안녕 하세요?

BacTeria 박종민 입니다.

아래 내용은 워낙 일반화된 팁이라... 모르시는 분이 있을런지.

하여간 Caption Bar에 버튼 달기 예제 입니다.

- 델파이의 부흥을 위해... 델파이 만세~

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMLButtonUp(var Msg: TWMLButtonUp);         message WM_LBUTTONUP;
    procedure WMNCHitTest(var Msg: TWMNCHitTest);         message WM_NCHITTEST;
    procedure WMNCActivate(var Msg: TWMNCActivate);       message WM_ACTIVATE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  ButtonRect: TRect;
  ButtonDown: Boolean;
  ButtonFaceDown: Boolean;
  BX, FX, BY, FY, CY: integer;

implementation

{$R *.DFM}

uses Buttons;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ButtonDown := False;
  ButtonFaceDown := False;
  BX := GetSystemMetrics(SM_CXSIZE);
  FX := GetSystemMetrics(SM_CXSIZEFRAME);
  BY := GetSystemMetrics(SM_CYSIZE);
  CY := GetSystemMetrics(SM_CYCAPTION);
  FY := GetSystemMetrics(SM_CYSIZEFRAME);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  TempHDC: HDC;
begin
  ButtonRect := Bounds(ClientWidth-BX*4, FX+2, BX-2, BY-4);

  TempHDC := Canvas.Handle;
  Canvas.Handle := GetWindowDC(Handle);
  DrawButtonFace(Canvas, ButtonRect, 1, bsAutoDetect, false, ButtonFaceDown, false);
  ReleaseDC(Handle, Canvas.Handle);
  Canvas.Handle := TempHDC;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Repaint;
end;

procedure TForm1.WMLButtonUp(var Msg: TWMLButtonUp);
begin
 if ButtonDown then
 begin
   if PtInRect(ButtonRect, Point(Msg.XPos+FX, Msg.YPos+FY+CY)) then ShowMessage('Button Click');

   ButtonDown := False;
   ButtonFaceDown := False;
   Repaint;
   ReleaseCapture;
   Msg.Result := 0;
  end else inherited;
end;

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
  inherited;

  Repaint;
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  Inherited;

  if PtInRect(ButtonRect, Point(Msg.XPos-Left, Msg.YPos-Top)) then Msg.Result := htSysMenu;
end;

procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
  Inherited;

  if PtInRect(ButtonRect, Point(Msg.XCursor-Left, Msg.YCursor-Top)) then
  begin
    ButtonDown := True;
    ButtonFaceDown := True;
    Repaint;
    SetCapture(Handle);
    Msg.Result := 0;
  end;
end;

end.