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

  Custom Menus      
  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 KsMenus;

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
  Menus, KsItems, ImgList, KsBitmap, KsUtils, KsControls, KsEffects;

type

{ TKsMenuBarView }

  TKsCustomMenuBar = class;

  TKsMenuBarView = class(TKsItemView)
  private
    FMenuBar: TKsCustomMenuBar;
  protected
    procedure SetSize(ASize: TPoint); override;
    procedure SetPosition(APosition: TPoint); override;
    procedure Invalidate; override;
  public
    constructor CreateView(AOwner: TComponent; ABuffer: TKsBitmap);
  end;

{ TKsCustomMenuBar class }

{ TKsCustomMenuBar is a menu bar and its accompanying drop-down menus for a form. }
  TKsCustomMenuBar = class(TKsCustomControl)
  private
    FDisableUpdate: boolean;
    FItems: TKsCustomItem;
    FView: TKsMenuBarView;
    FPopupBlend: boolean;
    FPopupBlendValue: integer;
    { MDI Child }
    FActiveMDIForm: TComponent;
    FDropShadow: boolean;
    FShowAnimationTime: integer;
    FShadowWidth: integer;
    FShowAnimation: TKsAnimation;
    FAutoSize: boolean;
    procedure DoMDIItemClick(Sender: TObject);
    procedure DoInternalChange(Sender: TObject);
    { messages }
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    { properties }
    function GetImages: TCustomImageList;
    procedure SetImages(Value: TCustomImageList);
    procedure SetPopupBlend(const Value: boolean);
    procedure SetPopupBlendValue(const Value: integer);
    procedure SetDropShadow(const Value: boolean);
    procedure SetShadowWidth(const Value: integer);
    procedure SetShowAnimation(const Value: TKsAnimation);
    procedure SetShowAnimationTime(const Value: integer);
    procedure SetAutoSize(const Value: boolean);
  protected
    FCalcSize: boolean;
    FSysMenu: TKsCustomItem;
    FMin: TKsCustomItem;
    FRestore: TKsCustomItem;
    FClose: TKsCustomItem;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    { for next }
    function GetViewRect: TRect; virtual;
    { overrides }
    procedure PaintBuffer; override;
    { need for }
    class procedure InsertItemProc(AParent: TComponent; AItem: TKsCustomItem); virtual;
    class function GetItemClassProc: TKsCustomItemClass; virtual;

    procedure ItemsChanged; virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    property View: TKsMenuBarView read FView;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure EnterLoop;
    function IsShortCut(var Msg: TWMKey): boolean;
    { MDI }
    procedure ShowMDIItems(AMDIForm: TComponent);
    procedure HideMDIItems;
  published
    property Align;
    property Anchors;
    property AutoSize: boolean read FAutoSize write SetAutoSize;
    property Blend;
    property BlendValue;
    { Lists the images that can appear beside individual menu items. }
    property Images: TCustomImageList read GetImages write SetImages;
    { Describes the elements of the menu. }
    property Items: TKsCustomItem read FItems;
    { Link to Blend property for popup menu }
    property PopupBlend: boolean read FPopupBlend write SetPopupBlend;
    { Link to BlendValue property for popup menu }
    property PopupBlendValue: integer read FPopupBlendValue write SetPopupBlendValue;
    { Animation and Shadow }
    property DropShadow: boolean read FDropShadow write SetDropShadow;
    property ShadowWidth: integer read FShadowWidth write SetShadowWidth;
    property ShowAnimation: TKsAnimation read FShowAnimation write SetShowAnimation;
    property ShowAnimationTime: integer read FShowAnimationTime write SetShowAnimationTime;
  end;

{ TKsCustomPopupMenu class }

