Как разместить ComboBox в заголовке формы? Или CheckBox? Или DateTimePicker? Если кнопку (вернее, эмуляцию кнопки) можно «запихать» в заголовок формы, то что делать с другими компонентами?
Есть несколько вполне рабочих трюков. Один из них сейчас рассмотрим.
Понятно, что под заголовком подразумеваем совсем не заголовок формы. От него мы избавились в предыдущей статье. Давайте сделаем панель, куда закинем то, что хотели бы видеть в заголовке, и немного поэкспериментируем.
Панель — заголовок
Итак, берем исходник из уже упомянутой статьи и немного модифицируем.
Во-первых, теперь мы рисуем только в GDI+. Модули, представленные в статье «Как подключить GDI+ для Delphi 7 и не иметь проблем в XE«, хорошо себя показали. В связи с чем, убираем галку «GDI+», ибо смысла в ней больше нет.
Во-вторых, кидаем Panel поверх PaintBox‘а, в котором рисуется версия Windows. Это будет заголовок окна. Ни выравнивания, ни Anchors не задаем. Так надо )
В-третьих, переносим Label «Close Alt+F4» на эту панель. Пока так, вместо системных кнопок. Тем более что, и компонент, и реакция на клик, уже есть.
В-четвертых, на панель ставим ComboBox из трех пунктов, определяющих цветовую схему не-клиентской области окна.
Еще ряд косметических модификаций. Добавим иконку, заголовок окна. В дизайнере Delphi7 получилось следующее:
В OnResize формы устанавливаем расположение и размер панели:
|
1 2 3 4 5 6 |
procedure TFmMain.FormResize(Sender: TObject); begin pnlTitle.Left := 0; pnlTitle.Width := ClientWidth; pnlTitle.Top := 0; end; |
В обработчике события OnMouseDown панели заголовка pnlTitle пишем:
|
1 2 3 4 5 6 7 |
ReleaseCapture; // if the mouse is not released, the command to move the mouse // will not work, because is occupied by the element that // initiated the click // если не освободить мышь, команда на движение мыши не отработает, // т.к. занята тем элементом, кто инициировал нажатие SendMessage(Handle, WM_SYSCOMMAND, DRAG_TITLE_COMMAND, 0); |
Вешаем на этот обработчик все компоненты панели, кроме избранных. На ComboBox вешать смысла нет никакого. Клик на иконке должен показать в будущем системное меню. Клик на Close Alt+F4 должен закрывать окно, а не таскать его.
Пока буду приводить фрагменты, чтобы акцентироваться на важном. Полностью некоторые листинги приведу в конце статьи.
Напомню константы:
|
1 2 3 4 5 6 7 8 9 10 11 |
const // SC_SIZE + WMSZ_… SIZE_LEFT_COMMAND = $F001; SIZE_RIGHT_COMMAND = $F002; SIZE_TOP_COMMAND = $F003; SIZE_TOPLEFT_COMMAND = $F004; SIZE_TOPRIGHT_COMMAND = $F005; SIZE_BOTTOM_COMMAND = $F006; SIZE_BOTTOMLEFT_COMMAND = $F007; SIZE_BOTTOMRIGHT_COMMAND = $F008; DRAG_TITLE_COMMAND = $F009; |
Обработаем изменения в ComboBox‘е:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
// Response to color theme change // Реакция на смену цветовой темы procedure TFmMain.ComboBox1Change(Sender: TObject); begin // Set a different title // Задать другой заголовок Caption := 'IP76.RU: Tricks Form 2.0 / Theme:' + ComboBox1.Text; // The fire bitmap needs to be recreated with a different color // Битмап огня должен быть пересоздан с другим цветом FreeAndNil(FBitmap); // Response to non-client click // Реакция на клик non-client CheckBox1Click(CheckBox1); // Draw Self Promotion // Отрисовать саморекламу pb1Paint(pb1); // Draw Windows Version // Отрисовать версию Windows pb1Paint(pb2); // Force non-client area to rerender // Заставить нарисовать не-клиентcкую область SendMessage(Handle, WM_NCPAINT, 0, 0); end; |
Обработаем событие изменения заголовка, потому что мало ли кто и каким образом захочет сменить его:
|
1 |
procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT; |
Реализация:
|
1 2 3 4 5 |
procedure TFmMain.WMSetText(var Msg: TWMSetText); begin inherited; lblTitle.Caption := Msg.Text; end; |
И вот что получилось:
У формы меняется размер мышкой, таскается за заголовок, вроде все как надо. Но хочется, чтобы панель стала более «настоящим» заголовком.
Шаги в потустороннее. Non-Сlient Window Area
Путь в потустороннее начинается с CheckBox Non-client. Обработчик события OnChange выглядит так:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
if Sender = CheckBox1 then begin // clWindowText not be visible on the dark background of the header // clWindowText будет не виден на темном фоне заголовка if CheckBox1.Checked then Label1.Font.Color := clWhite else Label1.Font.Color := clWindowText; lblTitle.Font.Color := Label1.Font.Color; // make title bar transparent/opaque // сделать панель заголовка прозрачной/непрозрачной pnlTitle.ParentBackground := CheckBox1.Checked; // set caption-panel coordinates // задать координаты заголовка FormResize(Sender); // WM_NC events... // вызвать события WM_NC... Perform(CM_BORDERCHANGED, 0, 0); // handler for CheckBox1 completed // обработчик для CheckBox1 закончен Exit; end; |
Обращаю внимание на строку pnlTitle.ParentBackground := CheckBox1.Checked, без не фокуса не получится. Если рисуем в не-клиентской части окна, панель должна стать «прозрачной».
Шаг 1: Отрицательные координаты
Мы не случайно не стали делать никакого автоматического выравнивания для панели-заголовка. Координаты надо указывать вручную, потому что положение панели, даже в отрицательной зоне, очень важно, особенно для выпадающих списков.
Модифицированный обработчик OnResize формы:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
procedure TFmMain.FormResize(Sender: TObject); begin pnlTitle.Left := 0; pnlTitle.Width := ClientWidth; // need to move to non-client side // требуется переместиться в не-клиентскую часть if CheckBox1.Checked then // in this case, the panel will start from the coordinate, // by the value of BorderWidth, spaced from the top edge, // the bottom edge of the panel will become 0 // в этом случае, панель начнется с координаты, на величину // BorderWidth, отстоящей от верхнего края, // нижний край панели станет равен 0 pnlTitle.Top := -pnlTitle.Height else // need to move to the visible(client) part // требуется переместиться в видимую часть pnlTitle.Top := 0; end; |
Шаг 2: Размер не-клиентской области
Суровые программисты работают с не-клиентской областью окна
Трюки с формой 1.0
В тексте цитируемой статьи присутствует листинг обработчика для события WM_NCCALCSIZE, а в исходнике его нет. Просто там он не нужен, а здесь пригодится. Вернем и модифицируем его. BorderWidth меняет размер не-клиентской области окна. Мы чуть-чуть поправим размер сверху на высоту заголовка.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
procedure TFmMain.WMNCCalcSize(var Message: TWMNCCalcSize); var NCCalcSizeParams: PNCCalcSizeParams; begin inherited; if (BorderStyle <> bsNone) or (WindowState = wsMaximized) then Exit; NCCalcSizeParams := Message.CalcSize_Params; if CheckBox1.Checked then Inc(NCCalcSizeParams.rgrc[0].Top, pnlTitle.Height); // These parameters are calculated by BorderStyle // Эти параметры посчитает BorderStyle // ----------------------------------------------- // Inc(NCCalcSizeParams.rgrc[0].Top, CNS_NC_SIZE); // Inc(NCCalcSizeParams.rgrc[0].Left, CNS_NC_SIZE); // Inc(NCCalcSizeParams.rgrc[0].Right, -CNS_NC_SIZE); // Inc(NCCalcSizeParams.rgrc[0].Bottom, -CNS_NC_SIZE); end; |
В результате всех этих модификаций, панель-заголовок переместилась в отрицательную зону окна и заботливо прикрыта не-клиентской частью.
Шаг 3: Нарисовать заголовок
Конечно, процедура NCPaint претерпела серьезные изменения. Полный листинг в конце статьи. Если вкратце, теперь во всех трех режимах формируется битмап, на котором потом создается текстурная кисть. Далее формируется путь TGPGraphicsPath на пересечении двух прямоугольников и с помощью этой кисти выводится на контекст.
Чтобы нарисовать панель заголовка, будем использовать метод PaintTo и свойство ParentBackground, которое мы выставляем в обработчике OnChange чекбокса Non-client. Фрагмент из NCPaint, рисующий панель:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
// if we are in a non-client area // если находимся в не-клиентской области if CheckBox1.Checked then try // to draw on the bitmap // чтобы рисовать на битмапе gpg := TGPGraphics.Create(gbmp); // get GDI context // получить GDI контекст tmpDC := gpg.GetHDC; // draw a transparent panel on the context // рисовать прозрачную панель на контексте pnlTitle.PaintTo(tmpDC, BorderWidth, BorderWidth); // be sure to return the context // обязательно вернуть контекст gpg.ReleaseHDC(tmpDC); finally FreeAndNil(gpg); end; |
Рисуем, начиная с точки (BorderWidth, BorderWidth), потому что надо учитывать отступы не-клиентской части сверху и слева.
Образ панели получился «неживой», нереагирующий на мышь. Сейчас оживим.
Трансляция Non-Client событий
Понятно, что события не могут «пробиться» к элементам, находящимся в не-клиентской области окна. Они как бы в «сумраке»…
Поэтому, надо ловить события в не-клиентской области, преобразовывать их и отсылать уже как обычные. Все компоненты и панель-заголовок имеют статус видимых. Более того, все компоненты на панели имеют положительные координаты. И еще более того, мышиные события работают с координатами именно клиентской области окна. Иными словами, проблем возникнуть не должно.
WM_NCHITTEST
Для начала надо модифицировать обработчик WM_NCHITTEST. До момента определения, что требуется сделать с размером окна, необходимо распознать попадание в заголовок, соответствующим образом среагировать и выйти. Также, при определении типа изменения размеров мышкой, необходимо учитывать и новую область заголовка.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
procedure TFmMain.WMNCHitTest(var Message: TWMNCHitTest); var pnt: TPoint; rct: TRect; h: Integer; begin inherited; pnt := CalcCursorPos; // If the title bar is in a non-client area // and the point is title // Если панель заголовка в не-клиентской зоне // и точка попала в заголовок if CheckBox1.Checked and CheckTitlePos(pnt) then begin // in events WM_NCMOUSE..., WM_NCLBUTTON... // we will intercept and handled // в событиях WM_NCMOUSE..., WM_NCLBUTTON... // перехватим и обработаем Message.Result := HTBORDER; exit; end; if (BorderStyle <> bsNone) or (WindowState = wsMaximized) then Exit; h := 0; // if required, take into account heading add-height // если требуется, учесть доп.высоту заголовка if CheckBox1.Checked then h := pnlTitle.Height; if (pnt.Y < 1) or (pnt.X < 1) or (pnt.X > Width - 2*CNS_NC_SIZE-1) or (pnt.Y > Height - h - 2*CNS_NC_SIZE-1) then begin rct := ClientRect; InflateRect(rct, CNS_NC_SIZE, CNS_NC_SIZE); // if required, take into account heading add-height // если требуется, учесть доп.высоту заголовка if CheckBox1.Checked then rct.Top := rct.Top - pnlTitle.Height; case CheckCurrAreaMode(pnt, rct, CNS_NC_SIZE, False) of 1: Message.Result := HTTOPLEFT; 2: Message.Result := HTTOP; 3: Message.Result := HTTOPRIGHT; 4: Message.Result := HTRIGHT; 5: Message.Result := HTBOTTOMRIGHT; 6: Message.Result := HTBOTTOM; 7: Message.Result := HTBOTTOMRIGHT; 8: Message.Result := HTLEFT; end; end; end; |
Для определения того, что точка попала в заголовок, используем следующий метод:
|
1 2 3 4 5 6 7 8 |
// Determine if the point is in the non-client area of the title // Определить что точка находится в не-клиентской зоне заголовка function TFmMain.CheckTitlePos(const APos: TPoint): Boolean; begin Result := (APos.Y < 0) and (APos.X > 0) and (APos.X < Width - 2*CNS_NC_SIZE - 1) and (APos.Y > -pnlTitle.Height - 1); end; |
Обработка движения мыши
За событие движения мыши в не-клиентской области окна отвечает WM_NCMOUSEMOVE.
|
1 2 3 4 |
// mouse movements in the non-client area of the window // движени мыши в не-клиентской области окна procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE; |
Обработчик таков:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
procedure TFmMain.WMNCMouseMove(var Message: TWMNCMouseMove); var pnt: TPoint; begin inherited; pnt := CalcCursorPos; // anything that doesn't concern the header doesn't concern us // все, что не касается заголовка, нас не касается if not (CheckBox1.Checked and CheckTitlePos(pnt)) then Exit; // correction for panel height // поправка на высоту панели Message.XCursor := pnt.X; Message.YCursor := pnt.Y + pnlTitle.Height; // if there are no applicants for the event // если нет претендентов на событие if not SendNCHitMessageToChilds(pnlTitle, WM_MOUSEMOVE, Message) then // then the panel will process it // то панель его обработает pnlTitle.Perform(WM_MOUSEMOVE, TMessage(Message).WParam, TMessage(Message).LParam); // there will be a slight flicker when "frantic" flame rendering // при "бешенной" пламенной отрисовке будет небольшое мерцание if not RadioButton3.Checked then SendMessage(Handle, WM_NCPAINT,0,0); end; |
Для начала получаем и считаем позицию курсора в клиентских координатах окна. Если координата попадает в область заголовка, преобразуем Y координату в клиентскую для панели. Далее пытаемся по этим координатам найти подходящий WinControl на панели, который возможно обработает событие. И если таковых не нашлось, отправляем событие WM_MOUSEMOVE панели.
Поиск WinControl‘ов — кандидатов и отправка сообщения осуществляется следующим образом:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
// Send a TWMNCHitMessage message to all child controls // Разослать всем дочерним компонентам сообщение TWMNCHitMessage function SendNCHitMessageToChilds(AParent: TWinControl; const AMessage: DWORD; Msg: TWMNCHitMessage): Boolean; function PossibleControl(AControl: TControl; const APoint: TPoint): Boolean; begin Result := AControl is TWinControl and AControl.Visible and AControl.Enabled and PtInRect(AControl.BoundsRect, APoint); end; var i: Integer; pnt: TPoint; ctr: TWinControl; begin // coordinates in client area AParent // координаты в клиентской области AParent pnt := Point(Msg.XCursor, Msg.YCursor); Result := False; for i := 0 to AParent.ControlCount - 1 do begin if PossibleControl(AParent.Controls[i], pnt) then // this is our patient // это наш пациент begin ctr := AParent.Controls[i] as TWinControl; // transfer coordinates to the patient's client area // перевод координат в клиентскую область пацинта Msg.XCursor := pnt.X - ctr.Left; Msg.YCursor := pnt.Y - ctr.Top; // maybe the patient has his own patients // может быть у пацента есть свои пациенты Result := SendNCHitMessageToChilds(ctr, AMessage, Msg); if not Result then // there were no candidates, so send to the patient // кандидатов не оказалось, значит шлем пациенту SendMessage(ctr.Handle, AMessage, TMessage(Msg).WParam, TMessage(Msg).LParam); Result := True; Break; end; end; end; |
Обработка нажатий мыши
За нажатия мыши в нашем случае будут отвечать события WM_NCLBUTTONDOWN и WM_NCLBUTTONUP.
|
1 2 3 4 5 6 |
// left mouse button in the non-client area of the window // левая кнопка мыши в не-клиентской области окна procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; procedure WMNCLButtonUp(var Message: TWMNCLButtonUp); message WM_NCLBUTTONUP; |
Обработчики по структуре абсолютно такие же, как представленный выше обработчик движения мыши. Единственное различие, рассылаются сообщения WM_LBUTTONDOWN и WM_LBUTTONUP соответственно.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
procedure TFmMain.WMNCLButtonDown(var Message: TWMNCLButtonDown); var pnt: TPoint; begin inherited; pnt := CalcCursorPos; if not (CheckBox1.Checked and CheckTitlePos(pnt)) then Exit; Message.XCursor := pnt.X; Message.YCursor := pnt.Y + pnlTitle.Height; if not SendNCHitMessageToChilds(pnlTitle, WM_LBUTTONDOWN, Message) then pnlTitle.Perform(WM_LBUTTONDOWN, TMessage(Message).WParam, TMessage(Message).LParam); SendMessage(Handle, WM_NCPAINT, 0, 0); end; procedure TFmMain.WMNCLButtonUp(var Message: TWMNCLButtonUp); var pnt: TPoint; begin inherited; pnt := CalcCursorPos; if not (CheckBox1.Checked and CheckTitlePos(pnt)) then Exit; Message.XCursor := pnt.X; Message.YCursor := pnt.Y + pnlTitle.Height; if not SendNCHitMessageToChilds(pnlTitle, WM_LBUTTONUP, Message) then pnlTitle.Perform(WM_LBUTTONUP, TMessage(Message).WParam, TMessage(Message).LParam); SendMessage(Handle, WM_NCPAINT, 0, 0); end; |
ComboBox в заголовке
Итак, у нас получилось следующее:
Как видим, события транслируются превосходно. Клики на метках работают. Перетаскивание за заголовок формы — все есть. Хотя никаких особых ухищрений для этого не потребовалось. Работают все те же OnMouseDown, OnClick, OnMouseMove на компонентах.
Почему ComboBox в заголовке вообще работает. Потому что его parent, панель-заголовок, в статусе видимости. Посылаем ComboBox событие WM_LBUTTONDOWN с правильными координатами. В итоге он работает, как будто лежит на форме в легальной зоне.
Специально для того, чтобы выпадающее окно выпадало правильно, в OnResize устанавливаем правильные координаты панели. Когда приходит сообщение WM_LBUTTONDOWN, ComboBox определяет экранные координаты для выпадающего окна и показывает его. А так как он лежит на самом деле ровно под тем местом, на котором его нарисовали, то и окно выпадает прям идеально.
То же самое будет и с выпадающим меню. Кинем на форму TPopupMenu. Сделаем в нем пару элементов и на событие OnClick изображения Image1, которое служит иконкой, напишем такой обработчик:
|
1 2 3 4 5 6 7 8 |
procedure TFmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var p: TPoint; begin p := Image1.ClientToScreen(Point(X,Y)); PopupMenu1.Popup(p.x,p.y); end; |
Супер-незамысловато! Однако, между тем, из non-client области он будет работать более чем адекватно. Мы преобразовали не-клиентские координаты в клиентские и в обработчик OnMouseDown приходят X и Y в системе координат Image1.
Оптимизация кода
Вначале посмотрим на обработчики семейства сообщений NC мыши и заметим, что они все похожи друг на друга. Повторяющийся код, который так и просится в отдельную функцию. Сделаем такую функцию:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
function TFmMain.SendNCHitMessage( var Message: TWMNCHitMessage): Boolean; var pnt: TPoint; Msg: DWORD; begin pnt := CalcCursorPos; // anything that doesn't concern the header doesn't concern us // все, что не касается заголовка, нас не касается Result := (CheckBox1.Checked and CheckTitlePos(pnt)); if not Result then Exit; Msg := WM_NULL; case Message.Msg of WM_NCMOUSEMOVE: Msg := WM_MOUSEMOVE; WM_NCLBUTTONDOWN: Msg := WM_LBUTTONDOWN; WM_NCLBUTTONUP: Msg := WM_LBUTTONUP; WM_NCLBUTTONDBLCLK: Msg := WM_LBUTTONDBLCLK; WM_NCRBUTTONDOWN: Msg := WM_RBUTTONDOWN; WM_NCRBUTTONUP: Msg := WM_RBUTTONUP; WM_NCRBUTTONDBLCLK: Msg := WM_RBUTTONDBLCLK; else Result := False; end; if not Result then Exit; // correction for panel height // поправка на высоту панели Message.XCursor := pnt.X; Message.YCursor := pnt.Y + pnlTitle.Height; // if there are no applicants for the event // если нет претендентов на событие if not SendNCHitMessageToChilds(pnlTitle, Msg, Message) then // then the panel will process it // то панель его обработает pnlTitle.Perform(Msg, TMessage(Message).WParam, TMessage(Message).LParam); end; |
Перепишем уже существующие обработчики:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
// mouse movements in the non-client area of the window // движение мыши в не-клиентской области окна procedure TFmMain.WMNCMouseMove(var Message: TWMNCMouseMove); begin inherited; if not SendNCHitMessage(Message) then Exit; // there will be a slight flicker when "frantic" flame rendering // при "бешенной" пламенной отрисовке будет небольшое мерцание if not RadioButton3.Checked then SendMessage(Handle, WM_NCPAINT,0,0); end; // left mouse button in the non-client area of the window // левая кнопка мыши в не-клиентской области окна procedure TFmMain.WMNCLButtonDown(var Message: TWMNCLButtonDown); begin inherited; if not SendNCHitMessage(Message) then Exit; SendMessage(Handle, WM_NCPAINT, 0, 0); end; procedure TFmMain.WMNCLButtonUp(var Message: TWMNCLButtonUp); begin inherited; if not SendNCHitMessage(Message) then Exit; SendMessage(Handle, WM_NCPAINT, 0, 0); end; |
Реакция на правую кнопку мыши
Добавим еще пару обработчиков:
|
1 2 3 4 5 6 |
// right mouse button in the non-client area of the window // правая кнопка мыши в не-клиентской области окна procedure WMNCRButtonDown(var Message: TWMNCRButtonDown); message WM_NCRBUTTONDOWN; procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP; |
И их схожая реализация, только еще короче:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
procedure TFmMain.WMNCRButtonDown(var Message: TWMNCRButtonDown); begin inherited; if SendNCHitMessage(Message) then SendMessage(Handle, WM_NCPAINT, 0, 0); end; procedure TFmMain.WMNCRButtonUp(var Message: TWMNCRButtonUp); begin inherited; if SendNCHitMessage(Message) then SendMessage(Handle, WM_NCPAINT, 0, 0); end; |
Теперь, если установить в свойство Image1.PopupMenu наш только что созданный PopupMenu1, и убрать обработчик Image1.OnMouseDown := nil для чистоты эксперимента, то выпадение контекстного меню станет автоматическим по правой кнопке.
Да, мне кажется это круто. Нет, это не заготовка под системное меню.
Также замечательно работают календарь (TDateTimePicker) и прочие «выпадашки»: TColorBox, TToolButton со стилем tbsDropDown и установленным DropdownMenu.
Метод WndProc
Конечно, все можно было бы сделать через переопределение метода формы WndProc:
|
1 |
procedure WndProc(var Message: TMessage); override; |
И весь код с мышиными обработчиками не-клиентской области сокращается до такой реализации:
|
1 2 3 4 5 6 7 8 9 10 11 12 |
procedure TFmMain.WndProc(var Message: TMessage); begin if (Message.Msg in [ // WM_NCMOUSEMOVE, because there is a special condition WM_NCLBUTTONDOWN, WM_NCLBUTTONUP, WM_NCLBUTTONDBLCLK, WM_NCRBUTTONDOWN, WM_NCRBUTTONUP, WM_NCRBUTTONDBLCLK]) and SendNCHitMessage(TWMNCHItMessage(Message)) then SendMessage(Handle, WM_NCPAINT,0,0) else inherited; end; |
Если поставить breakpoint на обработчики перечисленных событий, то мы туда попадем только в случае, если клики происходят вне области заголовка и только в non-client зоне.
Также, теперь мы обрабатываем еще и двойной клик в не-клиентской области окна. Исключение составил только WM_NCMOUSEMOVE, потому что в нем происходит проверка на текущее рисование пламени. Причина только в этом. Эту проверку вполне можно было бы дописать в WndProc, но хотелось оставить простоту и изящество «в одной строке». Эдакое одностишье со смыслом.
Когда стоит применять
Прекрасно подходит для элементов, управление которыми привычно через клик. Button, BitBtn, PopupMenu, Image, Label, CheckBox, ComboBox в заголовке будут смотреться и вести себя просто идеально.
Недостатки
Если приглядеться к надписям, или убрать «жирность» шрифта, увидим черные рудименты вокруг символов. Это работает сглаживание, в этих местах должна быть полупрозрачность, но ее, к сожалению, нет. Аналогичные рудименты видны вокруг красного круга иконки. В этих местах также должно быть легкое размытие.
Вывести элементы редактирования, типа TEdit, можно, но пользоваться ими будет некомфортно. Не видно курсора внутри, плохая реакция на отрисовку.
Если придраться к тому, что CheckBox не реагирует на смену цвета шрифта, то это проблема CheckBox‘а. В лоб проблема решается размещением на какой-нибудь панельке узкого чекбокса, так чтобы видна была только галка, и метки, на клик которой устанавливать или снимать свойство Checked. Если решать изящно, то хотелось бы верить, что разговор об этом состоится в недалеком будущем. Голосуем в комментариях, интересует или нет, как решить эту проблему изящно.
Что будет дальше
Все подбираюсь к теме системного меню окна и системных кнопок, но вот уже оба раза количество материала зашкаливает. Впихивать все в одну статью, как показала практика, занятие непродуктивное. Постараюсь в следующей статье 2.1 рассказать про это.
Также, дальше мы откажемся от «попсовости» в пользу «деловитости». Пламя отбирает прилично ресурсов. Для украшения — вполне себе применимо, для дела надо другой подход.
Продолжение: Трюки с формой 2.1: Edit в заголовке окна.
Если есть заинтересованность в решении таких проблем, подписывайтесь на канал в телеге, комментируйте. Меня это весьма мотивирует. Если кто-то хочет поучаствовать в создании контента, регистрируйтесь на сайте и пишите статьи. Давайте делать мир понятней!
Листинги
Рисование всей не-клиентской области
Обратите внимание на строку idx := ComboBox1.ItemIndex. Все обращения к массивам, а также приведение типов (например, TFireColorMode(idx)) во всем проекте происходит через предварительную инициализацию переменной idx: Integer. Использование ComboBox1.ItemIndex в качестве индекса массива или типа в семействе XE приводит к неожиданным ошибкам в самых загадочных местах. Не зная про этот глюк, можно искать до посинения.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 |
const colors: Array[0..2,0..2] of TGPColor = (($FF550011, $FFFF0000, $FFFFF428), // red ($FF005100, $FF00FF00, $FF00FFBE), // green ($FF000058, $FF0000FF, $FF61FFFF) // blue ); positions: Array[0..2] of Single = (0,0.5,1); procedure TFmMain.NCPaint(DC:HDC); var idx: Integer; rct: TRect; // gdi+ gpg: TGPGraphics; // for border gbr: TGPBrush; gpath: TGPGraphicsPath; // for draw pnlTitle tmpDC: HDC; // for draw NC Bitmap gbmp: TGPBitmap; begin // If you immediately access ComboBox1.ItemIndex in type casting // and as an array element, there will be unpredictable errors // in those places where you can’t even guess what’s wrong // Если обращаться сразу к ComboBox1.ItemIndex в приведении типов // и как к элементу массива, будут непредсказуемые ошибки в тех местах, // где вы даже предположить не сможете, в чем дело idx := ComboBox1.ItemIndex; // if you take a rectangle from the current Left, Top, Width, Height // of the form, there will be a disgrace // если брать прямоугольник от текущих Left, Top, Width, Height формы // будет форменное безобразие GetWindowRect(Handle, rct); // get the "client" window rectangle where Left=0 and Top=0 // получить "клиентский" прямоугольник окна, в котором Left=0 и Top=0 OffsetRect(rct, -rct.Left, -rct.Top); gpath := TGPGraphicsPath.Create; gbmp := TGPBitmap.Create(rct.Right, rct.Bottom); gpg := TGPGraphics.Create(gbmp); // 1. Preparation // 1. Подготовка try // create a solid brush of the given color // создать сплошную кисть заданного цвета if RadioButton1.Checked then gbr := TGPSolidBrush.Create(colors[idx][0]); // create a gradient brush with 3 given colors // создать градиентную кисть из 3 заданных цветов if RadioButton2.Checked then begin gbr := TGPLinearGradientBrush.Create( MakePoint(rct.Right / 2, rct.Top), MakePoint(rct.Right/2, rct.Bottom), $FF550011, $FFFF0000); TGPLinearGradientBrush(gbr).SetInterpolationColors( @Colors[idx], @Positions, 3); end; // create a texture brush from the prepared flame bitmap // создать текстурную кисть из подготовленного битмап пламени if RadioButton3.Checked then begin gpg.DrawImage(FBkgBmp, 0, 0, 0, 0, gbmp.GetWidth, gbmp.GetHeight, UnitPixel); gbr := TGPTextureBrush.Create(gbmp); end; // залить кистью весь прямоугольник gpg.FillRectangle(gbr,rct.Left, rct.Top, rct.Right, rct.Bottom); finally FreeAndNil(gpg); FreeAndNil(gbr); end; // 2. Draw the title panel in the bitmap // 2. Нарисовать панель заголовка в битмапе // if we are in a non-client area // если находимся в не-клиентской области if CheckBox1.Checked then try // to draw on the bitmap // чтобы рисовать на битмапе gpg := TGPGraphics.Create(gbmp); // get GDI context // получить GDI контекст tmpDC := gpg.GetHDC; // draw a transparent panel on the context // рисовать прозрачную панель на контексте pnlTitle.PaintTo(tmpDC, BorderWidth, BorderWidth); // be sure to return the context // обязательно вернуть контекст gpg.ReleaseHDC(tmpDC); finally FreeAndNil(gpg); end; // 3. Draw the non-client part // 3. Нарисовать не-клиентскую часть // Canvas on the context you want to draw on // Холст на контексте, в котором требуется рисовать gpg := TGPGraphics.Create(DC); // texture brush on the bitmap prepared above // текстурная кисть на подготовленном выше битмап gbr := TGPTextureBrush.Create(gbmp); try // Form a frame at the intersection of two rectangles // Сформировать рамку на пересечении двух прямоугольников // external // внешнего gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right, rct.Bottom)); // and internal // и внутреннего InflateRect(rct, -CNS_NC_SIZE, -CNS_NC_SIZE); // correction from above if there is a non-client header // коррекция сверху, если есть не-клиентский заголовок if CheckBox1.Checked then rct.Top := rct.Top + pnlTitle.Height; gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); // draw the resulting frame // нарисовать получившуюся рамку gpg.FillPath(gbr, gpath); finally FreeAndNil(gbmp); FreeAndNil(gpg); FreeAndNil(gbr); FreeAndNil(gpath); end; end; procedure TFmMain.WMNCPaint(var Message: TWMNCPaint); var DC: HDC; begin if (BorderStyle <> bsNone) or (WindowState = wsMaximized) then inherited else begin DC := GetWindowDC(Handle); try NCPaint(DC); finally ReleaseDC(Handle, DC); end; end; end; |
Таскать за заголовок
Изначально это был обработчик только для формы. Но быстро стал общим. На него кто только не повешен.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
procedure TFmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin if ssDouble in Shift then // btnCloseClick(btnMaximize) else if (WindowState = wsNormal) and (Sender is TControl) and (((Sender = Self) and (TRICKS_VERSION = 1)) OR ((TRICKS_VERSION = 2) and (Sender = pnlTitle)) OR ((TRICKS_VERSION = 2) and (Sender <> Self) and (TControl(Sender).Parent<>Self)) ) then begin ReleaseCapture; // if the mouse is not released, the command to move the mouse // will not work, because is occupied by the element that // initiated the click // если не освободить мышь, команда на движение мыши не отработает, // т.к. занята тем элементом, кто инициировал нажатие SendMessage(Handle, WM_SYSCOMMAND, DRAG_TITLE_COMMAND, 0); end; end; end; |
Скрины
Скачать
Друзья, спасибо за внимание!
Если продолжение темы трюков с формой интересна, подписывайтесь на телегу. Оставляйте комментарии, регистрируйтесь на сайте, после регистрации доступен чат и возможность написать свою статью. Думаю, есть хитрости у каждого, которыми можно поделиться с другими.
Исходник (zip) 209 Кб. Delphi 7, XE 7, XE 10, XE 11
Для XE открываем файл .dpr и спокойно build’им. Путь из Search Path можно убрать, а можно и не убирать, модули из него никак не задействованы в XE из-за директивного условия.
Исполняемый файл (zip) 317 Кб.
Хотел написать про Edit-подобные контролы, что их тоже можно и нужно размещать в заголовке, но увидел в статье, что это планируется на будущее, что радует.
А за статью спасибо! Очень подробно, доступно, понятно. Впрочем, как и всегда! )
Спасибо! Так может напишешь про Edit’ы? Я тут горю про GDI+ эффекты написать, как сделать красивый drag’n’drop и все это потом использовать для ветки 1.x — форма с bsNone, где заголовок не нужен, а вот применений — уйма. А так одновременно по двум направлениям будем двигаться.
Есть одна заковыка с этими «кастомными» заголовками. Они (как и следует ожидать) не реагируют на такие уже привычные для обычных win-окон действия, как: если ты тащишь окно за загривок (заголовок) кверху, то окно максимизируется. Если тащишь вправо — оно впишется в правую половину экрана, если влево — то в левую и т.д. и т.п. Мало того, есть еще аналог этих манипуляция с клавиатуры через сочетания: кнопка WIN + стрелки курсора. Было бы круто, если бы была возможность реализовать такое и с формами \ приложениями, где заголовок свой полностью, как в статье?
Это прямо тема для целой статьи. Постараюсь в ближайшее время написать.
Добрый день ! Классный пример, спасибо! Но вот обнаружил проблему: при растягивании размера формы по ширине в режиме отрисовки noclient заголовок не перерисовывается, не могли бы Вы подсказать что поправить ?
Добрый вечер!
Судя по скрину, никаких манифестов тут нет.
Если используется Delphi 5 или 7, то попробуйте в файле проекта TricksForm20.dpr убрать все директивы условной компиляции и явно прописать:
{$R WindowsXP.res}
Если XE, то имеет смысл включить «темы времени исполнения» в опциях проекта.
Спасибо за оперативный ответ !
Использую Win7 без всяких тем, со стандартным квадратным интерфейсом чтобы смотреть что происходит с интерфейсом в таком кривом варианте винды, компилирую в XE2, enable runtime themes включено, перерисовка заголовка до нормальных размеров происходит когда мышь попадает в его область
Снова с добрым днем, в дополнение к предыдущей проблеме обнаружил еще одну — при развороте формы на весь экран съедается заголовок
Добрый вечер! Напомню, что делалось в расчёте на DWM, которого в Вашем варианте нет. Предположу, что победить конкретно эту проблему можно добавив в конец обработчика FormResize
SendMessage(Handle, WM_NCPAINT, 0,0);
Проверил в Вин 7 классического вида в виртуалке.
Попробуйте )))
Снова спасибо за оперативный отклик ! SendMessage помог решить проблему артефакта перерисовки в правом верхнем углу, а вот заголовок при развертке упс….., сам еще не копал эту тему
Михаил, добрый вечер )))
Вы наверное сделали в обработчике FormMouseDown что-то вроде этого:
В этом случае, в FormResize имеет смысл добавить условие проверки «максимизированности» окна:
Идею понял, переделал немного по другому, все получилось, спасибо !