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

AlexTP

Hero Member
Posts: 1997

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][+]

    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 [Select][+]

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; 
 