home *** CD-ROM | disk | FTP | other *** search
/ PC World 1999 February / PCWorld_1999-02_cd.bin / temacd / HotKeys / SysHot.pas < prev    next >
Pascal/Delphi Source File  |  1998-11-03  |  8KB  |  276 lines
  1. unit SysHot;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   WComp;
  8.  
  9. type
  10.   TWMHotKey = record
  11.     Msg: Cardinal;
  12.     idHotKey: Word;
  13.     Modifiers: Integer;
  14.     VirtKey : Integer;
  15.   end;
  16.  
  17.   THKModifier = (hkShift, hkCtrl, hkAlt, hkExt);
  18.   THKModifiers = set of THKModifier;
  19.  
  20.   TVirtKey =  (vkNone, vkCancel, vkBack, vkTab, vkClear, vkReturn, vkPause, vkCapital, vkEscape,
  21.                vkSpace, vkPrior, vkNext, vkEnd, vkHome, vkLeft, vkUp, vkRight, vkDown,
  22.                vkSelect, vkExecute, vkSnapshot, vkInsert, vkDelete, vkHelp,
  23.                vk0, vk1, vk2, vk3, vk4, vk5, vk6, vk7, vk8, vk9,
  24.                vkA, vkB, vkC, vkD, vkE, vkF, vkG, vkH, vkI, vkJ, vkK, vkL, vkM,
  25.                vkN, vkO, vkP, vkQ, vkR, vkS, vkT, vkU, vkV, vkW, vkX, vkY, vkZ,
  26.                vkNumpad0, vkNumpad1, vkNumpad2, vkNumpad3, vkNumpad4,
  27.                vkNumpad5, vkNumpad6, vkNumpad7, vkNumpad8, vkNumpad9,
  28.                vkMultiply, vkAdd, vkSeparator, vkSubtract, vkDecimal, vkDivide,
  29.                vkF1, vkF2, vkF3, vkF4, vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12,
  30.                vkF13, vkF14, vkF15, vkF16, vkF17, vkF18, vkF19, vkF20, vkF21, vkF22, vkF23, vkF24,
  31.                vkNumlock, vkScroll, vkApps);
  32.  
  33.   PHotKeyItem = ^THotKeyItem;
  34.   THotKeyItem = record
  35.     Modifiers : THKModifiers;
  36.     VirtKey   : TVirtKey;
  37.     Registered: Boolean;
  38.   end;
  39.  
  40.   THotKeyEvent = procedure(Sender: TObject; Index: Integer) of object;
  41.  
  42.   TSysHotKey = class(TWindowedComponent)
  43.   private
  44.     { property variables }
  45.     FActive  : Boolean;
  46.     { event variables }
  47.     FOnHotKey: THotKeyEvent;
  48.     { private variables }
  49.     FList    : TList;
  50.     { property setting/getting routines }
  51.     procedure SetActive(Value : Boolean);
  52.     function  GetCount: Integer;
  53.   protected
  54.     { method overrides }
  55.     procedure Loaded; override;
  56.     { message handlers }
  57.     procedure wmHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
  58.     procedure wmDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  59.     { private routines }
  60.     function  ModifiersToFlag(Modifiers : THKModifiers): UInt;
  61.     procedure RegisterHotKeyNr(Index : Integer);
  62.     procedure UnregisterHotKeyNr(Index : Integer);
  63.     procedure RegisterHotKeys;
  64.     procedure UnregisterHotKeys;
  65.   public
  66.     { constructor / destructor overrides }
  67.     constructor Create(AOwner: TComponent); override;
  68.     destructor Destroy; override;
  69.     { methods }
  70.     procedure Add(Item: THotKeyItem);
  71.     function  AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): THotkeyItem;
  72.     procedure Clear;
  73.     procedure Delete(Index : Integer);
  74.     function  Get(Index: Integer): THotKeyItem;
  75.     procedure Put(Index: Integer; Item: THotKeyItem);
  76.     { runtime only properties }
  77.     property HotKeys[Index: Integer]: THotKeyItem read Get write Put; default;
  78.     property HotKeyCount: integer read GetCount;
  79.   published
  80.     { properties }
  81.     property Active: Boolean read FActive write SetActive;
  82.     { events }
  83.     property OnHotKey: THotKeyEvent read FOnHotKey write FOnHotKey;
  84.   end;
  85.  
  86. function KeyToVirtKey(const Key: Char): TVirtKey;
  87. function HotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  88.  
  89. procedure Register;
  90.  
  91. implementation
  92.  
  93. var
  94.   VirtKeys : array[TVirtKey] of UInt =
  95.              ($00, $03, $08, $09, $0C, $0D, $13, $14, $1B,
  96.               $20, $21, $22, $23, $24, $25, $26, $27, $28,
  97.               $29, $2B, $2C, $2D, $2E, $2F,
  98.               $30, $31, $32, $33, $34, $35, $36, $37, $38, $39,
  99.               $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A,
  100.               $4B, $4C, $4D, $4E, $4F, $50, $51, $52, $53, $54,
  101.               $55, $56, $57, $58, $59, $5A,
  102.               $60, $61, $62, $63, $64, $65, $66, $67, $68, $69,
  103.               $6A, $6B, $6C, $6D, $6E, $6F,
  104.               $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B,
  105.               $7C, $7D, $7E, $7F, $80, $81, $82, $83, $84, $85, $86, $87,
  106.               $90, $91, $5D);
  107.  
  108. function KeyToVirtKey(const Key: Char): TVirtKey;
  109. var
  110.   i     : TVirtKey;
  111.   KeyVal: UInt;
  112. begin
  113.   Result := TVirtKey(0);
  114.   KeyVal := Ord(UpperCase(Key)[1]);
  115.   for i:= Low(TVirtKey) to High(TVirtKey) do
  116.    if KeyVal = VirtKeys[i] then
  117.     begin
  118.       Result := TVirtKey(i);
  119.       Exit;
  120.     end;
  121. end;
  122.  
  123. function HotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  124. begin
  125.   Result.VirtKey := VirtKey;
  126.   Result.Modifiers := Modifiers;
  127.   Result.Registered := False;
  128. end;
  129.  
  130. { TSysHotKey }
  131.  
  132. constructor TSysHotKey.Create(AOwner : TComponent);
  133. begin
  134.   inherited Create(AOwner);
  135.   FList := TList.Create;
  136. end;
  137.  
  138. destructor TSysHotKey.Destroy;
  139. begin
  140.   Clear;
  141.   FList.Free;
  142.   inherited Destroy;
  143. end;
  144.  
  145. procedure TSysHotKey.Loaded;
  146. begin
  147.   inherited Loaded;
  148.   if Active then RegisterHotKeys;
  149. end;
  150.  
  151. procedure TSysHotKey.SetActive(Value : Boolean);
  152. begin
  153.   if FActive<>Value then
  154.    begin
  155.      FActive := Value;
  156.      if Active then RegisterHotKeys else UnregisterHotKeys;
  157.    end;
  158. end;
  159.  
  160. procedure TSysHotKey.wmHotKey(var Msg: TWMHotKey);
  161. begin
  162.   if Assigned(FOnHotKey) then FOnHotKey(Self, Msg.idHotKey);
  163. end;
  164.  
  165. function TSysHotKey.ModifiersToFlag(Modifiers : THKModifiers): UInt;
  166. begin
  167.   Result := 0;
  168.   if hkShift in Modifiers then Result := Result or MOD_SHIFT;
  169.   if hkCtrl  in Modifiers then Result := Result or MOD_CONTROL;
  170.   if hkAlt   in Modifiers then Result := Result or MOD_ALT;
  171.   if hkExt   in Modifiers then Result := Result or MOD_WIN;
  172. end;
  173.  
  174. procedure TSysHotKey.RegisterHotKeyNr(Index : Integer);
  175. begin
  176.   with PHotKeyItem(FList.Items[Index])^ do
  177.    Registered := WordBool(RegisterHotKey(Handle, Index, ModifiersToFlag(Modifiers), VirtKeys[VirtKey]));
  178. end;
  179.  
  180. procedure TSysHotKey.UnRegisterHotKeyNr(Index : Integer);
  181. begin
  182.   with PHotKeyItem(FList.Items[Index])^ do
  183.    if Registered then
  184.     begin
  185.       UnregisterHotKey(Handle, Index);
  186.       Registered := False;
  187.     end;
  188. end;
  189.  
  190. procedure TSysHotKey.RegisterHotKeys;
  191. var
  192.   I : integer;
  193. begin
  194.   for I:=0 to FList.Count-1 do
  195.    RegisterHotKeyNr(I);
  196. end;
  197.  
  198. procedure TSysHotKey.UnregisterHotKeys;
  199. var
  200.   I : integer;
  201. begin
  202.   for I:=0 to FList.Count-1 do
  203.    UnregisterHotKeyNr(I);
  204. end;
  205.  
  206. procedure TSysHotKey.wmDestroy(Var Msg : TWMDestroy);
  207. begin
  208.   Active := False;
  209.   inherited;
  210. end;
  211.  
  212. procedure TSysHotKey.Add(Item: THotKeyItem);
  213. begin
  214.   AddHotKey(Item.VirtKey, Item.Modifiers);
  215. end;
  216.  
  217. function TSysHotKey.AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  218. var
  219.   pItem : PHotKeyItem;
  220.   iItem : Integer;
  221. begin
  222.   pItem := PHotKeyItem(AllocMem(sizeof(THotKeyItem)));
  223.   pItem^.VirtKey := VirtKey;
  224.   pItem^.Modifiers := Modifiers;
  225.   iItem := FList.Add(pItem);
  226.   if Active then RegisterHotKeyNr(iItem);
  227.   Result := pItem^;
  228. end;
  229.  
  230. procedure TSysHotKey.Clear;
  231. var
  232.   I : integer;
  233. begin
  234.   if Active then UnregisterHotKeys;
  235.   for I:=0 to FList.Count-1 do
  236.    FreeMem(FList.Items[I]);
  237.   FList.Clear;
  238. end;
  239.  
  240. procedure TSysHotKey.Delete(Index : Integer);
  241. begin
  242.   if Active then UnregisterHotKeys;
  243.   FreeMem(FList.Items[Index]);
  244.   FList.Delete(Index);
  245.   FList.Pack;
  246.   if Active then RegisterHotKeys;
  247. end;
  248.  
  249. function TSysHotKey.Get(Index: Integer): THotKeyItem;
  250. begin
  251.   Result := THotKeyItem(FList.Items[Index]^);
  252. end;
  253.  
  254. procedure TSysHotKey.Put(Index: Integer; Item: THotKeyItem);
  255. begin
  256.   if Active then UnregisterHotKeyNr(Index);
  257.   with THotKeyItem(FList.Items[Index]^) do
  258.    begin
  259.      VirtKey := Item.VirtKey;
  260.      Modifiers := Item.Modifiers;
  261.    end;
  262.   if Active then RegisterHotKeyNr(Index);
  263. end;
  264.  
  265. function TSysHotKey.GetCount: integer;
  266. begin
  267.   Result := FList.Count;
  268. end;
  269.  
  270. procedure Register;
  271. begin
  272.   RegisterComponents('SheAr', [TSysHotKey]);
  273. end;
  274.  
  275. end.
  276.