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.