hktest.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

unit HkTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SysHot, StdCtrls, Menus, WComp;
                
type
  THotKeyTest = class(TForm)
    SysHotKey: TSysHotKey;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    chkActivate: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure SysHotKeyHotKey(Sender: TObject; Index: Integer);
    procedure chkActivateClick(Sender: TObject);
  private
    FActive : Boolean;
    FShowing: Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  HotKeyTest: THotKeyTest;

implementation

{$R *.DFM}

procedure THotKeyTest.FormCreate(Sender: TObject);
begin
  with SysHotKey do
   begin
     // Alt+space (opens system menu)
     AddHotKey(vkSpace, [hkAlt]);
     // Alt+F4 (closes program)
     AddHotKey(vkF4, [hkAlt]);
     // Printscreen (capture screen)
     AddHotKey(vkSnapshot, []);
     // Space
     AddHotKey(vkSpace, []);
     // Enter
     AddHotKey(vkReturn, []);
     // Alt+Printscreen (capture window)
     AddHotKey(vkSnapshot, [hkAlt]);
   end;
  FActive := False;
  FShowing := False;
end;

procedure THotKeyTest.SysHotKeyHotKey(Sender: TObject; Index: Integer);
begin
  if not FActive and not FShowing then SetForeGroundWindow(Handle);
  case Index of
    0, 1 : if not FActive then
            begin
              // Set FActive to true to avoid multiple overlapping message boxes
              FActive := True;
              ShowMessage('Sorry, this key has been overruled!!!!');
              FActive := False;
            end;
    2    : if not FActive then
            begin
              FActive := True;
              ShowMessage('Didn''t you mother teach you that it isn''t nice to steal other people''s graphics?');
              FActive := False;
            end;
    3, 4 : if not FShowing then
            begin
              FShowing := True;
              ShowMessage('You''ll have to use the mouse instead of the keyboard to do this....!!'+#13+#10+'(The ENTER and SPACE keys are trapped as well....)');
              FShowing := False;
            end;
    5    : if not FActive then
            begin
              FActive := True;
              ShowMessage('Nope, can''t capture this window either....');
              FActive := False;
            end;
  end;
end;

procedure THotKeyTest.chkActivateClick(Sender: TObject);
begin
  SysHotKey.Active := TCheckBox(Sender).Checked;
  FActive := True;
  if SysHotKey.Active then
   ShowMessage('The hotkeys are now active')
  else
   ShowMessage('The hotkeys have been deactivated.');
  FActive := False;
end;

end.