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



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke