Как добавить свою кнопку в заголовок окна?

← →
kerrik © (2002-09-27 23:45) [0]

Как добавить свою кнопку в заголовок окна? Там, где кнопки минимизации, раскрытия во весь экран и закрытия окна... Желательно пример. Заранее спасибо...

← →
Юрий Зотов © (2002-09-27 23:53) [1]

Или использовать готовый компонент (см. на Torry), или ручками, перехватывая сообщения формы.

Отрисовка - через DrawFrameControl. Плюс обработка WM_NCPAINT и еще кучи сообщений, связанных с изменением заголовка или стиля окна.

← →
kerrik © (2002-10-02 19:41) [2]

А интересный компонент на эту тему не подскажите? Или всё-таки пример найдётся? Заранее благодарен...

← →
Юрий Зотов © (2002-10-03 01:40) [3]

Вот пример. Не судите слишком строго, это всего лишь набросок на скорую руку. Однако, работает, и даже лучше, чем все остальное, что я видел на эту тему (учитываются захват мыши другим окном, изменения текста Caption и системных настроек). Если делать более строго, надо вводить флаг состояния кнопки и разруливать с его учетом.

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;
// procedure WMCaptureChanged(var Message: TWMCaptureChanged); message WM_CAPTURECHANGED;
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.

← →
NewI © (2002-10-03 04:02) [4]

Полный пример ищи где-то на этом сайте.

Ушло на мыло.

← →
vitVitVit (2002-10-03 15:02) [6]

Elpack - TElFormCaption

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