1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, Menus;

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    keys:array[0..255] of boolean;
    grid:TStringGrid;
    menu:TMainMenu;
    procedure Menu_Datei(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  x,y:integer;
  m:TMenuItem;
begin
  //StringGrid initialisieren und mit 256 Werten füllen:
  grid:=TStringGrid.Create(self);
  grid.Parent:=self;
  with grid do begin
    align:=alClient;
    defaultdrawing:=false;
    ondrawcell:=StringGridDrawCell;
    fixedcols:=0;
    fixedrows:=0;
    colcount:=16;
    rowcount:=16;
    for y:=0 to 15 do
      for x:=0 to 15 do
        cells[x,y]:=inttostr(y*16+x);
    for x:=0 to 15 do
      colwidths[x]:=32;
    tabstop:=false;
  end; {with}
  //Tastatur-Merker initialisieren:
  fillchar(keys,sizeof(keys),0);
  //Hauptmenü erzeugen:
  menu:=TMainMenu.Create(self);
  m:=TMenuItem.Create(self);
  m.OnClick:=Menu_Datei;
  //Der Menüeintrag soll sowohl auf ALT+D als auch auf STRG+F reagieren:
  m.Caption:='&Datei';
  m.ShortCut:=ShortCut(Word('F'), [ssCtrl]);
  menu.Items.Add(m);
end;

procedure TForm1.Menu_Datei;
begin
  showmessage('Dies wäre der Datei-Dialog');
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if key<=255 then keys[key]:=true;
  grid.Invalidate;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if key<=255 then keys[key]:=false;
  grid.Invalidate;
end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  key:integer;
begin
  key:=ARow*16+ACol;
  with grid,canvas do begin
    brush.Style:=bsSolid;
    if keys[key] then brush.Color:=clRed
      else brush.Color:=clWindow;
    textrect(rect,rect.Left,rect.Top,cells[ACol,ARow]);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  grid.Free;
  menu.Free;
end;

end.					

1:
2:
3:
4:
5:
6:

procedure TForm1.FormDeactivate(Sender: TObject);
var
  i:integer;
begin
  fillchar(keys,sizeof(keys),0);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:

Unit KeyMapper;

Interface

Uses
    Windows,
    Forms;

Type
    TKeyMapper = Class
    Private
        App: TApplication;
        Key: Array[0..256] Of Boolean;
    Public
        Constructor Create(AApp: TApplication);
        Destructor Destroy; Override;
        Procedure WndProc(Var Msg: TMsg; Var Handled: Boolean);
    End;

Implementation

Uses
    SysUtils,
    Messages;

Constructor TOCtrlKeyMapper.Create(AApp: TApplication);
Begin
    FillChar(Key, SizeOf(Key), False);
    AApp.OnMessage := WndProc;
    App := AApp;
End;

Destructor TOCtrlKeyMapper.Destroy;
Begin
    App.OnMessage := Nil;
    App := Nil;
End;

Procedure TOCtrlKeyMapper.WndProc(Var Msg: TMsg; Var Handled: Boolean);
Begin
    Case Msg.Message Of
        wm_KeyUp:
            Self.Key[Msg.wParam] := False;
        wm_KeyDown:
            Self.Key[Msg.wParam] := True;
    End;
End;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

Type
 tForumX = Class(...)
  ...
  KeyMapper: tOCtrlKeyMapper;
  ...
 End;

Function tFormX.onCreate(...);
Begin
 KeyMapper:=tKeyMapper.Create(Application);
End;