{ TKsCustomPopupMenu encapsulates the properties, methods, and events of a advanced pop-up menu. }
  TKsCustomPopupMenu = class(TPopupMenu)
  private
    FItems: TKsCustomItem;
    FPopupBlend: boolean;
    FPopupBlendValue: integer;
    FDropShadow: boolean;
    FShowAnimationTime: integer;
    FShadowWidth: integer;
    FShowAnimation: TKsAnimation;
    { proeprty }
    function GetImages: TCustomImageList;
    procedure SetImages(Value: TCustomImageList);
    procedure SetPopupBlend(const Value: boolean);
    procedure SetPopupBlendValue(const Value: integer);
    procedure SetDropShadow(const Value: boolean);
    procedure SetShadowWidth(const Value: integer);
    procedure SetShowAnimation(const Value: TKsAnimation);
    procedure SetShowAnimationTime(const Value: integer);
  protected
    { need for }
    class procedure InsertItemProc(AParent: TComponent; AItem: TKsCustomItem); virtual;
    class function GetItemClassProc: TKsCustomItemClass; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;

    procedure Popup(X, Y: integer); override;
    procedure Close; virtual;
  published
    { Lists the images that can appear beside individual menu items. }
    property Images: TCustomImageList read GetImages write SetImages;
    { Describes the elements of the menu. }
    property Items: TKsCustomItem read FItems;
    { Link to Blend property for popup menu }
    property PopupBlend: boolean read FPopupBlend write SetPopupBlend;
    { Link to BlendValue property for popup menu }
    property PopupBlendValue: integer read FPopupBlendValue write SetPopupBlendValue;
    { Animation and Shadow }
    property DropShadow: boolean read FDropShadow write SetDropShadow;
    property ShadowWidth: integer read FShadowWidth write SetShadowWidth;
    property ShowAnimation: TKsAnimation read FShowAnimation write SetShowAnimation;
    property ShowAnimationTime: integer read FShowAnimationTime write SetShowAnimationTime;
    property OnPopup;
  end;

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

uses KsForms, KsControlBars;

const
  ActivePopup: TKsCustomPopupMenu = nil;
  
{ TKsMenuBarView ==============================================================}

constructor TKsMenuBarView.CreateView(AOwner: TComponent; ABuffer: TKsBitmap);
begin
  inherited CreateView(AOwner, true, voHorizontal);
  FMenuBar := (AOwner as TKsCustomMenuBar);
  Buffer := ABuffer; 
end;

procedure TKsMenuBarView.Invalidate;
begin
  FMenuBar.Invalidate;
end;

procedure TKsMenuBarView.SetPosition(APosition: TPoint);
begin
  inherited SetPosition(APosition);
end;

procedure TKsMenuBarView.SetSize(ASize: TPoint);
var
  R: TRect;
begin
  inherited SetSize(ASize);
  { Set MenuBar size }
  if not FMenuBar.FAutoSize then Exit;

  R := FMenuBar.GetViewRect; 
  with FMenuBar do
    SetBounds(Left, Top, Width, ASize.Y + R.Top + (FHeight - R.Bottom));
end;

{ TKsCustomMenuBar ===============================================================}

constructor TKsCustomMenuBar.Create(AOwner: TComponent);
begin
  RegisterContainerClass(ClassType, InsertItemProc, GetItemClassProc);
  inherited Create(AOwner);
  FCalcSize := true;
  FAutoSize := true;

  FItems := GetItemClassProc.Create(Self);
  FItems.ParentComponent := Self;
  if not (csDesigning in ComponentState) then
    FItems.OnInternalChange := DoInternalChange;  

  FView := TKsMenuBarView.CreateView(Self, Buffer);
  FView.ParentComponent := Self;
  FView.Items := FItems;
  FView.Window := Self;

  Color := clMenu;
  FPopupBlend := false;
  FPopupBlendValue := 150;
  FDropShadow := false;
  FShadowWidth := 4;
  FShowAnimation := kaNone;
  FShowAnimationTime := 300;

  Align := alTop;
  Height := GetSystemMetrics(SM_CYMENU);
end;

destructor TKsCustomMenuBar.Destroy;
begin
  FView.Free;
  FItems.Free;
  inherited Destroy;
  UnregisterContainerClass(ClassType);
end;

