unit Unit1; 
 
interface 
 
uses 
  Windows, 
  Messages, 
  SysUtils, 
  Classes, 
  Graphics, 
  Controls, 
  Forms, 
  Dialogs, 
  ExtCtrls; // für "TImage" 
 
type 
 
  TMImage = class(TImage) 
  private 
    unten, drin, merk: Boolean; 
    a, b, ab, a2, b2: integer; 
    p: TPoint; 
  protected 
    procedure setEnabled(Value: boolean); override; 
    procedure MEnter(var EMsg: TMessage); message CM_MouseEnter; 
    procedure MLeave(var LMsg: TMessage); message CM_MouseLeave; 
    procedure setfalse; 
    function cursordrin: boolean; 
    function inside(x, y: integer): boolean; 
  public 
    constructor Create(AOwner: TComponent); override; 
    procedure mousemove(Shift: TShiftState; X, Y: Integer); override; 
    procedure mousedown(Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); override; 
    procedure mouseup(Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); override; 
  end; 
 
  TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormKeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure FormKeyUp(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen }
  end; 
 
const 
  ButtonAnzahl = 3; 
  ersteTaste: char = '1'; 
 
var 
  Form1: TForm1; 
  MI: array[0..ButtonAnzahl - 1] of TMImage; 
  T: integer; 
 
implementation 
 
{$R *.DFM} 
 
//------------- Buttonbetätigung --------------- 
 
procedure Klick(sender: Longint); 
begin 
  (* 
  hierher kommt alles, was beim Loslassen 
  der linken Maustaste passieren soll. 
  0 = 1. Button (MI[0]) 
  1 = 2. Button (MI[1]) 
  usw. 
  Beispielsweise: 
  *) 
  case sender of 
    0: beep; 
    1: showmessage('Button 2'); 
    2: MI[0].enabled := not MI[0].enabled; 
  end; 
end; 
 
//------------- TMImage ---------------------- 
 
constructor TMImage.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  autosize := true; 
  picture.loadfromfile('inaktiv.bmp'); 
  transparent := true; 
  a := round(width / 2); 
  b := round(height / 2); 
  a2 := sqr(a); 
  b2 := sqr(b); 
  ab := a2 * b2; 
end; 
 
procedure TMImage.setfalse; 
begin 
  unten := false; 
  drin := false; 
  merk := false; 
end; 
 
function TMImage.cursordrin: boolean; 
begin 
  getcursorpos(p); 
  p := self.ScreenToClient(p); 
  result := inside(p.x, p.y); 
end; 
 
procedure TMImage.setEnabled(value: boolean); 
begin 
  inherited; 
  setfalse; 
  if enabled then 
  begin 
    if cursordrin then 
    begin 
      picture.loadfromfile('aktiv.bmp'); 
      drin := true; 
    end 
    else 
      picture.loadfromfile('inaktiv.bmp'); 
  end 
  else 
    picture.loadfromfile('disabled.bmp'); 
end; 
 
function TMImage.inside(x, y: integer): boolean; 
begin 
  result := b2 * sqr(a - x) + a2 * sqr(b - y) <= ab; 
end; 
 
procedure TMImage.MEnter(var EMsg: TMessage); 
begin 
  if not enabled then exit; 
  if cursordrin then 
  begin 
    unten := false; 
    merk := false; 
    picture.loadfromfile('aktiv.bmp'); 
  end; 
end; 
 
procedure TMImage.MLeave(var LMsg: TMessage); 
begin 
  if enabled then 
  begin 
    setfalse; 
    picture.loadfromfile('inaktiv.bmp'); 
  end; 
end; 
 
procedure TMImage.mousemove(Shift: TShiftState; X, Y: Integer); 
begin 
  if not enabled then exit; 
  drin := inside(x, y); 
  if (drin <> merk) then 
  begin 
    if drin then 
      picture.loadfromfile('aktiv.bmp') 
    else 
      picture.loadfromfile('inaktiv.bmp'); 
    merk := drin; 
  end; 
end; 
 
procedure TMImage.mousedown(Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if (not drin) or (button <> mbleft) or (not enabled) then exit; 
  unten := true; 
  picture.loadfromfile('unten.bmp'); 
end; 
 
procedure TMImage.mouseup(Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if (button <> mbleft) or (not enabled) then exit; 
  if drin then 
  begin 
    picture.loadfromfile('aktiv.bmp'); 
    if unten then 
      Klick(self.tag); 
  end; 
  unten := false; 
end; 
 
//---------------- TForm1 --------------------------- 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x, abstand, links, oben: integer; 
begin 
  doublebuffered := true; 
  keypreview := true; 
  T := ord(upcase(ersteTaste)); 
  oben := 15; 
  links := 20; 
  abstand := 10; 
  for x := 0 to ButtonAnzahl - 1 do 
  begin 
    MI[x] := TMImage.create(self); 
    MI[x].parent := self; 
    MI[x].top := oben; 
    MI[x].left := links + x * (MI[x].width + abstand); 
    MI[x].tag := x; 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var 
  x: integer; 
begin 
  for x := 0 to ButtonAnzahl - 1 do MI[x].free; 
end; 
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var 
  i: integer; 
begin 
  i := key - T; 
  if (Shift <> [ssCtrl]) or (i >= ButtonAnzahl) or (i < 0) or MI[i].drin 
    or (MI[i].enabled = false) then exit; 
  MI[i].drin := true; 
  MI[i].unten := true; 
  MI[i].picture.loadfromfile('unten.bmp'); 
end; 
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var 
  i: integer; 
begin 
  i := key - T; 
  if (Shift <> [ssCtrl]) or (i >= ButtonAnzahl) or (i < 0) 
    or (MI[i].enabled = false) then exit; 
  if MI[i].cursordrin then 
    exit; 
  MI[i].setfalse; 
  MI[i].picture.loadfromfile('inaktiv.bmp'); 
  Klick(i); 
end; 
 
end.