try
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
//Define a smaller drawing rectangle within the button
R := Bounds(Width - xFrame - 4 * xSize + 2,
yFrame + 3, xSize - 6, ySize - 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
inherited;
with Msg do
if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
Result := htCaptionBtn;
end;
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htCaptionBtn) then
ShowMessage('You hit the button on the caption bar');
end;
procedure TForm1.FormResize(Sender: TObject);
begin
//Force a redraw of caption bar if form is resized
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
end.
Автор: Tercio Ferdinando Gaudencio Filho
Приведённый здесь код создаёт кнопку в заголовке окна, создаёт MenuItem в системном меню и создаёт подсказку(Hint) в кнопке. Поместите код в Ваш Unit и замените "FrmMainForm" на Ваше имя формы, а так же некоторые кусочки кода, ткст подсказки и т.д.
procedure TFrmMainForm.WMSYSCOMMAND(var Msg: TMessage);
begin
if Msg.WParam=LongInt(NovoMenuHandle) then
//*********************************************
//Кнопка была нажата! Добавьте сюда Вашу функцию
//*********************************************
inherited;
end;
procedure TFrmMainForm.WMLBUTTONUP(var Msg: TMessage);
var
Tmp : Boolean;
begin
ReleaseCapture;
Tmp := Pressed;
Pressed := False;
if Tmp and PTInRect(Rec, PT1) then
begin
InvalidateRect(FrmMainForm.Handle, @Rec, True);
FHintShow := False;
FHint.ReleaseHandle;
//*********************************************
//Кнопка была нажата! Добавьте сюда Вашу функцию
//*********************************************
end
else
inherited;
end;
//Создаём квадратную кнопку, но если Вы захотите создать кнопку другого размера, то
//измените эту переменную на Вашу ширину.
Btn_Width := Border3D_Y + Border_Thickness + Button_Height - (2 * Border3D_Y) - 1;
Rec.Left := FrmMainForm.Width - (3 * Button_Width + Btn_Width);
Rec.Right := FrmMainForm.Width - (3 * Button_Width + 03);
Rec.Top := Border3D_Y + Border_Thickness - 1;
Rec.Bottom := Rec.Top + Button_Height - (2 * Border3D_Y);
FillRect(MyCanvas.Handle,Rec,HBRUSH(COLOR_BTNFACE+1));
If not Pressed or Focuslost Then
DrawEdge(MyCanvas.Handle, Rec, EDGE_RAISED, BF_SOFT or BF_RECT)
Else If Pressed and Not Focuslost Then
DrawEdge(MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or BF_RECT);
//It draw a the application icon to the button. Easy to change.
DrawIconEX(MyCanvas.Handle, Rec.Left+4, Rec.Top+3, Application.Icon, 8, 8, 0, 0, DI_NORMAL);
InsertMenu(GetSystemMenu(Handle,False), 4, MF_BYPOSITION+MF_STRING, NovoMenuHandle,pchar('TEXT OF THE MENU'));
Rec := Rect(0,0,0,0);
FHintText := 'Put the text of your Hint HERE';
FHint := THintWindow.Create(Self);
FHint.Color := clInfoBk; //Вы можете изменить бэкграунд подсказки
...
Взято из
Вы хотите добавить кнопку в панель заголовка вашего формы в Delphi. Это возможно, но требует некоторых workaround, поскольку Delphi не имеет встроенной поддержки для этого.
Приведенный код - это пример, как достичь этого. Он использует различные сообщения Windows (например, WM_ NCPAINT, WM_NCACTIVATE и т.д.) для рисования прямоугольника, похожего на кнопку, и обработки событий мыши.
Вот некоторые ключевые точки:
Процедура DrawCaptButton рисует кнопку в панели заголовка.
Процедура WMNCPaint используется для перерисовки кнопки при изменении размера формы или других изменениях.
Процедуры WMNCActivate, WMSetText и WMNCHitTest используются для обработки различных событий, связанных с активацией, текстом и тестированием нажатия на кнопку.
Процедура WMNCLButtonDown обрабатывает событие нажатия мыши на кнопке.
Процедура FormResize forcing перерисовки панели заголовка при изменении размера формы.
В ответ на ваш вопрос о том, как добавить дополнительную кнопку в панель заголовка, вы можете попробовать модифицировать переменную Rec в процедуре DrawCaptButton, чтобы позиционировать новую кнопку.
Например, вы можете добавить еще один прямоугольник к переменной Rec и нарисовать вторую кнопку внутри него. Вам также нужно будет обновить логику тестирования нажатия в процедуре WMNCHitTest, чтобы обработать новую кнопку.
Обратите внимание, что это только примерный код, и вам, вероятно, придется модифицировать его для соответствия вашим конкретным требованиям. Кроме того, помните, что добавление кнопок в панель заголовка может иметь неожиданные последствия, такие как нарушение функциональности системного меню или создание проблем с управлением окнами.
Вот пример модифицированной процедуры DrawCaptButton, которая добавляет еще одну кнопку:
procedureTForm1.DrawCaptButton;varxFrame,yFrame,xSize,ySize:Integer;R:TRect;begin// Размеры рамки для размераxFrame:=GetSystemMetrics(SM_CXFRAME);yFrame:=GetSystemMetrics(SM_CYFRAME);// Размеры кнопок заголовкаxSize:=GetSystemMetrics(SM_CXSIZELABEL);ySize:=GetSystemMetrics(SM_CYSIZELABEL);// Определение расположения новой кнопки заголовкаRec.Left:=Width-(2*xFrame+xSize)+1;Rec.Top:=yFrame+1;Rec.Right:=Rec.Left+xSize;Rec.Bottom:=Rec.Top+ySize;Canvas.Handle:=GetWindowDC(Handle);...end;
В этом примере я добавил еще один прямоугольник к переменной Rec и позиционировал его слегка смещенным от оригинальной кнопки. Вы можете изменить координаты, как вам нужно.
Помните обновить логику тестирования нажатия в процедуре WMNCHitTest, чтобы обработать новую кнопку:
Это только примерный код, и вам, вероятно, придется модифицировать его для соответствия вашим конкретным требованиям.
Добавляем дополнительную кнопку в заголовок формы.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал