Добавляем дополнительную кнопку в заголовок формы

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

Оформил: DeeCo

Автор: Vimil Saju

Чтобы добавить дополнительную кнопку, нам прийдётся создать обработчики для следующих событий:

WM_NCPAINT;//вызывается, когда перерисовывается не клиентская область формы

WM_NCACTIVATE; вызывается, когда заголовок формы становится активныи

WM_NCLBUTTONDOWN; вызывается, когда кнопка мыши нажимается на не клиентской области

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

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

WM_LBUTTONUP; вызывается, когда кнопка мыши отпушена в клиентской области

WM_NCLBUTTONUP; вызывается, когда кнопка мыши отпушена в не клиентской области

WM_NCLBUTTONDBLCLK; вызывается при двойном щелчке мышкой в не клиентской области

Приведённый ниже код модифицирован, чтобы избавиться от нежелательного мерцания кнопки

будем использовать следующие переменные:

h1(Thandle) : хэндл контекста устройства всего окна, включая не клиентскую область.

pressed(boolean): индикатор, показывающий, нажата кнопка или нет.

focuslost(boolean): индикатор, показывающий, находится ли фокус на кнопке или нет.

rec(Trect): размер кнопки.

Собственно сам исходник:

type

TForm1 = class(TForm)

procedure FormPaint(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure FormCreate(Sender: TObject);

private { Private declarations

} public procedure

WMNCPAINT(var msg: tmessage); message WM_NCPAINT;

procedure WMNCACTIVATE(var

msg: tmessage); message WM_NCACTIVATE;

procedure

WMNCMOUSEDOWN(var msg: tmessage); message WM_NCLBUTTONDOWN;

procedure WMNCMOUSEMOVE(var

msg: tmessage); message WM_NCMOUSEMOVE;

procedure WMMOVE(var msg: tmessage); message

WM_MOUSEMOVE;

procedure WMLBUTTONUP(var

msg: tmessage); message WM_LBUTTONUP;

procedure

WMNCMOUSEUP(var msg: tmessage); message WM_NCLBUTTONUP;

procedure WNCLBUTTONDBLCLICK(var

msg: tmessage); message WM_NCLBUTTONDBLCLK;

end;

var

Form1: TForm1;

h1: thandle;

pressed: boolean;

focuslost: boolean;

rec: trect;

implementation{$R *.DFM}

procedure tform1.WMLBUTTONUP(var msg: tmessage);

begin

pressed := false;

invalidaterect(form1.handle, @rec, true);

inherited;

end;

procedure tform1.WMMOVE(var msg: tmessage);

var

tmp: boolean

begin

tmp := focuslost;

focuslost := true;

if tmp focuslost then

invalidaterect(form1.handle, @rec, true);

inherited;

end;

procedure tform1.WMNCMOUSEMOVE(var msg: tmessage);

var

pt1: tpoint;

tmp: boolean;

begin

tmp := focuslost;

pt1.x := msg.LParamLo — form1.left;

pt1.y := msg.LParamHi — form1.top;

if not (ptinrect(rec, pt1)) then

focuslost := true

else

focuslost := false;

if tmp focuslost then

invalidaterect(form1.handle, @rec, true);

end;

procedure tform1.WNCLBUTTONDBLCLICK(var msg: tmessage);

var

pt1: tpoint;

begin

pt1.x := msg.LParamLo — form1.left;

pt1.y := msg.LParamHi — form1.top;

if not (ptinrect(rec, pt1)) then

inherited;

end;

procedure

tform1.WMNCMOUSEUP(var msg: tmessage);

var

pt1: tpoint;

begin

pt1.x := msg.LParamLo — form1.left;

pt1.y := msg.LParamHi — form1.top;

if (ptinrect(rec, pt1)) and (focuslost = false) then

begin

pressed := false; {

enter your code here when the button is

clicked }

invalidaterect(form1.handle, @rec, true);

end

else

begin

pressed := false;

focuslost := true;

inherited;

end;

end;

procedure tform1.WMNCMOUSEDOWN(var msg: tmessage);

var

pt1: tpoint;

begin

pt1.x := msg.LParamLo — form1.left;

pt1.y := msg.LParamHi — form1.top;

if ptinrect(rec, pt1) then

begin

pressed := true;

invalidaterect(form1.handle, @rec, true);

end

else

begin

form1.paint;

inherited;

end;

end;

procedure

tform1.WMNCACTIVATE(var msg: tmessage);

begin

invalidaterect(form1.handle, @rec, true);

inherited;

end;

procedure tform1.WMNCPAINT(var msg: tmessage);

begin

invalidaterect(form1.handle, @rec, true);

inherited;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

h1 := getwindowdc(form1.handle);

rec.left := form1.width — 75;

rec.top := 6;

rec.right := form1.width — 60;

rec.bottom := 20;

selectobject(h1, getstockobject(ltgray_BRUSH));

rectangle(h1, rec.left, rec.top, rec.right, rec.bottom);

if

(pressed = false) or (focuslost = true) then

drawedge(h1, rec, EDGE_RAISED, BF_RECT)

else if

(pressed = true) and (focuslost = false) then

drawedge(h1, rec, EDGE_SUNKEN, BF_RECT);

releasedc(form1.handle, h1);

end;

procedure

TForm1.FormResize(Sender: TObject);

begin

form1.paint;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

rec.left := 0;

rec.top := 0;

rec.bottom := 0;

rec.right := 0;

end;

Комментарии специалистов:

Дата: 25 Августа 2000г.

Автор: NeNashevnashev@mail.ru

InvalidateRect на событие Resize ничего не даёт. Но даже без него

кнопка всё равно моргает при Resize формы… Надо ещё где-то убрать

Для рисования кнопок на заголовке окна лучше пользоваться

DrawFrameControl а не DrawEdge… Так и с не серыми настройками

интерфейса всё правильно будет. Да и проще так.

Названия функций, констант и т.п лучше писать так, как они в описаниях

даются, а не подряд маленькими буквами. Особенно для публикации. Так

оно и читается по большей части лучше, и в С такая привычка Вам не

помешает…

Сравнивать логическое значение с логической константой чтоб получить

логическое значение глупо, так как логическое значение у Вас уже есть.

тоесь вместо

if (pressed=true) and (focuslost=false)

лучше писать

if Pressed and not FocusLost

Для конструирования прямоугольников и точек из координат есть две

простые функции Rect и Point.

В общем Ваша процедура FormPaint может выглядеть так:

procedure

TMainForm.FormPaint(Sender:

TObject);

var

h1: THandle;

begin

h1 := GetWindowDC(MainForm.Handle);

rec := Rect(MainForm.Width — 75, 6, MainForm.Width — 60, 20);

if

Pressed and not FocusLost then

DrawFrameControl(h1, rec, DFC_BUTTON,

DFCS_BUTTONPUSH or DFCS_PUSHED)

else

DrawFrameControl(h1, rec,

DFC_BUTTON,

DFCS_BUTTONPUSH);

ReleaseDC(MainForm.Handle, h1);

end;

Но вообще-то рисовать эту кнопку надо только при WM_NCPAINT, а не

всегда… И вычислять координаты по другому… Вдруг размер элементов

заголовка у юзера в системе не стандартный? А это просто настраивается…

{/codecitation}

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