fstopdlg.pas

Asta For d2006 自己修改版 经典中间件 速度超快

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.