procedure TKsCustomMenuBar.Loaded;
begin
  inherited;
  PopupBlend := FPopupBlend;
  PopupBlendValue := FPopupBlendValue;
  DropShadow := FDropShadow;
  ShadowWidth := FShadowWidth;
  ShowAnimation := FShowAnimation;
  ShowAnimationTime := FShowAnimationTime;

  Items.IsToolbar := Parent is TKsCustomControlBar;

  { For MDI }
  if not (csDesigning in ComponentState) and (Owner is TForm) and ((Owner as TForm).FormStyle = fsMDIForm) then
  begin
    FSysMenu := GetItemClassProc.Create(Owner);
    FSysMenu.MDIItemKind := mikSysMenu;
    FSysMenu.Visible := false;
    FSysMenu.OnClick := DoMDIItemClick;
    Items.Insert(0, FSysMenu);

    FMin := GetItemClassProc.Create(Owner);
    FMin.MDIItemKind := mikMinimize;
    FMin.Visible := false;
    FMin.OnClick := DoMDIItemClick;
    Items.Add(FMin);

    FRestore := GetItemClassProc.Create(Owner);
    FRestore.MDIItemKind := mikRestore;
    FRestore.Visible := false;
    FRestore.OnClick := DoMDIItemClick;
    Items.Add(FRestore);

    FClose := GetItemClassProc.Create(Owner);
    FClose.MDIItemKind := mikClose;
    FClose.Visible := false;
    FClose.OnClick := DoMDIItemClick;
    Items.Add(FClose);
  end;

  FCalcSize := false;
  FView.CalcSize;

  FItems.BiDiMode := BiDiMode;
end;

procedure TKsCustomMenuBar.DoInternalChange(Sender: TObject);
begin
  if (csLoading in ComponentState) or (csDestroying in ComponentState) then Exit; 

  if not FDisableUpdate then
    ItemsChanged; 
end;

procedure TKsCustomMenuBar.ItemsChanged;
begin
  PopupBlend := FPopupBlend;
  PopupBlendValue := FPopupBlendValue;
  DropShadow := FDropShadow;
  ShadowWidth := FShadowWidth;
  ShowAnimation := FShowAnimation;
  ShowAnimationTime := FShowAnimationTime;
  if Owner is TWinControl then
    FItems.OwnerForm := TWinControl(Owner);

  Items.IsToolbar := Parent is TKsCustomControlBar;

  Invalidate;
end;

procedure TKsCustomMenuBar.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
begin
  FItems.GetChildren(Proc, Root);
  inherited ;
end;

class function TKsCustomMenuBar.GetItemClassProc: TKsCustomItemClass;
begin
  Result := TKsCustomItem;
end;

class procedure TKsCustomMenuBar.InsertItemProc(AParent: TComponent;
  AItem: TKsCustomItem);
begin
  (AParent as TKsCustomMenuBar).Items.Add(AItem);
end;

{ Overrides }

function TKsCustomMenuBar.GetViewRect: TRect;
begin
  Result := Rect(0, 0, FWidth, FHeight);

  case Align of
    alTop: Dec(Result.Bottom, 2);
    alBottom: Inc(Result.Top, 2);
  end;
end;

procedure TKsCustomMenuBar.PaintBuffer;
begin
  inherited ;

  if (FView <> nil) and (Buffer <> nil) then
  begin
    { Draw view }
    with GetViewRect do
    begin
      FView.Left := Left;
      FView.Top := Top;
    end;
    FView.Paint(Buffer);
    { Draw back }
    case Align of
      alTop: Buffer.DrawEdge(Rect(0, FHeight-2, FWidth, FHeight), KColor(clBtnShadow), KColor(clBtnHighlight));
      alBottom: Buffer.DrawEdge(Rect(0, 0, FWidth, 2), KColor(clBtnShadow), KColor(clBtnHighlight));
    end;
  end;
end;

procedure TKsCustomMenuBar.ShowMDIItems(AMDIForm: TComponent);
begin
  { MDI }
  FDisableUpdate := true;

  FSysMenu.Visible := true;
  FMin.Visible := true;
  FRestore.Visible := true;
  FClose.Visible := true;

  FActiveMDIForm := AMDIForm;
  Items.ActiveMDIForm := AMDIForm;

  FDisableUpdate := false;

  Invalidate;
end;

procedure TKsCustomMenuBar.HideMDIItems;
begin
  FSysMenu.Visible := false;
  FMin.Visible := false;
  FRestore.Visible := false;
  FClose.Visible := false;

  FActiveMDIForm := nil;
  Items.ActiveMDIForm := nil;

  Invalidate;
