Delphi控件源码

开发平台：

Delphi

FsTopDlg.pas：源码内容

							unit FsTopDlg;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus;
type
  TFSTopForm = class(TForm)
    PopupMenu1: TPopupMenu;
    StatLabel: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CheckShortCut(Key: Word; Shift: TShiftState);
  end;
var
  FSTopForm: TFSTopForm;
implementation
uses ClientFrm;
{$R *.DFM}
procedure CheckMenuItem(mi: TMenuItem; ShortCut: TShortCut);
var
   i : integer;
begin
   // TRACE('CheckMenuItem: %s', [mi.Name]);
   for i := 0 to mi.Count-1 do begin
      if mi.Items[i].ShortCut = ShortCut then
         if Assigned(mi.Items[i].OnClick) then
            mi.Items[i].OnClick(mi.Items[i]);
      CheckMenuItem(mi.Items[i], ShortCut);
   end;
end;
procedure TFSTopForm.CheckShortCut(Key: Word; Shift: TShiftState);
var
   sc : TShortCut;
begin
   // TRACE('Check Key: %d  Shift: %d', [Key, byte(Shift)]);
   sc := ShortCut(Key, Shift);
   CheckMenuItem(PopupMenu1.Items, sc);
end;
procedure TFSTopForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   ClientForm.FullScreen1Click(nil);
end;
procedure TFSTopForm.FormCreate(Sender: TObject);
begin
   Top := 0;
   Left := Screen.Width - Width;
   StatLabel.Hint := 'Right-Click for Popup Menu' + #13#10 +
                     'Close this window to Exit Full Screen Mode';
end;
procedure CopyMenuItems(Src, Dest: TMenuItem);
var
   i      : integer;
   mi, mo : TMenuItem;
begin
   // Delete the old ones
   for i := Dest.Count-1 downto 0 do begin
      mi := Dest.Items[i];
      Dest.Delete(i);
      mi.Free;
   end;
   // Merge the new ones
   for i := 0 to Src.Count-1 do begin
      mi := TMenuItem.Create(Dest);
      mo := Src.Items[i];
      mi.Caption  := mo.Caption;
      mi.ShortCut := mo.ShortCut;
      mi.OnClick  := mo.OnClick;
      mi.Bitmap   := mo.Bitmap;
      mi.Hint     := mo.Hint;
      mi.Action   := mo.Action;
      mi.Name     := mo.Name;
      Dest.Add(mi);
      CopyMenuItems(mo, mi);
   end;
end;
procedure TFSTopForm.FormShow(Sender: TObject);
begin
   // Merge the ClientForm's Main Menu into our Popup Menu
   CopyMenuItems(ClientForm.MainMenu1.Items, PopupMenu1.Items);
end;
end.

						