{==============================================================================

  Custom Menu Form
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsMenuForm;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
  KsBitmap, KsControls, KsForms, KsItems, ImgList;

type

  TKsPopupWindow = class;

{ TKsPopupView }

  TKsPopupView = class(TKsItemView)
  private
    FPopupWindow: TKsPopupWindow;
  protected
    procedure SetSize(ASize: TPoint); override;
    procedure SetPosition(APosition: TPoint); override;
    procedure Invalidate; override;
  public
    constructor CreateView(AOwner: TComponent);
  end;

{ TKsPopupForm }

  TKsPopupForm = class(TKsCustomForm)
  private
    FPopupWindow: TKsPopupWindow;
    FOwnerForm: TWinControl;
    procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
    procedure WMMouseActivate(var Msg: TWMMouseActivate); message WM_MOUSEACTIVATE;
  protected
    function GetClientRect: TRect; override;
    function GetMinTrackSize: TPoint; override;
    procedure PaintClientArea(Buffer: TKsBitmap); override;
    procedure PaintNCArea(Buffer: TKsBitmap); override;

    property PopupWindow: TKsPopupWindow read FPopupWindow;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TKsPopupFormClass = class of TKsPopupForm;

{ TKsPopupWindow class }

  TKsPopupWindow = class(TForm)
  private
    FView: TKsPopupView;
    FForm: TKsPopupForm;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  protected
    class function GetFormClass: TKsPopupFormClass; virtual;

    property Form: TKsPopupForm read FForm;
  public
    constructor CreatePopupWindow(AOwner: TComponent; AItems: TKsCustomItem;
      AParentView: TKsItemView); virtual;
    destructor Destroy; override;

    procedure CreateParams(var Params: TCreateParams); override;

    procedure CalcSize;
    procedure EnterLoop;

    property View: TKsPopupView read FView;
  end;

  TKsPopupWindowClass = class of TKsPopupWindow;

implementation {===============================================================}

uses KsMenus, KsEffects;

{ TKsPopupView }

constructor TKsPopupView.CreateView(AOwner: TComponent);
begin
  inherited CreateView(AOwner, false, voVertical);
  FPopupWindow := (AOwner as TKsPopupWindow)
end;

procedure TKsPopupView.Invalidate;
begin
  FPopupWindow.Invalidate;
end;

procedure TKsPopupView.SetPosition(APosition: TPoint);
var
  R: TRect;
begin
  R := FPopupWindow.FForm.GetClientRect;
  with FPopupWindow do
    SetBounds(APosition.X - R.Left, APosition.Y - R.Top, Width,
      Height);
end;

procedure TKsPopupView.SetSize(ASize: TPoint);
var
  R: TRect;
  ShadowWidth: integer;
begin
  FPopupWindow.FForm.FWidth := 1000;
  FPopupWindow.FForm.FHeight := 1000;

  if FPopupWindow.FForm.DropShadow then
    ShadowWidth := FPopupWindow.FForm.ShadowWidth
  else
    ShadowWidth := 0;
    
  R := FPopupWindow.FForm.GetClientRect;
  with FPopupWindow do
    SetBounds(Left, Top, ASize.X + R.Left + (FPopupWindow.FForm.FWidth - R.Right) + ShadowWidth,
      ASize.Y + R.Top + (FPopupWindow.FForm.FHeight - R.Bottom) + ShadowWidth);
end;

{ TKsPopupForm ================================================================}

constructor TKsPopupForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderIcons := [];
  BorderStyle := kbsNone;
  CanMove := false;
  CanResize := false;

  Active := true;
end;

destructor TKsPopupForm.Destroy;
begin
  inherited;
end;

function TKsPopupForm.GetClientRect: TRect;
begin
  Result := Rect(3, 3, FWidth-3, FHeight-3);
end;

function TKsPopupForm.GetMinTrackSize: TPoint;
begin
  Result := Point(10, 10);
end;

procedure TKsPopupForm.PaintClientArea(Buffer: TKsBitmap);
begin
  if (FPopupWindow <> nil) and (FPopupWindow.FView <> nil) then
  with FPopupWindow do
  begin
    with FForm.GetClientRect do
    begin
      FView.Left := Left;
      FView.Top := Top;
    end;

    FView.Paint(Buffer);

    FView.Left := 0;
    FView.Top := 0;
  end;
end;

procedure TKsPopupForm.PaintNCArea(Buffer: TKsBitmap);
var
  R: TRect;
begin
  R := Rect(0, 0, FWidth, FHeight);
  if (FPopupWindow <> nil) and (FPopupWindow.FView <> nil) and
     (FPopupWindow.FView.Items <> nil) then
  begin
    { Stadard }
    Buffer.DrawEdge(R, KColor(clBtnFace), KColor(clBlack));
    InflateRect(R, -1, -1);
    Buffer.DrawEdge(R, KColor(clBtnHighlight), KColor(clBtnShadow));
    InflateRect(R, -1, -1);
    Buffer.DrawEdge(R, KColor(clMenu), KColor(clMenu));
  end;
end;

procedure TKsPopupForm.WMActivate(var Msg: TWMActivate);
begin
  if (FOwnerForm <> nil) then
  begin
    { Activate OwnerForm }
    SendMessage(FOwnerForm.Handle, WM_NCACTIVATE, 1, 0);
  end;
end;

procedure TKsPopupForm.WMMouseActivate(var Msg: TWMMouseActivate);
begin
  if (FOwnerForm <> nil) then
  begin
    { Activate OwnerForm }
    SendMessage(FOwnerForm.Handle, WM_NCACTIVATE, 1, 0);
  end;
end;

{ TKsPopupWindow ===============================================================}

constructor TKsPopupWindow.CreatePopupWindow(AOwner: TComponent;
  AItems: TKsCustomItem; AParentView: TKsItemView);
begin
  inherited CreateNew(AOwner);

  FForm := GetFormClass.Create(Self);
  FForm.Loaded;
  FForm.FPopupWindow := Self;
  FForm.StayOnTop := true;
  FForm.Blend := AItems.PopupBlend;
  FForm.BlendValue := AItems.PopupBlendValue;
  FForm.DropShadow := AItems.DropShadow;
  FForm.ShadowWidth := AItems.ShadowWidth;

  if (AOwner.Owner <> nil) and (AOwner.Owner is TWinControl) then
    FForm.FOwnerForm := TWinControl(AOwner.Owner)
  else
    if AOwner is TWinControl then
      FForm.FOwnerForm := TWinControl(AOwner);

  if (not AItems.OnlyFirst) or ((AItems.OnlyFirst) and (AItems.First)) then
  begin
    FForm.ShowAnimation := AItems.ShowAnimation;
    FForm.ShowAnimationTime := AItems.ShowAnimationTime;
    if AItems.Parent <> nil then
      AItems.Parent.First := false
    else
      AItems.First := false;
  end;

  FView := TKsPopupView.CreateView(Self);
  FView.Buffer := FForm.Buffer;
  FView.ParentComponent := Self;
  FView.Items := AItems;
  FView.ParentView := AParentView;
  FView.Window := Self;
end;

destructor TKsPopupWindow.Destroy;
begin
  FView.Free;
  FForm.Free;
  inherited Destroy;
end;

procedure TKsPopupWindow.CalcSize;
begin
  if (FView <> nil) and (FForm <> nil) and (FForm.Buffer <> nil) then
    FView.CalcSize;
end;

procedure TKsPopupWindow.EnterLoop;
begin
  FView.MessageLoop;
end;

procedure TKsPopupWindow.CreateParams (var Params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    ExStyle := ExStyle or WS_EX_TOPMOST or WS_EX_TOOLWINDOW;
//    WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  end;
end;

procedure TKsPopupWindow.CMShowingChanged(var Message: TMessage);
const
  ShowFlags: array[Boolean] of UINT = (
    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
begin
  { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the
    form doesn't get activated when Visible is set to True. }
  SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing])
end;

class function TKsPopupWindow.GetFormClass: TKsPopupFormClass;
begin
  Result := TKsPopupForm;
end;

end.
