// Wer bunte Buttons braucht, kann sich auch mit der Komponente TPanel
// behelfen. Im Folgenden werden 3 Button aus Panels erzeugt, die mit
//
Panel1...Panel3 benannt sind.
// Zusätzlich hat der aktive Button eine hellere Farbe und kann nicht nur
// mit der Maus sondern auch mit der Leertaste betätigt werden.

// Getestet mit D4 unter WinME

...
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
// nur für DEMO
procedure FormCreate(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1Enter(Sender: TObject);
procedure Panel1Exit(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private-Deklarationen }
public
procedure
PUnten(P:TPanel);
procedure POben(P:TPanel);
procedure Farbe(P:TPanel);
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

const
oben=10;
links=10;
breit=33;
hoch=33;
unten:boolean=false;

var tmp:TPanel;

procedure TForm1.PUnten(P:TPanel);
begin
P.bevelInner:=bvLowered;
P.bevelOuter:=bvLowered;
// hier folgt alles, was in gedrücktem Zustand passieren soll,
// z.B.
label1.caption:=p.name+' ist gedrückt';
end;

procedure
TForm1.POben(P:TPanel);
begin
P.bevelInner:=bvRaised;
P.bevelOuter:=bvRaised;
// hier folgt alles, was nach dem Loslassen passieren soll,
// z.B.
// label1.caption:=p.name+' wurde eben losgelassen';
// oder vielleicht so etwas:
if p=Panel1 then label1.caption:='WEISS';
end;

procedure
TForm1.FormCreate(Sender: TObject);
var
x:integer;
begin
// das Folgende kann auch im Objektinspektor eingestellt werden ------
keypreview:=true;
for x:=0 to 2 do begin
with TPanel(findcomponent('Panel'+inttostr(x+1))) do begin
width:=breit;
height:=hoch;
left:=links+x*breit;
top:=oben;
bevelInner:=bvRaised;
bevelOuter:=bvRaised;
bevelWidth:=1;
onMouseDown:=Panel1MouseDown;
onMouseUp:=Panel1MouseUp;
onEnter:=Panel1Enter;
onExit:=Panel1Exit;
caption:='';
TabStop:=true;
case x of
0:color:=clsilver;
1:color:=clolive;
else color:=clgreen;
end;
end;
end;
//-----------------------------------------------------------------------
end;

procedure
TForm1.Farbe(P:TPanel);
begin
case
p.color of
clsilver:p.color:=clwhite;
clolive:p.color:=clyellow;
clgreen:p.color:=cllime;
clwhite:p.color:=clsilver;
clyellow:p.color:=clolive;
cllime:p.color:=clgreen;
end;
end;

procedure
TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
tmp:=TPanel(sender);
tmp.setfocus;
PUnten(tmp);
end;

procedure
TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
POben(TPanel(sender));
end;

procedure
TForm1.Panel1Enter(Sender: TObject);
begin
tmp:=Tpanel(sender);
farbe(tmp);
end;

procedure
TForm1.Panel1Exit(Sender: TObject);
begin
farbe(Tpanel(sender));
end;

procedure
TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if
(key=32)and(not unten)and(activecontrol=tmp) then begin
unten:=true;
PUnten(tmp);
end;
end;

procedure
TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if
(key=32)and(activecontrol=tmp) then begin
POben(tmp);
unten:=false;
end;
end;


 

Zugriffe seit 6.9.2001 auf Delphi-Ecke