Форма без заголовка служит в основном для того, чтобы сделать заставку, или показать какой-нибудь процесс. Как правило, такое окно автоматически лишается тени. И в ряде случаев требуется менять размеры мышкой, как у обычного окна.
Например, такой случай может возникнуть, когда заказчик требует поместить в заголовок формы ComboBox, календарь, разные checkbox‘ы, подписи в виде TLabel. Причем состав заголовка меняется в зависимости от того, что сейчас в этой форме отображается. При этом все должно выглядеть как обычно — заголовок, кнопки закрытия, максимизации, сворачивания, иконка и системное меню. Окно должно уметь менять размер мышкой. Иметь тень. Все атрибуты обычного окна, с необычным заголовком.
Немного про заголовок
В Delphi 10.4 Sydney появился «чудо-компонент» TTitleBarPanel. По поводу этого чуда, которое работает только под Windows 8 и 10, удобству использования и восторгов в его честь, выскажусь в отдельной статье.
А как же быть мне, любителю XE 7? А как же быть любителям Delphi 7, имя им — легион?
Сделать свой заголовок — это значить поместить свою панель вместо заголовка. Вот этим и займемся, неспеша и последовательно. В части 1 рассмотрим, как сделать тень, рамку и возможность менять размер мышкой при BorderStyle = bsNone. Максимально субъективно, по возможности внятно и коротко — как говорит Пивоваров А.В.
Для начала нам нужно избавиться от заголовка.
Без заголовка
Избавиться от заголовка можно, например, так. Сделать BorderStyle := bsSizeToolWin или bsSizeable, и в обработчике события OnCreate написать следующее:
|
1 2 |
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle,GWL_STYLE) and NOT WS_CAPTION) |
В этом случае у нас остается возможность менять размеры мышкой, остается тень, доступно системное меню. Правда, чтобы заголовок все-таки исчез, надо в том же OnCreate сделать такой грубый прием:
|
1 2 3 4 5 6 |
// If this is not done, the title will still be // visible from above until the first resize // Если этого не сделать, сверху все равно будет виден // заголовок до первого resize Width := Width + 1; Width := Width - 1; |
Казалось бы, проблема решена. Но тут есть ряд нюансов.
Во-первых, как ни старайся, все равно сверху будет небольшая белая (цвет зависит от OS) полоса. Во-вторых, цвет рамки вокруг окна мы не можем поменять никак.
В то время, как BorderStyle = bsNone дает нам «чистый» холст — рисуй, что хочешь, обрабатывай не-клиентскую часть, как считаешь нужным. Это окно без заголовка, рамок, тени, страха и упрека.
Поэтому, для избавления от заголовка начисто, используем BorderStyle = bsNone.
Делаем тень
Тень — это дело Dwm. Тут есть немножко про DwmAPI. Рассмотрим вначале, как сделать тень в XE 5 и выше. Потом сделаем для Delphi 7.
Тень в XE 5 и выше
Подключим в uses модули:
|
1 |
Winapi.DwmApi, Winapi.UxTheme |
Чтобы включить Aero тень, используем функцию DwmSetWindowAttribute следующим образом:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
function EnabledNCRendering(hWnd: THandle; const AEnabled: Boolean = False): HRESULT; var ncrp: LongInt; begin if AEnabled then ncrp := DWMNCRP_ENABLED else ncrp := DWMNCRP_DISABLED; Result := DwmSetWindowAttribute(hWnd, DWMWA_NCRENDERING_POLICY, @ncrp, sizeof(ncrp)); end; |
Чтобы тень из багажа DwmAPI заработала, необходимо задать рамки. Для задания рамки используем функцию DwmExtendFrameIntoClientArea. Главное, чтобы хотя бы один параметр был отличен от нуля.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
function SetDwmArea(AWnd: hWnd): Boolean; var hr: HRESULT; margins: _MARGINS; begin margins.cxLeftWidth := 1; margins.cxRightWidth := 1; margins.cyBottomHeight := 1; margins.cyTopHeight := 1; hr := DwmExtendFrameIntoClientArea(AWnd, margins); Result := hr=S_OK; end; |
Включаем в обработчик OnCreate формы следующий фрагмент:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
// enable shadow // включить тень hr := EnabledNCRendering(Handle, True); if hr <> S_OK then Label2.Caption := 'EnabledNCRendering FAIL:' + SysErrorMessage(hr); // make shadow visible // сделать тень видимой if not SetDwmArea(Handle) then begin Label3.Caption := 'SetDwmArea FAIL'; SetClassLong(Handle, GCL_STYLE, GetClassLong(Handle, GCL_STYLE) or CS_DROPSHADOW); end; |
Что происходит. Инициализируем тень и выводим на форму сообщения об ошибках, если таковые возникли. Если вызов SetDwmArea неудачен, то есть красивое размытие не увидим, делаем тень топорным CS_DROPSHADOW. Какая-никакая, но тоже тень.
Необходимо обработать еще два DWM-события. Без них не будет тени. В private секции формы пишем следующее:
|
1 2 3 4 |
procedure WMDWMCompositionChanged(var Msg: TMessage); message WM_DWMCOMPOSITIONCHANGED; procedure WMDwmNCRenderingChanged(var Msg: TMessage); message WM_DWMNCRENDERINGCHANGED; |
И где-то в implementation пишем реализацию:
|
1 2 3 4 5 6 7 8 9 10 11 |
procedure TFmMain.WMDWMCompositionChanged(var Msg: TMessage); begin inherited; SetDwmArea(Handle); end; procedure TFmMain.WMDwmNCRenderingChanged(var Msg: TMessage); begin inherited; SetDwmArea(Handle); end; |
Все. Симпатичная и привычная тень у нас теперь есть для окна без заголовка с BorderStyle = bsNone.
Тень в Delphi 7
Абсолютно тот же код, что для «XE 5 и выше» будет работать и в Delphi 7, при условии, что мы опишем псевдонимы некоторых функций из DwmApi. Для начала заключим блок с модулями Dwmapi в директивное условие.
|
1 2 3 4 5 6 7 8 9 |
uses {$IF CompilerVersion > 25} // directive to prevent XE from underlining and cursing on IFEND // директива, чтобы XE не подчеркивал и не ругался на IFEND {$LEGACYIFEND ON} Winapi.DwmApi, Winapi.UxTheme, {$IFEND} ... ; |
Говорят, что новшество появилось в Delphi 2010. Проверить не могу, поэтому отсчет цивилизации начинается с XE 5.
Для Delphi 7 предлагаю такой блок:
|
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 |
{$IF CompilerVersion < 26} // Winapi.UxTheme type _MARGINS = record cxLeftWidth: Integer; cxRightWidth: Integer; cyTopHeight: Integer; cyBottomHeight: Integer; end; // Winapi.DwmApi const ModName = 'DWMAPI.DLL'; {$EXTERNALSYM DWMNCRP_DISABLED} DWMNCRP_DISABLED = 1; // Disabled non-client rendering; window style is ignored {$EXTERNALSYM DWMNCRP_ENABLED} DWMNCRP_ENABLED = 2; // Enabled non-client rendering; window style is ignored {$EXTERNALSYM DWMWA_NCRENDERING_POLICY} DWMWA_NCRENDERING_POLICY = 2; // [set] Non-client rendering policy type TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; // external ModName name 'DwmSetWindowAttribute'; TDwmExtendFrameIntoClientArea = function(hWnd: HWND; const pMarInset: _Margins): HResult; stdcall; // external ModName name 'DwmExtendFrameIntoClientArea'; var _DwmSetWindowAttribute: TDwmSetWindowAttribute = nil; _DwmExtendFrameIntoClientArea: TDwmExtendFrameIntoClientArea = nil; _LibDwm: HMODULE = 0; _LibError: HRESULT = 0; function InitDwmApi: Boolean; begin if (_LibDwm = 0) and (_LibError = 0) then begin _LibDwm := LoadLibrary(ModName); if _LibDwm <> 0 then begin _DwmSetWindowAttribute := TDwmSetWindowAttribute(GetProcAddress(_LibDwm, 'DwmSetWindowAttribute')); _DwmExtendFrameIntoClientArea := TDwmExtendFrameIntoClientArea(GetProcAddress(_LibDwm, 'DwmExtendFrameIntoClientArea')); end else _LibError := GetLastError; end; Result := (_LibDwm <> 0) and Assigned(_DwmSetWindowAttribute) and Assigned(_DwmExtendFrameIntoClientArea); end; function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; begin if not InitDwmAPi then Result := _LibError else Result := _DwmSetWindowAttribute(hwnd, dwAttribute, pvAttribute, cbAttribute); end; function DwmExtendFrameIntoClientArea(hWnd: HWND; const pMarInset: _Margins): HResult; begin if not InitDwmAPi then Result := _LibError else Result := _DwmExtendFrameIntoClientArea(hwnd, pMarInset); end; {$IFEND} |
Для событий, указанных в секции для XE, без которых тени не будет, добавим константы:
|
1 2 3 4 5 6 7 8 |
const {$IF CompilerVersion < 26} {$EXTERNALSYM WM_DWMCOMPOSITIONCHANGED} WM_DWMCOMPOSITIONCHANGED = $031E; {$EXTERNALSYM WM_DWMNCRENDERINGCHANGED} WM_DWMNCRENDERINGCHANGED = $031F; {$ifend} |
Динамическая загрузка сделана потому, что Dwm существует, начиная с Vista. Под XP эту штуку еще не придумали. При запуске на XP ошибок не будет. Просто не будет тени.
Рамка окна
Окно стиля bsNone похоже на безликое пятно прямоугольной формы. Даже с тенью оно выглядит как дыра в тени. Конечно, рисовать прямо на форме мы не станем. Суровые программисты работают с не-клиентской областью окна.
В приватной секции формы пишем такое объявление:
|
1 2 3 4 5 6 7 8 9 10 |
// handler WM_NCCALCSIZE - for severe programmers // обработчик WM_NCCALCSIZE - для суровых программистов procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; // handler WM_NCPAINT - for all programmers // обработчик WM_NCPAINT - для всех программистов procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; procedure NCPaint(DC:HDC; const AGDIP: Boolean = False); |
Задать размер не-клиентской области окна
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
procedure TFmMain.WMNCCalcSize(var Message: TWMNCCalcSize); var NCCalcSizeParams: PNCCalcSizeParams; begin inherited; if (BorderStyle <> bsNone) or (WindowState = wsMaximized) then Exit; NCCalcSizeParams := Message.CalcSize_Params; 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; |
Что происходит. Здесь мы задаем отступы для не-клиентской области со всех сторон окна.
Константа CNS_NC_SIZE объявлена как:
|
1 2 3 |
{$WRITEABLECONST ON} const CNS_NC_SIZE: Integer = 4; |
Директива WRITEABLECONST ON включает возможность присваивать типизированным константам другие значения в коде. Почему не можем использовать, как VAR переменную? Потому что «не должно быть глобальных переменных в грамотном коде«. Не буду говорить, чьи слова.
Программист должен быть в первую очередь грамотным и ленивым. Поэтому часть для «суровых» программистов заменяем в обработчике OnCreate формы на строку:
|
1 2 3 |
// set non-client window area // задать не-клиентскую область окна BorderWidth := CNS_NC_SIZE; |
Остальное сделает TWinControl. В исходниках раздела СКАЧАТЬ обработчика WMNCCalcSize нет. Потому что, как люди мы — суровые, но как программисты — ленивые. Но WMNCCalcSize пригодится в дальнейшем, поэтому оставил в тексте статьи.
Нарисовать не-клиентскую область окна
Зачем нам вообще ее рисовать? Если мы захотим свой цвет в будущем заголовке, то это будет резко диссонировать с системным цветом рамки.
Зачем нам рамка, ведь на рисунке 2 все чудесно? Об этом чуть позже.
Покрасим рамку в красный.
|
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 |
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; procedure TFmMain.NCPaint(DC:HDC; const AGDIP: Boolean = False); var rct: TRect; // gdi api pen: HPen; OldPen: HPen; OldBrush: HBrush; begin // 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); if not AGDIP then begin Pen := CreatePen(PS_SOLID, CNS_NC_SIZE*2-1, RGB(255, 0, 0)); OldPen := SelectObject(DC, pen); OldBrush := SelectObject(DC, GetStockObject(NULL_BRUSH)); Rectangle(dc, rct.left, rct.Top, rct.Right, rct.Bottom); SelectObject(DC, OldBrush); SelectObject(DC, OldPen); DeleteObject(pen); end else begin // below the text will be the full listing // ниже по тексту будет полный листинг end; end; |
Какие тут есть нюансы.
Во-первых, в обработчике WMNCPaint контекст устройства DC получаем через GetWindowDC(Handle). Не надо использовать ни Canvas.Handle формы, ни что либо еще. Это неправильно.
Во-вторых, в методе NCPaint прямоугольник формы получаем, как GetWindowRect(Handle, rct). Если формировать прямоугольник от текущих значений свойств формы Left, Top, Width, Height, будет мрак.
В стандартном GDI API нет возможности нарисовать прямоугольник так, чтобы перо описывало его «изнутри». Поэтому, грани прямоугольника проходят по центральной оси «толстой» линии. В связи с чем, толщина пера равна CNS_NC_SIZE * 2 — 1. Если пытаться задать какое-либо другое значение, получим рудименты, как в клиентской области окна, так и в не-клиентской.
Менять размер мышкой
Снова код одинаков, что для Delphi 7, что для XE 5, XE 7, XE 10 и надеюсь XE 11.
Конечно, можно обрабатывать событие мыши OnMove или WM_MOUSEMOVE. По координатам определять в каком направлении менять размеры, выбрать соответствующий курсор, обработать нажатие мышкой с последующим перетаскиванием, посчитать ширину, высоту. Если таскабельная область оказалась слева или сверху, дополнительно менять Left и Top. Удовольствие так себе.
Можно сообразить, что если у нас появилась не-клиентская область окна, событие должно быть WM_NCMOUSEMOVE. Определившись с направлением, можем сделать такой ход. Определить параметр cmd, как сумму SC_SIZE + одна из констант, начинающихся на WMSZ_… Далее вызвать следующее:
|
1 2 |
ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, cmd, 0); |
Для такого cmd у меня даже набор констант есть:
|
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; |
Это, отчасти, верно. Одно но. Чтобы начать получать хоть что-то по не-клиентской области, вначале мы должны обработать событие WM_NCHITTEST.
Пишем в приватной части формы:
|
1 2 |
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; |
В реализации метода мы должны обработать координаты курсора, и если хотим что-то получать по не-клиентской области, необходимо вернуть в Message.Result что-то отличное от нуля.
Для начала определимся с какой стороной или углом окна имеем дело:
|
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 |
function CheckCurrAreaMode (const pnt : TPoint; const ARect : TRect; const ASize: Integer = 4; const UseSquareMarker: Boolean = True) : Integer; var w,h : Integer; begin w := WidthRect(ARect); h := HeightRect(ARect); result := 0; // detect if the mouse has hit the corners // определить, что мышь попала в углы if (abs(pnt.X - ARect.Left) < ASize) and (abs(pnt.Y - ARect.Top) < ASize) then result := 1; if (abs(pnt.X - ARect.Right) < ASize) and (abs(pnt.Y - ARect.Top) < ASize) then result := 3; if (abs(pnt.X - ARect.Right) < ASize) and (abs(pnt.Y - ARect.Bottom) < ASize) then result := 5; if (abs(pnt.X - ARect.Left) < ASize) and (abs(pnt.Y - ARect.Bottom) < ASize) then result := 7; // determine if the mouse is on the frame // определить, что мышка попала на рамку if UseSquareMarker then // analyze only the square in the middle of the side // анализировать только квадрат на середине стороны begin if (abs(pnt.X - (ARect.Left + w div 2)) < ASize) and (abs(pnt.Y - ARect.Top) < ASize) then result := 2; if (abs(pnt.X - ARect.Right) < ASize) and (abs(pnt.Y - (ARect.Top + h div 2)) < ASize) then result := 4; if (abs(pnt.X - (ARect.Left + w div 2)) < ASize) and (abs(pnt.Y - ARect.Bottom) < ASize) then result := 6; if (abs(pnt.X - ARect.Left) < ASize) and (abs(pnt.Y - (ARect.Top + h div 2)) < ASize) then result := 8; end else // check side // анализировать всю сторону begin if (Result = 0) and (abs(pnt.Y - ARect.Top) < ASize) then result := 2; if (Result = 0) and (abs(pnt.X - ARect.Right) < ASize) then result := 4; if (Result = 0) and (abs(pnt.Y - ARect.Bottom) < ASize) then result := 6; if (Result = 0) and (abs(pnt.X - ARect.Left) < ASize) then result := 8; end; end; |
Здесь происходит анализ координат и возвращается число от 0 до 8, где 0 — мимо всего, 1 — левый верхний угол, 2 — верх, 3 — правый верхний, 4 — правая сторона, 5 — нижний правый, 6 — низ, 7 — левый нижний, 8 — левая сторона.
У нас есть целый набор констант, которые говорят Windows, что ему делать и как реагировать на попадание курсора в конкретную область окна. В Message.Result необходимо вернуть понятную для Windows константу.
|
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 |
procedure TFmMain.WMNCHitTest(var Message: TWMNCHitTest); var pnt: TPoint; rct: TRect; begin inherited; if (BorderStyle <> bsNone) or (WindowState = wsMaximized) then Exit; pnt := CalcCursorPos; if (pnt.Y < 1) or (pnt.X < 1) or (pnt.X > Width-2*CNS_NC_SIZE-1) or (pnt.Y > Height-2*CNS_NC_SIZE-1) then begin rct := ClientRect; InflateRect(rct, CNS_NC_SIZE, CNS_NC_SIZE); 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 := HTBOTTOMLEFT; 8: Message.Result := HTLEFT; end; end; end; |
И все. Больше ничего делать не надо. Все дальнейшие действия с краями и размерами Windows сделает автоматически. И курсор покажет правильный, и размер изменит, как надо.
Собственно, за тем нам и нужна была рамка — чтобы дать комфортное пространство для манипуляций мышью. Если толщина рамки ноль, мы никогда не поймаем и не обработаем события мыши в не-клиентской части окна.
Подключаем GDI+
В предыдущей статье рассмотрено, как подключить GDIPlus для Delphi 7. Воспользуемся этой полезной информацией и подключим в опциях проекта для Delphi 7 каталог ..\GDIPPlus\ в поле Search Path. Для семейства XE этого делать не надо, в них уже все это есть.
В предложение uses добавим такой код:
|
1 2 3 4 5 6 7 8 |
uses {$IF CompilerVersion >25} System.Math, Winapi.GDIPAPI, Winapi.GDIPOBJ {$else} Math, GDIPAPI, GDIPOBJ {$ifend} // ... ; |
Добавим на форму ряд компонент, определяющих — рисуем ли с помощью GDI, или GDI+. Для режима GDI+ зададим три режима — просто рамка, градиентная рамка, огненная рамка.
Зачем нам GDI+. Во-первых, есть возможность указать, что ширина линии направлена внутрь фигуры. Во-вторых, GDI+ дает множество визуальных возможностей.
Простая рамка
|
1 2 3 4 5 6 7 8 9 10 11 |
gpg := TGPGraphics.Create(DC); // creates a pen with a border width // создает перо с шириной рамки gpn := TGPPen.Create(MakeColor(255,0,0), CNS_NC_SIZE); // specifying what to draw from inside the shape // указание, что рисовать изнутри фигуры gpn.SetAlignment(PenAlignmentInset); gpg.DrawRectangle(gpn,rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top); |
Градиентная рамка
Вначале укажем два константных массива. Нужны для тройного градиента. Почему константы вынесены из процедуры. Потому что их использует еще один метод формы. В статье он не описан, потому что это рисование текста. Но любопытствующим, добро пожаловать в исходники.
|
1 2 3 4 5 |
const colors: Array[0..2] of TGPColor = ($FF550011, $FFFF0000, $FFFFF428); positions: Array[0..2] of Single = (0,0.5,1); |
Фрагмент в NCPaint:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
// Create a gradient brush, declared as gbr: TGPBrush // Создать градиентную кисть, объявлена как gbr: TGPBrush gbr := TGPLinearGradientBrush.Create( MakePoint(rct.Right / 2, rct.Top), MakePoint(rct.Right/2, rct.Bottom), $FF550011, $FFFF0000); // Set 3-Color Gradient // Установить трехцветный градиент TGPLinearGradientBrush(gbr).SetInterpolationColors( @Colors, @Positions, 3); // add external Rect to gpath: TGPGraphicsPath // в gpath: TGPGraphicsPath добавить внешний Rect gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); // add inner Rect to gpath: TGPGraphicsPath // в gpath: TGPGraphicsPath добавить внутренний Rect InflateRect(rct, -CNS_NC_SIZE, -CNS_NC_SIZE); gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); // paint the frame with the brush // закрасить рамку кистью gpg.FillPath(gbr, gpath); |
Огненная рамка
Это не видео, не набор битмапов. Мы генерируем битмап, используя этот алгоритм. Затем получившийся битмап (FBkgBmp: TGPBitmap) используем при создании текстурной кисти.
|
1 2 3 4 5 6 7 |
gbr := TGPTextureBrush.Create(FBkgBmp); gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); InflateRect(rct, -CNS_NC_SIZE, -CNS_NC_SIZE); gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); gpg.FillPath(gbr, gpath); |
Так как не по теме статьи, генерацию огня спрячу в спойлер. По теме эффектов планируется цикл статей. Если это интересно, пишите комментарии, подписывайтесь на телегу, участвуйте в создании познавательного контента! )))
|
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 |
function CreateBitmap(const AWidth, AHeight: Integer): TGPBitmap; var size: Integer; pal: PColorPalette; i: Integer; begin Result := TGPBitmap.Create(AWidth, AHeight, PixelFormat8bppIndexed); size := Result.GetPaletteSize; GetMem(pal, size); try Result.GetPalette(pal, size); for i := 0 to 63 do begin pal^.Entries[i] := MakeColor(i shl 2, 0, 0); pal^.Entries[i + 64] := MakeColor(255, i shl 2, 0); pal^.Entries[i + 128] := MakeColor(255, 255, i shl 2); pal^.Entries[i + 192] := MakeColor(255, 255, 255); end; Result.SetPalette(pal); finally FreeMem(pal, size); end; end; procedure FlameBitmap(ABitmap: TGPBitmap); var w, h: Integer; bmpLook: BitmapData; j, x: Integer; p: PByte; top: PByte; bottom: PByte; begin w := ABitmap.GetWidth; h := ABitmap.GetHeight; if (ABitmap.LockBits(MakeRect(0,0, w, h), ImageLockModeRead + ImageLockModeWrite, PixelFormat8bppIndexed, bmpLook) = Ok) then try top := bmpLook.Scan0; bottom := PByte(Integer(top) + ((h - 1) * w)); for x := 0 to w -1 do PByte(Integer(bottom) + x)^ := Byte(random(256)); p := top; while Integer(p) < Integer(bottom) do begin if (p <> top) then begin j := PByte(Integer(p) - 1)^ + PByte(Integer(p) + 1)^ + PByte(Integer(p) + w)^ * 3; j := j div 5; if (j < 0) then j := 0; p^ := Byte(j); end; inc(p); end; finally ABitmap.UnlockBits(bmpLook); end; end; |
Что получилось, продемонстрировано ниже. «Горит» не только рамка, но и «внутренности» текстов. Как сделано — в исходниках.
NCPaint целиком
|
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 |
const colors: Array[0..2] of TGPColor = ($FF550011, $FFFF0000, $FFFFF428); positions: Array[0..2] of Single = (0,0.5,1); procedure TFmMain.NCPaint(DC:HDC; const AGDIP: Boolean = False); var rct: TRect; // gdi api pen: HPen; OldPen: HPen; OldBrush: HBrush; // gdi+ gpg: TGPGraphics; gpn: TGPPen; // for border gbr: TGPBrush; gpath: TGPGraphicsPath; begin // if you take a rectangle from the current Left, Top, Width, Height // of the form, there will be a disgrace // если брать прямоугольник от текущих Left, Top, Width, Height формы // будет форменное безобразие: // Wrong: rct := Rect(Left, Top, Left+Width, Top+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); if not AGDIP then begin // Calculate the thickness by eye - wrong // Считать толщину на глазок - неправильно // Wrong: Pen := CreatePen(PS_SOLID, Round(CNS_NC_SIZE*1.9), RGB(255,0,0)); Pen := CreatePen(PS_SOLID, CNS_NC_SIZE*2-1, RGB(255,0,0)); OldPen := SelectObject(DC, pen); OldBrush := SelectObject(DC, GetStockObject(NULL_BRUSH)); Rectangle(dc, rct.left, rct.Top, rct.Right, rct.Bottom); SelectObject(DC, OldBrush); SelectObject(DC, OldPen); DeleteObject(pen); end else begin gpg := TGPGraphics.Create(DC); gpn := TGPPen.Create(MakeColor(255,0,0), CNS_NC_SIZE); gpath := TGPGraphicsPath.Create; gbr := nil; try // Just a red border // Просто красная рамка if RadioButton1.Checked then begin gpn.SetAlignment(PenAlignmentInset); gpg.DrawRectangle(gpn,rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top); end; // Gradient Border // Градиентная рамка if RadioButton2.Checked then begin // Create a gradient brush, declared as gbr: TGPBrush // Создать градиентную кисть, объявлена как gbr: TGPBrush gbr := TGPLinearGradientBrush.Create( MakePoint(rct.Right / 2, rct.Top), MakePoint(rct.Right/2, rct.Bottom), $FF550011, $FFFF0000); // Set 3-Color Gradient // Установить трехцветный градиент TGPLinearGradientBrush(gbr).SetInterpolationColors( @Colors, @Positions, 3); // add external Rect to gpath: TGPGraphicsPath // в gpath: TGPGraphicsPath добавить внешний Rect gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); // add inner Rect to gpath: TGPGraphicsPath // в gpath: TGPGraphicsPath добавить внутренний Rect InflateRect(rct, -CNS_NC_SIZE, -CNS_NC_SIZE); gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); // paint the frame with the brush // закрасить рамку кистью gpg.FillPath(gbr, gpath); end; // Fire Frame // Огненная рамка if RadioButton3.Checked and Assigned(FBkgBmp) then begin gbr := TGPTextureBrush.Create(FBkgBmp); gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); InflateRect(rct, -CNS_NC_SIZE, -CNS_NC_SIZE); gpath.AddRectangle(MakeRect(rct.Left, rct.Top, rct.Right-rct.Left, rct.Bottom-rct.Top)); gpg.FillPath(gbr, gpath); end; finally FreeAndNil(gpg); FreeAndNil(gpn); FreeAndNil(gbr); FreeAndNil(gpath); end; end; end; |
Выводы
Модифицированные модули GDI+ вполне рабочие для Delphi 7.
В Delphi 7 можно писать код, который без проблем компилируется в версиях выше.
Зная, как все работает и зачем это нужно, можно обходится без дополнительных компонент. Большинство из которых, в настоящее время, всего лишь красочная упаковка того же анальгина. Только стоит раз в 10 дороже.
Скачать
Друзья, спасибо за внимание!
Надеюсь, статья кому-нибудь да пригодится. В следующий раз планирую показать, как сделать из панели заголовок окна. Конечно же, сброшу в телегу. Подписывайтесь, чтобы не пропустить! Пишите в комментариях, если есть вопросы по статье или есть темы, которые считаете нужным осветить.
Исходник (zip) 151 Кб. Delphi 7, XE 7, XE 10
Для XE открываем файл .dpr и спокойно build’им. Путь из Search Path можно убрать, а можно и не убирать, модули из него никак не задействованы в XE из-за директивного условия.
Внутри исходников есть еще всякие интересные штуки, для которых не нашлось места в статье.
Исполняемый файл (zip) 262 Кб.
Отличная статья, читается как хороший детектив. И интрига насчёт эффектов даже есть )
Так вот, по эффектам по типу той же огненной рамки — безусловно интересно, по крайней мере, мне ) Потому жду дальнейшего раскрытия темы, так сказать. Ну, по мере сил и возможностей, разумеется.
Да, с одной стороны эффекты это свистоперделки как бы, а с другой стороны такие штуки — как по мне, — так вполне себе очень эффективный способ сделать визуальный акцент в приложении там, где он уместен и нужен. Все зависит от задачи.
Ну и если посмотреть на многие текущие приложения для десктопа, то очень много где вообще рисуют свой интерфейс полностью, заменяя системные элементы управления на отрисованные картинки, и все это под управлением html/js и с использованием css, и в итоге вообще порой это выглядит как вкб-приложение, ни разу не нативно. Это не плохо, если все сделано с умом, со вкусом и этим удобно пользоваться. Но всего хорошо в меру )
Впрочем, как использовать те или иные инструменты — это дело каждого программиста. А автору — благодарность за то, что он такие вот инструменты описывает, рассказывает, показывает. Делает в общем. Спасибо!
Рад отклику! Спасибо за такой содержательный комментарий.
Если честно, я не очень люблю манипуляции с заголовком формы, всякие хитрости с не-клиентской областью. Лучше иметь «родной» заголовок и рисовать непосредственно в нем. И стили подхватит, и родную для текущей версии Windows тему. Но иногда (редко на самом деле) просят поместить туда разного рода WinControl’ы. В Windows я не знаю подходящей стандартной фишки для этого. Поэтому приходится окольными путями реализовывать.
Вот над компонентами поиздеваться я люблю. Ибо убежден, что стандартные компоненты такие «простецкие» на самом деле для того, чтобы не мешать их модифицировать в нужном направлении. Не даром же и PaintWindow вынесен в отдельный виртуальный метод, и csCustomPaint имеется.
Про эти издевательства, и про эффекты, планируется в дальнейшем написать цикл статей. Надеюсь, что в этом году все получится. Надо еще Direct2D-эффекты дооформлять. Там далеко не все эффекты описаны, хоть и реализовано уже много.
7: Message.Result := HTBOTTOMRIGHT; заменить на 7: Message.Result := HTBOTTOMLEFT; а остальном весьма любопытный пример, спасибо за публикацию.
Спасибо за столь внимательное отношение к материалу!
Вы правы, там конечно HTBOTTOMLEFT. Исправил )))
А насчёт плюсов «родного» заголовка, конечно, заблуждение: от него отказываются и идут на различные ухищрения как раз именно потому, что он не поддерживает даже тёмную тему Windows 11 (он всегда белого цвета).
Ответил тут.
Ответ на комментарий Гостьи
Не соглашусь. Любые глюки ОС — это глюки, про которые можно где-то прочитать, дождаться исправления. Это стандартное, пусть даже неправильное, поведение окна. Форсировать движок имеет смысл, когда участвуешь в гонках. В остальных случаях лучше не заходить на темную территорию. То есть при принятии решения о своём заголовке надо сильно подумать — ради чего? Стоит ли овчинка выделки?
Любовь к искусству и врожденный перфекционизм — не аргумент. Аргумент — это тот парень, который после тебя будет курить код, это глюки, когда вместо HTBOTTOMLEFT написал что-то другое, это изумлённый пользователь, который не смог оценить силу таланта и отказался от продукта.
Не верю. У меня наоборот все спрашивают, почему в моём приложении есть это бельмо, от которого я никак не могу избавиться.
Тема Windows 10 Dark проблему не решает? Windows 11 под рукой проверить нет.
Вот, кстати, человек определяет наличие темной темы Windows.
Добавив это тема будет определяться и использоваться на взлёте.
Поставил таки в виртуалку 11-й вин. Менять тему окна (включая и заголовок) можно очень просто с помощью той же DwmSetWindowAttribute. Работает, кстати и для Win10.
Случилось чудо: наконец-то хоть кто-то догадался всё это систематизировать и собрать и показать в одном месте!
Спасибо!
Вам спасибо!!! )))
Если в примере включить GDI+, Red Border = true и Border Width = 1, то правая и нижняя границы не отображаются и не реагируют на наведение курсора. Это как-то можно починить?
Для появления красной рамки в полном варианте можно сделать так:
С курсорами стрелок и ресайзом пока не понятно. Вроде работает. Конечно, надо прицеливаться в одно-пиксельную ширину, не сильно удобно, но работает. Неплохо бы глянуть проект. На окне смотрю кнопка появилась, может изменилось что-то?
У вас всё работает? Странно. У меня в демонстрационном примере, если включить всю связку:
1) GDI+
2) Red Border = true
3) Border Width = 1
то правая и нижняя границы вообще на мышь не реагируют (курсор не меняется). И их даже не видно.
Никаких изменений конечно в пример мною не вносилось.
Обновил архивы, попробуйте?
А можно исходники, пожалуйста, если не затруднит? Мне песочницу долго заводить для проверки исполняемого 🙁
Архив исходников обновлён
Спасибо за обновление! К сожалению, что с GDI+, что без — правой и нижней границ в 1 пиксель не видно ни мне, ни мышке.
Архив скачан отсюда, экзешник ведёт себя так.
Да, спасибо, а я на десятке пока не могу проверить, у меня временно ноут на восьмёрке.
Огромное спасибо! Очень познавательно и однозначно в сундучок знаний.
Но меня давно интересует вопрос: как добавить тень к окнам с использованием VCL стилей? Пока единственное решение — это применение CS_DROPSHADOW. Но оно не работает для дочерних окон, только для главного. Хотелось получить полноценную DWM тень для всех окон приложения с использованием VCL стилей. Вы не рассматривали такой вопрос?
Я пробовал использовать код вашего примера для окон с VCL стилем и стандартным заголовком окна — но тени нет. А если убрать заголовок, тогда полноценная тень есть. Я не сильный знаток Delphi, но может в вашем коде просто нужно что-то добавить или поправить, чтобы получить полную тень для окна с заголовком и VCL стилем?
Странно, что уже сколько лет как появились VCL стили (с ХЕ2), но разработчики до сих пор не реализовали для них полноценную тень. А без тени окно выглядит безликим и трудно различимым на фоне других открытых окон.
Не особо люблю VCL стили, поэтому, видимо, и не замечал подобного. Реально нет симпатичной dwm-тени! А используя CS_DROPSHADOW получаем пересечение полигонов и тень строится по объединённому полигону. Прикольно ))) Спасибо, что обратили внимание. Проблема интересная, надо бы её поковырять при случае. Народ пишет, что нерешаема.
В Delphi XE 12 проблема не решена, только что проверил.
Пока видится два пути:
1) Сделать всем формам StyleElements := [seFont,seClient] (или StyleElements — [seBorder] ) и мириться со стандартным заголовком;
2) Сделать без рамки и имитировать заголовок.
Посмотрел, как делают Almediadev. Они так и делают — отрубают в стилях Border и убирают рамку.
Пока, чтобы минимизировать телодвижения, можно всем окнам в проекте назначить CS_DROPSHADOW. Показывать окно с небольшим «финтом». После Show перевести фокус на себя, потом на показываемую форму. Это избавит от косяка с тенью в первом ответе
Большое спасибо! Не ожидал столь быстрого ответа, думал тема с автором уже история. Супер!
Я как раз ломал голову над тем, как у дочернего окна активировать CS_DROPSHADOW. Тоже обратил внимание, что если окно переместить за пределы главного окна, то тень появляется. Также эта тень появляется, если кликнуть по заголовку окна. А если кликнуть повторно, то тень пропадает. Короче чудеса да и только. Так вот сидел и думал (искал в инете), как же эмулировать клик по заголовку окошка после его отображения на экране.
У тут как раз и Вы с готовым решением.