// 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;
|