Recent

Author Topic: Tried to colorize 1-px line under TMainMenu, need help  (Read 242 times)

Alextp

  • Hero Member
  • *****
  • Posts: 1149
    • UVviewsoft
Tried to colorize 1-px line under TMainMenu, need help
« on: September 19, 2020, 01:58:12 pm »
For Win32MenuStyler https://wiki.freepascal.org/Win32MenuStyler
I need to colorize 1 px horizontal line under MainMenu. It is painted by OS in non-client area.
C++ sample how to do it:
https://stackoverflow.com/questions/57177310/how-to-paint-over-white-line-between-menu-bar-and-client-area-of-window

I tried to add it to Win32 WS, near the "WM_NCPAINT:" in TWindowProcHelper.DoWindowProc, but failed. I added:

Code: Pascal  [Select][+][-]
  1.     WM_NCPAINT:
  2.     begin
  3.       if TWin32ThemeServices(ThemeServices).ThemesEnabled and
  4.         (lWinControl is TCustomControl) and not (lWinControl is TCustomForm) then
  5.       begin
  6.         TWin32ThemeServices(ThemeServices).PaintBorder(lWinControl, True);
  7.         LMessage.Result := 0;
  8.       end;
  9.       PaintLineUnderMenubar(TargetWindow);
  10.     end;
  11.  

with my func:
Code: Pascal  [Select][+][-]
  1. procedure PaintLineUnderMenubar(Window: Hwnd);
  2. var
  3.   R, RScr: TRect;
  4.   br: HBRUSH;
  5.   dc: HDC;
  6. begin
  7.   if not IsWindow(Window) then exit;
  8.   if GetMenu(Window) = 0 then Exit;
  9.  
  10.   GetClientRect(Window, R);
  11.   MapWindowPoints(Window, NULL, R, 2);
  12.   GetWindowRect(Window, RScr);
  13.   OffsetRect(R, -RScr.Left, -RScr.Top);
  14.   Dec(R.Top);
  15.  
  16.   R.Bottom := R.Top + 2;
  17.  
  18.   dc := GetWindowDC(Window);
  19.   br := CreateSolidBrush(clRed);
  20.   FillRect(dc, R, br);
  21.   DeleteObject(br);
  22.   ReleaseDC(Window, dc);
  23. end;
  24.  

Can you help?
Screenshot of current white line - is added.
« Last Edit: September 19, 2020, 04:14:28 pm by Alextp »

winni

  • Hero Member
  • *****
  • Posts: 1904
Re: Tried to colorize 1-px line under TMainMenu, need help
« Reply #1 on: September 19, 2020, 03:30:24 pm »
Hi!

Your Rectangle has a height of zero:

R.Bottom := R.Top + 1;

This will fill the area from R.Top to R.Bottom -1. That is zero.

Do:

R.Bottom := R.Top + 2;

Allways the same trouble with the Integer-Rects.

Winni

PS.: Or just draw a line
« Last Edit: September 19, 2020, 03:33:23 pm by winni »

Handoko

  • Hero Member
  • *****
  • Posts: 3868
  • My goal: build my own game engine using Lazarus
Re: Tried to colorize 1-px line under TMainMenu, need help
« Reply #2 on: September 19, 2020, 03:48:38 pm »
I ever had such problem too in the past.  :)

Alextp

  • Hero Member
  • *****
  • Posts: 1149
    • UVviewsoft
Re: Tried to colorize 1-px line under TMainMenu, need help
« Reply #3 on: September 19, 2020, 04:15:05 pm »
@winni, thanks, edited the 1st post - it still don't work...

wp

  • Hero Member
  • *****
  • Posts: 7636
Re: Tried to colorize 1-px line under TMainMenu, need help
« Reply #4 on: September 19, 2020, 04:39:58 pm »
In Lazarus the WM* messages were renamed to LM*. Please try to catch message LM_NCPAINT.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

 

TinyPortal © 2005-2018