Добавить свою кнопку в заголовок окна...

← →
LyzD © (2003-03-30 17:01) [0]

Подскажите, пожалуйста.

Как можно добавить свою кнопку в заголовок окна... Хочется добавить кнопку типа "Закрепить положение окна"...

← →
Юрий Зотов © (2003-03-30 22:28) [1]

unit Unit1;

interface

uses
Windows, Messages, Classes, Controls, Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit; // Только для демонстрации
procedure FormCreate(Sender: TObject); // OnCreate
procedure Edit1Change(Sender: TObject); // Edit1.OnChange
private
function DrawButton(State: Cardinal): boolean;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown ); message WM_NCLBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMLButtonUp ); message WM_LBUTTONUP;
protected
procedure WndProc(var Message: TMessage); override;
public
procedure ButtonClick;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := Caption
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
Caption := Edit1.Text
end;

procedure TForm1.ButtonClick;
begin
ShowMessage("Click!")
end;

function TForm1.DrawButton(State: Cardinal): boolean;
var
P: TPoint;
R: TRect;
DC: HDC;
Flags: Cardinal;
begin
GetCursorPos(P);
Dec(P.X, Left);
Dec(P.Y, Top);
R.Right := Width - 3 * GetSystemMetrics(SM_CXSMSIZE);
R.Left := R.Right - 75;
R.Top := GetSystemMetrics(SM_CYFRAME) + 2;
R.Bottom := R.Top + GetSystemMetrics(SM_CYSIZE) - 4;
Result := PtInRect(R, P);
if (R.Right > R.Left) and ((State = 0) or Result) then
begin
DC := GetWindowDC(Handle);
try
DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONPUSH or State);
R.Right := R.Left;
R.Left := GetSystemMetrics(SM_CXFRAME);
Flags := DC_ICON or DC_TEXT;
if GetForegroundWindow = Handle then Flags := Flags or DC_ACTIVE;
DrawCaption(Handle, DC, R, Flags)
finally
ReleaseDC(Handle, DC)
end
end
end;

procedure TForm1.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
if DrawButton(DFCS_PUSHED) then SetCapture(Handle) else inherited
end;

procedure TForm1.WMLButtonUp(var Message: TWMLButtonUp);
begin
if GetCapture = Handle then ReleaseCapture;
if DrawButton(0) then ButtonClick else inherited
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_ACTIVATE, WM_PAINT, WM_WINDOWPOSCHANGING, WM_SETTEXT, WM_WININICHANGE, WM_CAPTURECHANGED:
DrawButton(0)
end
end;

end.

← →
Yorick © (2003-03-31 02:05) [2]

А вообще компонент в кладовке такой есть

← →
Intell © (2003-03-31 20:40) [3]

E У меня тоже компонент. Если не устроит компонент, есть исходник.
sergein@nojabrsk.ru

Пробовал такие штуки делать под WinXP - так там после этих приколов заголовок перестает использовать стили XP - становится похож на стандартный (только уродливей :)
Может это лечится?

Добавить свою кнопку в заголовок окна... Найти похожие ветки