Delphi控件源码

开发平台：
C++ Builder

am2000mainmenu.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       TMainMenu2000 Component Unit                    }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000mainmenu;
{$I am2000.inc}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, ExtCtrls,
  Forms, Dialogs, Menus, Buttons, ComCtrls,
  am2000options, am2000menuitem;
type
  // mainmenu manager
  TCustomMainMenu2000 = class(TMainMenu)
  private
    FEMI2000           : TEditableMenuItem2000; // layer for comptibility with Delphi and your apps
    FMergedMenus       : TList;
    FMergedMenuItems   : TList;
    ParentMenu         : TCustomMainMenu2000;
{$IFNDEF Delphi4OrHigher}
    FImages            : TImageList;
{$ENDIF}
    function GetMenuItem2000: TMenuItem2000;
    function GetMergedMenuItem(const Index: Integer): TMenuItem;
    function GetMergedMenuItemsCount: Integer;
  protected
    procedure Loaded; override;
{$IFNDEF Delphi4OrHigher}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
{$ENDIF}
  public
    property Items2000 : TMenuItem2000
      read GetMenuItem2000;
    property MergedMenus : TList
      read FMergedMenus;
{$IFNDEF Delphi4OrHigher}
    property Images : TImageList read FImages write FImages;
{$ENDIF}
    property MergedMenuItems [const Index: Integer] : TMenuItem read GetMergedMenuItem;
    property MergedMenuItemsCount : Integer read GetMergedMenuItemsCount;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Merge2(Menu: TMenu);
    procedure Unmerge2(Menu: TMenu);
    procedure RebuildMergedMenuItems;
    function IsShortCut(var Msg: TWMKey): Boolean; 
{$IFDEF Delphi4OrHigher}
    override;
{$ENDIF}
  published
    property Items       : TEditableMenuItem2000  read FEMI2000;
  end;
implementation
uses
  Consts,
  am2000menubar, am2000const, am2000utils;
type
  // forgot about this
  TFalseMenu = class(TComponent)
  private
{$IFDEF Delphi4OrHigher}  
    FBiDiMode: TBiDiMode;
{$ENDIF}
    FItems: TMenuItem;
  end;
{ TCustomMainMenu2000 }
constructor TCustomMainMenu2000.Create(AOwner: TComponent);
begin
  inherited;
  // we don't need TMenuItem so we just destoy it
  // and create TMenuItem2000 instead of.
  TFalseMenu(Self).FItems:= TMenuItem2000.Create(Self);
{$IFDEF Delphi4OrHigher}
  TFalseMenu(Self).FBiDiMode:= BiDiMode;
{$ENDIF}
  FEMI2000:= TEditableMenuItem2000.Create(Self);
  FMergedMenus:=  TList.Create;
  FMergedMenus.Add(Self);
  FMergedMenuItems:= TList.Create;              
end;
destructor TCustomMainMenu2000.Destroy;
begin
  if (ParentMenu <> nil)
  then ParentMenu.Unmerge2(Self);
  FMergedMenus.Free;
  FMergedMenuItems.Free;
  if (csDesigning in ComponentState)
  then SendMessage(GetMnuDsgnHandle, wm_Close, 0, 0);
  inherited;
end;
procedure TCustomMainMenu2000.Loaded;
begin
  inherited;
  // if this menu is the main menu for a mdi child form
  // then scan the parent mdi form and merge with
  // it's main menu
  if (not (csDesigning in ComponentState))
  and (TForm(Owner).Menu = Self)
  and (TForm(Owner).FormStyle = fsMdiChild)
  and (ActiveMenuBar <> nil)
  and (ActiveMenuBar.Menu is TCustomMainMenu2000)
  then begin
    ParentMenu:= TCustomMainMenu2000(ActiveMenuBar.Menu);
    ParentMenu.Merge2(Self);
  end;
end;
function TCustomMainMenu2000.GetMenuItem2000: TMenuItem2000;
begin
  Result:= TMenuItem2000(inherited Items);
end;
procedure TCustomMainMenu2000.Merge2(Menu: TMenu);
begin
  FMergedMenus.Add(Menu);
  RebuildMergedMenuItems;
  if (ActiveMenuBar <> nil)
  then ActiveMenuBar.UpdateMenuBar(True);
end;
procedure TCustomMainMenu2000.Unmerge2(Menu: TMenu);
begin
  FMergedMenus.Remove(Menu);
  RebuildMergedMenuItems;
  if (ActiveMenuBar <> nil)
  then ActiveMenuBar.UpdateMenuBar(True);
end;
procedure TCustomMainMenu2000.RebuildMergedMenuItems;
var
  GroupIndex, MenuIndex, ItemIndex: Integer;
  BreakGroupIndex: Boolean;
  Menu: TMenu;
  OwnerForm: TComponent;
begin
  FMergedMenuItems.Clear;
  // place menu for active form at the end of the list
  for MenuIndex:= 0 to FMergedMenus.Count -1 do
    if FMergedMenus[MenuIndex] <> Self then begin
      Menu:= TMenu(FMergedMenus[MenuIndex]);
      OwnerForm:= Menu.Owner;
      while (OwnerForm <> nil)
      and (not (OwnerForm is TForm)) do
        OwnerForm:= OwnerForm.Owner;
      if (OwnerForm is TForm)
      and (TForm(OwnerForm).Active)
      and (TForm(OwnerForm).Menu = Menu)
      then begin
        FMergedMenus.Remove(Menu);
        FMergedMenus.Add(Menu);
        Break;
      end;
    end;
  // rebuild menu items
  for GroupIndex:= 0 to 255 do begin
    MenuIndex:= FMergedMenus.Count -1;
    BreakGroupIndex:= False;
    while (MenuIndex >= 0) and (not BreakGroupIndex) do
      with TMainMenu(FMergedMenus[MenuIndex]) do begin
        for ItemIndex:= 0 to Items.Count -1 do
          if Items[ItemIndex].GroupIndex = GroupIndex then begin
            FMergedMenuItems.Add(Items[ItemIndex]);
            BreakGroupIndex:= True;
          end;
        Dec(MenuIndex);
      end;
  end;
end;
function TCustomMainMenu2000.GetMergedMenuItem(const Index: Integer): TMenuItem;
begin
  Result:= nil;
  if (FMergedMenuItems = nil) or (Index < 0)
  then Exit;
  if FMergedMenuItems.Count = 0
  then RebuildMergedMenuItems;
  if (Index < FMergedMenuItems.Count)
  then Result:= TMenuItem(FMergedMenuItems[Index]);
end;
function TCustomMainMenu2000.GetMergedMenuItemsCount: Integer;
begin
  if FMergedMenuItems = nil
  then
    Result:= 0
  else begin
    if (FMergedMenuItems.Count = 0)
    then RebuildMergedMenuItems;
    Result:= FMergedMenuItems.Count;
  end;
end;
{$IFNDEF Delphi4OrHigher}
procedure TCustomMainMenu2000.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove)
  and (Acomponent = FImages)
  then FImages:= nil;
end;
{$ENDIF}
function TCustomMainMenu2000.IsShortCut(var Msg: TWMKey): Boolean;
begin
  Result:= IsShortCutEx(Msg, Items2000, csDesigning in ComponentState);
end;
end.

						