Owner Drawing the Submenu Arrow

[nglthach 23]

Hi folks,

 

I am trying to skin menu item. I have successfully customize the menu item appearance. But if the menu has sub menu, I could not owner drawing the arrow. Here is my code:

procedure TForm12.cmniOpenRecentAdvancedDrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
  // Prevent the OS drawing the arrow
  ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

procedure TForm12.cmniOpenRecentDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := clRed;
  ACanvas.Rectangle(ARect);
  // Prevent the OS drawing the arrow
  ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

Here is the result:

 

As you see, the arrow still there although I already draw a rectangle to the whole menu item's rect.

Do you know how to prevent the OS drawing the arrow? Thanks!

 

 

[programmerdelphi2k 237]

the "arrow" is drawed by OS, here a C code that you study how manipulate it...

https://www.codeguru.com/cplusplus/owner-drawing-the-submenu-arrow/

[nglthach 23]

Thanks! It solved my problem!

[nglthach 23]

The problem is VCL TCustomForm.WndProc call SaveDC before the owner drawing method, then restore the drawing context by calling RestoreDC

Solving the problem by overriding WndProc as:

 

interface

TForm12 = class(TForm)
  public
    procedure WndProc(var Message: TMessage); override;
  end;
  
implementation

procedure TForm12.WndProc(var Message: TMessage);
var
  MenuItem: TMenuItem;
  Canvas: TCanvas;
  SaveIndex: Integer;
begin
  if Message.Msg = WM_DRAWITEM then
  begin
    with PDrawItemStruct(Message.LParam)^ do
      if (CtlType = ODT_MENU) and Assigned(Menu) and not IsVclControl(HWndItem) then
      begin
        MenuItem := Menu.FindItem(itemID, fkCommand);
        if (MenuItem <> nil) and not (MenuItem.GetParentComponent is TMainMenu) then
        begin
          Canvas := TControlCanvas.Create;
          with Canvas do
          try
            //SaveIndex := SaveDC(hDC); <==== here is the problem
            try
              Handle := hDC;
              Font := Screen.MenuFont;
              Vcl.Menus.DrawMenuItem(MenuItem, Canvas, rcItem,
                TOwnerDrawState(LoWord(itemState)));
            finally
              Handle := 0;
              //RestoreDC(hDC, SaveIndex) <==== here is the problem
            end;
          finally
            Free;
          end;
          Exit;
        end;
      end;
  end;

  inherited WndProc(Message);

end;

 

[Remy Lebeau 1394]

4 hours ago, nglthach said:

The problem is VCL TCustomForm.WndProc call SaveDC before the owner drawing method, then restore the drawing context by calling RestoreDC

Solving the problem by overriding WndProc

Here is a dirtier hack that shouldn't require overriding WndProc at all (untested!):

procedure TForm12.cmniOpenRecentAdvancedDrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
  // pop the HDC state that TForm saved...
  RestoreDC(ACanvas.Handle, -1);

  // Prevent the OS from drawing the arrow...
  ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);

  // save the new state so TForm will restore it...
  SaveDC(ACanvas.Handle);
end;

procedure TForm12.cmniOpenRecentDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
  ...
  // OnAdvancedDrawItem is fired after OnDrawItem, so don't exclude here...
  // ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

 

[programmerdelphi2k 237]

@nglthach  it works in RAD 11.3  🙂

 

but @Remy Lebeau  was more simple way and works too!  🙂 

 

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  MainMenu1.OwnerDraw := not MainMenu1.OwnerDraw;
end;

procedure TForm1.Printer1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
  // pop the HDC state that TForm saved...
  RestoreDC(ACanvas.Handle, -1);

  // Prevent the OS from drawing the arrow...
  ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);

  // save the new state so TForm will restore it...
  SaveDC(ACanvas.Handle);
end;

procedure TForm1.Printer1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
  LText: string;
begin
  LText               := TMenuItem(Sender).Caption;
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := clRed;
  ACanvas.Rectangle(ARect);
  ACanvas.TextRect(ARect, LText, []);
  //
  // OnAdvancedDrawItem is fired after OnDrawItem, so don't exclude here...
  ExcludeClipRect(ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

 

 

Edited April 2, 2023 by programmerdelphi2k