Четвёртая кнопка на заголовочной полосе окна

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

unit Unit1;

interface

uses

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

ComCtrls, ExtCtrls, StdCtrls;

const

wm_BtnClk = wm_User 111;{Определяем своё сообщение}

type

TForm1 = class(TForm)

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

R: TRect;{Переменная для обозначения прямоугольной области кнопки}

Press: Boolean;

procedure WmNcPaint(var Msg: TWmNcPaint); message wm_NcPaint;

procedure WMNcActivate(var msg: TwmncActivate); message wm_NcActivate;

procedure WmNcLButtonDown( var Msg: TWMNCLBUTTONDOWN); message Wm_NCLbuttonDown;

procedure wmnchittest(var Msg: TWMncHITTEST); message wm_NcHittest;

procedure wmSize(var Msg: TMessage); message wm_Size;

procedure wmncLButtonUp(var msg: TWMncLBUTTONUP); message wm_NclButtonUp;

procedure wmLbuttonUp(var Msg: TMessage); message wm_LbuttonUp;

procedure wmBtnClk(var msg: TMessage); message wm_BtnClk;

public

{ Public declarations }

procedure DrawBtn;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.WmNcPaint(var Msg: TWmNcPaint);

begin

inherited;

Drawbtn;{При перерисовке окна прорисовываем кнопку}

end;

procedure TForm1.DrawBtn;{Код прорисовки кнопки}

var

WDc: HDc;

Cx, Cy: Integer;

XFrame, Yframe: Integer;

begin

{Получаем контекст нашего окна, снимаем мерки с оконных размеров,

вычисляем положение нашей кнопки и прорисовываем её в зависимости

от того нажата ли кнопка мыши над ней}

WDc := GetWindowDc(Handle);

Cx := GetSystemMetrics(SM_CXSize);

Cy := GetSystemMetrics(SM_CYSize);

xFrame := GetSystemMetrics(SM_CXFrame);

yFrame := GetSystemMetrics(SM_CYFrame);

R := Bounds(Width — xFrame — 4*Cx 2, yFrame 2, Cx — 2, Cy — 4);

if Press then

DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH or DFCS_PUSHED)

else

DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH);

ReleaseDc(Handle,WDC);

end;

procedure TForm1.WMNcActivate(var msg: TwmncActivate);

begin

inherited;

DrawBtn;

end;

procedure TForm1.WmNcLButtonDown(var Msg: TWMNCLBUTTONDOWN);

var

pt: TPoint;

begin

inherited;

drawbtn;

pt := Point(msg.XCursor — Left,msg.YCursor — top);

if PtInRect(R,pt) then

begin

Press := True;

drawbtn;

end;

end;

procedure TForm1.wmnchittest(var Msg: TWMncHITTEST);

var

pt: tpoint;

begin

inherited;

pt :=Point(msg.XPos — Left, msg.YPos — Top);

if PtinRect(r,pt) then

msg.Result := htBorder;

end;

procedure TForm1.wmSize(var Msg: TMessage);

begin

inherited;

RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT

or RDW_INVALIDATE);

end;

procedure TForm1.wmncLButtonUp(var msg: TWMncLBUTTONUP);

var

pt: TPoint;

begin

inherited;

pt := Point(msg.XCursor — Left,msg.YCursor — top);

if PtInRect(R,pt) then

begin

Press := False;

drawbtn;

PostMessage(Handle,wm_btnClk,0,0);

end;

end;

procedure TForm1.wmLbuttonUp(var Msg: TMessage);

begin

inherited;

if Press then

begin

Press := False;

DrawBtn;

end;

end;

procedure TForm1.wmBtnClk(var msg: TMessage);

begin

{Объявили константу своего сообщения,

посылаем его своему окну при отпускании кнопки мыши над новой кнопкой,

а здесь обрабатываем своё сообщение}

ShowMessage(‘О, круто, наша кнопка нажимается! Спасибо проекту Delphi World!’);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT

or RDW_INVALIDATE);

end;

end.

{/codecitation}

Добавить комментарий