end;

procedure TKsCustomMenuBar.DoMDIItemClick(Sender: TObject);
begin
  if Sender = nil then Exit;
  if FActiveMDIForm = nil then Exit;

  case TKsCustomItem(Sender).MDIItemKind of
    mikClose: (FActiveMDIForm as TKsCustomForm).Close;
    mikRestore: (FActiveMDIForm as TKsCustomForm).Restore;
    mikMinimize: (FActiveMDIForm as TKsCustomForm).Minimize;
    mikSysMenu: begin
      (FActiveMDIForm as TKsCustomForm).SysMenu;
      FView.UpdateHover(ClientToScreen(Point(-1, -1)));
    end;
  end;
end;

procedure TKsCustomMenuBar.EnterLoop;
begin
  FItems.First := true;
  FItems.OnlyFirst := true;

  FView.MessageLoop;
end;

function TKsCustomMenuBar.IsShortCut(var Msg: TWMKey): boolean;
begin
  Result := Items.IsShortCut(Msg);
end;

procedure TKsCustomMenuBar.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  if (View <> nil) and (View.Buffer <> nil) and (not FCalcSize) and (not FAutoSize) then
  begin
    FCalcSize := true;
    try
      inherited SetBounds(ALeft, ATop, AWidth, AHeight);
      View.CalcSize;
    finally
      FCalcSize := false;
    end;
  end
  else
    inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

{ Mouse routines }

procedure TKsCustomMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  FView.UpdateHover(ClientToScreen(Point(X, Y)));
end;

procedure TKsCustomMenuBar.CMMouseLeave(var Msg: TMessage);
begin
  FView.UpdateHover(Point(-1, -1));
end;

procedure TKsCustomMenuBar.CMDialogChar(var Msg: TCMDialogChar);
var
  ShiftState: TShiftState;
begin
  if (Msg.CharCode <> 0) then
  begin
    ShiftState := KeyDataToShiftState(Msg.KeyData);
{    if Menus.ShortCut(Msg.CharCode, ShiftState) <> 0 then
    begin
      if ssCtrl in ShiftState then // Need add $60 to CharCode if Ctrl pressed
        IsShortCut(Msg.CharCode + $60, ShiftState)
      else
        CheckShortCut(Msg.CharCode, ShiftState);
    end; }

    if ssAlt in ShiftState then
    begin
      if FItems.FindItemByChar(Char(Msg.CharCode)) <> nil then
      begin
        PostMessage(Parent.Handle, WM_CHAR, Msg.CharCode, 0);
        EnterLoop;
        Msg.Result := 1;
        Exit;
      end;
    end;

  end;

  inherited ;
end;

procedure TKsCustomMenuBar.CMDialogKey(var Msg: TCMDialogKey);
begin
  inherited ;
end;

{ Properties }

function TKsCustomMenuBar.GetImages: TCustomImageList;
begin
  Result := FItems.Images;
end;

procedure TKsCustomMenuBar.SetImages(Value: TCustomImageList);
begin
  FItems.Images := Value;
end;

procedure TKsCustomMenuBar.SetPopupBlend(const Value: boolean);
begin
  FPopupBlend := Value;
  FItems.PopupBlend := Value;
end;

procedure TKsCustomMenuBar.SetPopupBlendValue(const Value: integer);
begin
  FPopupBlendValue := Value;
  FItems.PopupBlendValue := Value;
end;

procedure TKsCustomMenuBar.SetDropShadow(const Value: boolean);
begin
  FDropShadow := Value;
  FItems.DropShadow := Value;
end;

procedure TKsCustomMenuBar.SetShadowWidth(const Value: integer);
begin
  FShadowWidth := Value;
  FItems.ShadowWidth := Value;
end;

procedure TKsCustomMenuBar.SetShowAnimation(const Value: TKsAnimation);
begin
  FShowAnimation := Value;
  FItems.ShowAnimation := Value;
end;

procedure TKsCustomMenuBar.SetShowAnimationTime(const Value: integer);
begin
  FShowAnimationTime := Value;
  FItems.ShowAnimationTime := Value;
end;

procedure TKsCustomMenuBar.SetAutoSize(const Value: boolean);
begin
  FAutoSize := Value;
