Tried to colorize 1-px line under TMainMenu, need help

Forum > Win32/64

(1/1)

AlexTP:
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- WM_NCPAINT: begin if TWin32ThemeServices(ThemeServices).ThemesEnabled and (lWinControl is TCustomControl) and not (lWinControl is TCustomForm) then begin TWin32ThemeServices(ThemeServices).PaintBorder(lWinControl, True); LMessage.Result := 0; end; PaintLineUnderMenubar(TargetWindow); end;
with my func:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure PaintLineUnderMenubar(Window: Hwnd);var R, RScr: TRect; br: HBRUSH; dc: HDC;begin if not IsWindow(Window) then exit; if GetMenu(Window) = 0 then Exit; GetClientRect(Window, R); MapWindowPoints(Window, NULL, R, 2); GetWindowRect(Window, RScr); OffsetRect(R, -RScr.Left, -RScr.Top); Dec(R.Top); R.Bottom := R.Top + 2; dc := GetWindowDC(Window); br := CreateSolidBrush(clRed); FillRect(dc, R, br); DeleteObject(br); ReleaseDC(Window, dc);end;
Can you help?
Screenshot of current white line - is added.

winni:
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

Handoko:
I ever had such problem too in the past. :)

AlexTP:
@winni, thanks, edited the 1st post - it still don't work...

wp:
In Lazarus the WM* messages were renamed to LM*. Please try to catch message LM_NCPAINT.

Navigation

[0] Message Index