Thema: Delphi BorderIcons

Einzelnen Beitrag anzeigen

MrKnogge

Registriert seit: 9. Jun 2003
Ort: Pforzheim
2.458 Beiträge
 
Delphi 2007 Professional
 
#4

Re: BorderIcons

  Alt 14. Jun 2004, 16:24
ansonsten einfach mal nach "CaptionBar" suchen, ich glaub auf www.delphimania.de hab ich unter Tipps mal einen Beispielcode gesehen.

[edit]Habs gefunden:

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons;

type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
  private
    { Private-Deklarationen }
    CaptionBtn : TRect;
    procedure DrawCaptButton;
    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
    procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
    procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
    procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

const
  htCaptionBtn = htSizeLast + 1;

implementation

{$R *.DFM}

procedure TForm1.DrawCaptButton;
var
  xFrame,
  yFrame,
  xSize,
  ySize : Integer;
  R : TRect;
begin
  //Dimensions of Sizeable Frame
  xFrame := GetSystemMetrics(SM_CXFRAME);
  yFrame := GetSystemMetrics(SM_CYFRAME);

  //Dimensions of Caption Buttons
  xSize := GetSystemMetrics(SM_CXSIZE);
  ySize := GetSystemMetrics(SM_CYSIZE);

  //Define the placement of the new caption button
  //next to the existing caption buttons
  CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
                       yFrame + 2, xSize - 2, ySize - 4);

  //Get the handle to canvas using Form's device context
  Canvas.Handle := GetWindowDC(Self.Handle);

  Canvas.Font.Name := 'Symbol';
  Canvas.Font.Color := clBlue;
  Canvas.Font.Style := [fsBold];
  Canvas.Pen.Color := clYellow;
  Canvas.Brush.Color := clBtnFace;

  try
    DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
    //Define a smaller drawing rectangle within the button
    R := Bounds(Width - xFrame - 4 * xSize + 2,
                       yFrame + 3, xSize - 6, ySize - 7);
    with CaptionBtn do
      Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');
  finally
    //Get rid of the device context and set the
    //canvas handle to default
    ReleaseDC(Self.Handle, Canvas.Handle);
    Canvas.Handle := 0;
  end;
end;

//This traps the default form painting
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
  inherited;
  DrawCaptButton;
end;

//This traps form activation
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
  inherited;
  DrawCaptButton;
end;

//This traps any text being sent to the window
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
  inherited;
  DrawCaptButton;
end;

//This traps when the form's caption bar is hit with a mouse
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
  inherited;
  with Msg do
    if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
      Result := htCaptionBtn;
end;

//Traps a left-click on the caption bar
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
  inherited;
  if (Msg.HitTest = htCaptionBtn) then
    ShowMessage('You hit the button on the caption bar');
end;

//Have to perform an NC_ACTIVATE when the form is resized
//so that the caption bar and button are redrawn. This is
//necessary because Win95/NT4+ draw all buttons relative to the
//right side of a window.
procedure TForm1.FormResize(Sender: TObject);
begin
  //Force a redraw of caption bar if form is resized
  Perform(WM_NCACTIVATE, Word(Active), 0);
end;

end.
[/edit]

[edit=Sharky]Doppelposting geslöscht. Danke für die Info von Dir. Mfg, Sharky[/edit]
Christian Bootz
Einstein ist tot, Newton ist tot,
und mir ist auch schon ganz schlecht...
  Mit Zitat antworten Zitat