end;

{ TKsCustomPopupMenu ==========================================================}

constructor TKsCustomPopupMenu.Create(AOwner: TComponent);
begin
  RegisterContainerClass(ClassType, InsertItemProc, GetItemClassProc);
  inherited;
  FItems := GetItemClassProc.Create(Self);

  FPopupBlend := false;
  FPopupBlendValue := 150;
  FShadowWidth := 4;
  FShowAnimation := kaNone;
  FShowAnimationTime := 300;
  FDropShadow := false;
end;

destructor TKsCustomPopupMenu.Destroy;
begin
  FItems.Free;
  inherited;
  UnregisterContainerClass(ClassType);
end;

procedure TKsCustomPopupMenu.Loaded;
begin
  inherited;
  FItems.BiDiMode := BiDiMode;
end;

procedure TKsCustomPopupMenu.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
begin
  inherited;
  FItems.GetChildren(Proc, Root);
end;

function TKsCustomPopupMenu.GetImages: TCustomImageList;
begin
  Result := Items.Images;
end;

class function TKsCustomPopupMenu.GetItemClassProc: TKsCustomItemClass;
begin
  Result := TKsCustomItem;
end;

class procedure TKsCustomPopupMenu.InsertItemProc(AParent: TComponent;
  AItem: TKsCustomItem);
begin
  (AParent as TKsCustomPopupMenu).Items.Add(AItem);
end;

procedure TKsCustomPopupMenu.Popup(X, Y: integer);
begin
  if ActivePopup <> nil then
  begin
    ActivePopup.Close;
    Application.ProcessMessages;
  end;

  ActivePopup := Self;
  try
    PopupBlend := FPopupBlend;
    PopupBlendValue := FPopupBlendValue;
    DropShadow := FDropShadow;
    ShadowWidth := FShadowWidth;
    ShowAnimation := FShowAnimation;
    ShowAnimationTime := FShowAnimationTime;
    if Owner is TWinControl then
      FItems.OwnerForm := TWinControl(Owner);

    FItems.First := true;
    FItems.OnlyFirst := true;

    if Assigned(OnPopup) then
      OnPopup(Self);

    FItems.Popup(nil, X, Y, Rect(0, 0, 0, 0));
  finally
    ActivePopup := nil;
  end;
end;

procedure TKsCustomPopupMenu.Close;
begin
  if Owner is TWinControl then
    PostMessage((Owner as TWinControl).Handle, WM_NCMBUTTONDBLCLK, 0, 0);
end;

procedure TKsCustomPopupMenu.SetImages(Value: TCustomImageList);
begin
  FItems.Images := Value;
end;

procedure TKsCustomMenuBar.WMLButtonDown(var Message: TWMLButtonDown);
var
  i: integer;
  R: TRect;
begin
  inherited;

  { Check for item rect }
  for i := 0 to Items.Count - 1 do
  begin
    R := FView.GetItemRect(Items[i]);
    if PtInRect(R, Point(Message.XPos,Message.YPos)) then
    begin
      EnterLoop;
      Exit;
    end;
  end;
end;

procedure TKsCustomPopupMenu.SetPopupBlend(const Value: boolean);
begin
  FPopupBlend := Value;
  FItems.PopupBlend := Value;
end;

procedure TKsCustomPopupMenu.SetPopupBlendValue(const Value: integer);
begin
  FPopupBlendValue := Value;
  FItems.PopupBlendValue := Value;
end;

procedure TKsCustomPopupMenu.SetDropShadow(const Value: boolean);
begin
  FDropShadow := Value;
  FItems.DropShadow := Value;
end;

procedure TKsCustomPopupMenu.SetShadowWidth(const Value: integer);
begin
  FShadowWidth := Value;
  FItems.ShadowWidth := Value;
end;

procedure TKsCustomPopupMenu.SetShowAnimation(const Value: TKsAnimation);
begin
  FShowAnimation := Value;
  FItems.ShowAnimation := Value;
end;

procedure TKsCustomPopupMenu.SetShowAnimationTime(const Value: integer);
begin
  FShowAnimationTime := Value;
  FItems.ShowAnimationTime := Value;
end;

end.
