// Wenn man
BorderStyle = bsNone
setzt, fehlen natürlich auch die
// Buttons im Caption-Bereich
(Minimieren, Maximieren, Schließen).
Im
// Folgenden wird gezeigt, wie man die Button für
Schließen
und
//
Minimieren
zeichnen lassen kann
(bei BorderStyle = bsNone gibt es
// normalerweise kein
Maximieren),
wobei man die Buttongröße selbst
// bestimmt.
// Getestet mit D2010 unter
W7
...
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private-Deklarationen }
public
procedure zeichnen;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
dc: HDC;
closerect, minirect: TRect;
buttongroesse: integer = 25;
minioben: boolean = true;
closeoben: boolean = true;
procedure TForm1.FormCreate(Sender: TObject);
begin
borderstyle := bsnone;
position := poscreencenter;
dc := getwindowdc(handle);
closerect := rect(clientwidth - buttongroesse - 5, 5, clientwidth - 5,
buttongroesse + 5);
minirect := rect(clientwidth - buttongroesse * 2 - 7, 5, clientwidth -
buttongroesse - 7, buttongroesse + 5);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
releasedc(handle, dc);
end;
procedure TForm1.zeichnen;
begin
DrawFrameControl(dc, closerect, DFC_CAPTION, DFCS_CAPTIONCLOSE
or ord(not closeoben) * DFCS_PUSHED);
DrawFrameControl(dc, minirect, DFC_CAPTION, DFCS_CAPTIONMIN
or ord(not minioben) * DFCS_PUSHED);
end;
procedure TForm1.FormPaint(Sender: TObject);
var x: integer;
begin
zeichnen;
// ---------- Kante ums Formular zeichnen ------------
with canvas do begin
pen.color := clbtnhighlight;
for x := 0 to 1 do begin
moveto(clientwidth - x, x);
lineto(x, x);
lineto(x, clientheight - x);
end;
pen.color := clbtnshadow;
for x := 0 to 1 do begin
moveto(clientwidth - x - 1, x);
lineto(clientwidth - x - 1, clientheight - x - 1);
lineto(x, clientheight - x - 1);
end;
end;
// ----------------------------------------------------
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ptinrect(closerect, point(x, y)) then begin
closeoben := false;
zeichnen;
end else
if ptinrect(minirect, point(x, y)) then begin
minioben := false;
zeichnen;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not closeoben then begin
closeoben := true;
zeichnen;
if ptinrect(closerect, point(x, y)) then close;
end;
if not minioben then begin
minioben := true;
zeichnen;
if ptinrect(minirect, point(x, y)) then application.minimize;
end;
end;
|