Остаток полосы меню закрашивается своими руками, с отчётом в журнал
До этого места не дотянуться ни отрисовкой пунктов (это не пункт), ни подложкой через SetMenuInfo: под Wine пункты выходят тёмными, а полоса остаётся светлой. Полоса живёт в неклиентской части окна, поэтому закрашиваем прямо туда: правый край последнего названия берётся из GetMenuItemRect, границы полосы из GetMenuBarInfo, всё что правее — заливается нашей кистью. Закраска подновляется на перерисовке рамки окна и по таймеру: система трогает полосу и по другим поводам, а рисуем мы поверх неё. Прямоугольник и цвет те же, поэтому подновление не видно. Заодно закраска сама отчитывается в журнал: какие прямоугольники выдала система и куда мы рисовали. Полоса упорно остаётся светлой, а гадать по снимкам экрана дальше некуда.
This commit is contained in:
parent
1e6da9b592
commit
36499edd50
2 changed files with 179 additions and 1 deletions
|
|
@ -29,6 +29,13 @@ uses
|
|||
uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
|
||||
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform;
|
||||
|
||||
const
|
||||
{ Номера системных сообщений о перерисовке рамки окна. Берём числами, а
|
||||
не из модуля Windows: тот переопределяет TRect и Point, и обычные
|
||||
вызовы LCL начинают разбираться как системные. }
|
||||
MsgNcPaint = $0085;
|
||||
MsgNcActivate = $0086;
|
||||
|
||||
type
|
||||
|
||||
{ TMainForm }
|
||||
|
|
@ -62,6 +69,12 @@ type
|
|||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
{$IFDEF LCLWIN32}
|
||||
{ Остаток полосы меню закрашивается после того, как систему нарисовала
|
||||
рамку окна. Раньше — бесполезно: она закрасит поверх. }
|
||||
procedure WMNCPaint(var Msg: TLMessage); message MsgNcPaint;
|
||||
procedure WMNCActivate(var Msg: TLMessage); message MsgNcActivate;
|
||||
{$ENDIF}
|
||||
procedure lstPoolClick(Sender: TObject);
|
||||
procedure lstPoolMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
|
|
@ -654,6 +667,15 @@ var
|
|||
Frac: Double;
|
||||
Total, Done: Integer;
|
||||
begin
|
||||
{$IFDEF LCLWIN32}
|
||||
{ Заодно подновляем закраску остатка полосы меню.
|
||||
|
||||
Обработчика перерисовки рамки может не хватить: система трогает
|
||||
полосу и по другим поводам, а рисуем мы поверх неё. Прямоугольник тот
|
||||
же и цвет тот же, поэтому подновление не видно. }
|
||||
PaintMenuBarTail(Self);
|
||||
{$ENDIF}
|
||||
|
||||
Note := '';
|
||||
Frac := 0;
|
||||
|
||||
|
|
@ -697,6 +719,20 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF LCLWIN32}
|
||||
procedure TMainForm.WMNCPaint(var Msg: TLMessage);
|
||||
begin
|
||||
inherited;
|
||||
PaintMenuBarTail(Self);
|
||||
end;
|
||||
|
||||
procedure TMainForm.WMNCActivate(var Msg: TLMessage);
|
||||
begin
|
||||
inherited;
|
||||
PaintMenuBarTail(Self);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TMainForm.FormShow(Sender: TObject);
|
||||
var
|
||||
I: Integer;
|
||||
|
|
@ -715,6 +751,10 @@ begin
|
|||
не делал: пункты рисовались нашими руками, а полоса правее последнего
|
||||
названия оставалась светлой. }
|
||||
ApplyDarkMenu(Menu);
|
||||
PaintMenuBarTail(Self);
|
||||
{$IFDEF LCLWIN32}
|
||||
Log(MenuBarTailNote);
|
||||
{$ENDIF}
|
||||
|
||||
StartPlayer;
|
||||
|
||||
|
|
|
|||
140
src/uTheme.pas
140
src/uTheme.pas
|
|
@ -157,6 +157,22 @@ procedure HookNewForms;
|
|||
win32; под gtk2 цвет задаётся строкой стиля, см. ApplyMenuStyle. }
|
||||
procedure ApplyDarkMenu(AMenu: TMenu);
|
||||
|
||||
{ Закрашивает остаток полосы меню — то место правее последнего названия,
|
||||
которое не занято ни одним пунктом.
|
||||
|
||||
Нужно потому, что до него не дотянуться ни отрисовкой пунктов (это не
|
||||
пункт), ни подложкой через SetMenuInfo (проверено под Wine: пункты
|
||||
тёмные, полоса светлая). Полоса живёт в неклиентской части окна,
|
||||
поэтому рисуем прямо в её область.
|
||||
|
||||
Под gtk2 ничего не делает: там всю полосу красит строка стиля. }
|
||||
procedure PaintMenuBarTail(AForm: TCustomForm);
|
||||
|
||||
{ Что вышло у последней закраски: какие прямоугольники выдала система и
|
||||
куда мы рисовали. Нужно, чтобы не гадать, почему полоса осталась
|
||||
светлой. }
|
||||
function MenuBarTailNote: string;
|
||||
|
||||
{ Цвета для меню, которое рисует не программа, а система.
|
||||
|
||||
Вызывать до создания окон: строка стиля разбирается один раз, и уже
|
||||
|
|
@ -211,9 +227,40 @@ function SetMenuInfo(AMenu: HMENU; const AInfo: TMenuInfoRec): LongBool;
|
|||
stdcall; external 'user32' name 'SetMenuInfo';
|
||||
|
||||
{ Имя своё, а не DrawMenuBar: так называется и функция LCL, а имена в
|
||||
Паскале нечувствительны к регистру. }
|
||||
Паскале нечувствительны к регистру. По той же причине своё имя у всех
|
||||
остальных вызовов ниже. }
|
||||
function SysDrawMenuBar(AWnd: HWND): LongBool;
|
||||
stdcall; external 'user32' name 'DrawMenuBar';
|
||||
|
||||
type
|
||||
TMenuBarInfoRec = record
|
||||
cbSize: DWORD;
|
||||
rcBar: TRect;
|
||||
hMenu: HMENU;
|
||||
hwndMenu: HWND;
|
||||
Flags: DWORD; { два битовых признака, нам не нужны }
|
||||
end;
|
||||
|
||||
const
|
||||
{ Знаковое, как в заголовках Windows: -3. }
|
||||
OBJID_MENU = LongInt(-3);
|
||||
|
||||
function SysGetMenuBarInfo(AWnd: HWND; AObject, AItem: LongInt;
|
||||
var AInfo: TMenuBarInfoRec): LongBool;
|
||||
stdcall; external 'user32' name 'GetMenuBarInfo';
|
||||
function SysGetMenuItemRect(AWnd: HWND; AMenu: HMENU; AItem: UINT;
|
||||
var ARect: TRect): LongBool;
|
||||
stdcall; external 'user32' name 'GetMenuItemRect';
|
||||
function SysGetMenuItemCount(AMenu: HMENU): Integer;
|
||||
stdcall; external 'user32' name 'GetMenuItemCount';
|
||||
function SysGetWindowDC(AWnd: HWND): HDC;
|
||||
stdcall; external 'user32' name 'GetWindowDC';
|
||||
function SysReleaseDC(AWnd: HWND; ADC: HDC): Integer;
|
||||
stdcall; external 'user32' name 'ReleaseDC';
|
||||
function SysFillRect(ADC: HDC; const ARect: TRect; ABrush: HBRUSH): Integer;
|
||||
stdcall; external 'user32' name 'FillRect';
|
||||
function SysGetWindowRect(AWnd: HWND; var ARect: TRect): LongBool;
|
||||
stdcall; external 'user32' name 'GetWindowRect';
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
|
|
@ -854,6 +901,97 @@ begin
|
|||
{$ENDIF}
|
||||
end;
|
||||
|
||||
var
|
||||
TailNote: string = 'закраска полосы меню не вызывалась';
|
||||
|
||||
function MenuBarTailNote: string;
|
||||
begin
|
||||
Result := TailNote;
|
||||
end;
|
||||
|
||||
procedure PaintMenuBarTail(AForm: TCustomForm);
|
||||
{$IFDEF LCLWIN32}
|
||||
var
|
||||
Info: TMenuBarInfoRec;
|
||||
WinRect, ItemRect, Fill: TRect;
|
||||
DC: HDC;
|
||||
Count: Integer;
|
||||
Menu: HMENU;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF LCLWIN32}
|
||||
if (AForm = nil) or (not AForm.HandleAllocated) or (MenuBrush = 0) then
|
||||
begin
|
||||
TailNote := 'полоса: нет окна или кисти';
|
||||
Exit;
|
||||
end;
|
||||
if (AForm.Menu = nil) or (not AForm.Menu.HandleAllocated) then
|
||||
begin
|
||||
TailNote := 'полоса: у меню нет дескриптора';
|
||||
Exit;
|
||||
end;
|
||||
Menu := AForm.Menu.Handle;
|
||||
|
||||
FillChar(Info{%H-}, SizeOf(Info), 0);
|
||||
Info.cbSize := SizeOf(Info);
|
||||
if not SysGetMenuBarInfo(AForm.Handle, OBJID_MENU, 0, Info) then
|
||||
begin
|
||||
TailNote := 'полоса: GetMenuBarInfo отказала';
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Count := SysGetMenuItemCount(Menu);
|
||||
if Count <= 0 then
|
||||
begin
|
||||
TailNote := 'полоса: пунктов не найдено';
|
||||
Exit;
|
||||
end;
|
||||
{ Правый край последнего названия. Всё, что правее, — ничьё, его и
|
||||
закрашиваем. }
|
||||
if not SysGetMenuItemRect(AForm.Handle, Menu, Count - 1, ItemRect{%H-}) then
|
||||
begin
|
||||
TailNote := 'полоса: GetMenuItemRect отказала';
|
||||
Exit;
|
||||
end;
|
||||
if not SysGetWindowRect(AForm.Handle, WinRect{%H-}) then
|
||||
begin
|
||||
TailNote := 'полоса: GetWindowRect отказала';
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Обе рамки система выдаёт в координатах экрана, а рисуем мы в
|
||||
координатах окна. }
|
||||
Fill.Left := ItemRect.Right - WinRect.Left;
|
||||
Fill.Top := Info.rcBar.Top - WinRect.Top;
|
||||
Fill.Right := Info.rcBar.Right - WinRect.Left;
|
||||
Fill.Bottom := Info.rcBar.Bottom - WinRect.Top;
|
||||
TailNote := Format(
|
||||
'полоса: пунктов %d, полоса экрана %d,%d..%d,%d, край пункта %d, ' +
|
||||
'окно %d,%d, красим %d,%d..%d,%d',
|
||||
[Count, Info.rcBar.Left, Info.rcBar.Top, Info.rcBar.Right,
|
||||
Info.rcBar.Bottom, ItemRect.Right, WinRect.Left, WinRect.Top,
|
||||
Fill.Left, Fill.Top, Fill.Right, Fill.Bottom]);
|
||||
|
||||
if (Fill.Right <= Fill.Left) or (Fill.Bottom <= Fill.Top) then
|
||||
begin
|
||||
TailNote := TailNote + ' — красить нечего';
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DC := SysGetWindowDC(AForm.Handle);
|
||||
if DC = 0 then
|
||||
begin
|
||||
TailNote := TailNote + ' — окно не дало холста';
|
||||
Exit;
|
||||
end;
|
||||
try
|
||||
SysFillRect(DC, Fill, MenuBrush);
|
||||
finally
|
||||
SysReleaseDC(AForm.Handle, DC);
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure ApplyDarkMenu(AMenu: TMenu);
|
||||
|
||||
procedure Walk(AItem: TMenuItem);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue