Board index » delphi » Help please, on Creating Owner-Drawn Menu Items

Help please, on Creating Owner-Drawn Menu Items

Dear all,

        I cannot receive WM_MEASUREITEM and WM_DRAWITEM message after calling
InsertMenu, AppendMenu, or InsertMenuItem API calls using MF_OWNERDRAW in
uFlag.  I have tried a few message handling tech already.

1.  Set Application.OnMessage handler to my own handler
2.  Using
     procedure WM_MEASUREITEM(var Msg: TMessage); Message WM_MEASUREITEM;
3.  Overriding WndProc to capture all messages

        I have tried tracing WM_MEASUREITEM message using WinSight32.  And I think
that the message is eaten by a TPUtilWindow window, which is hidden in my
application.  How could I overcome this problem or have a alternate method
on making owner-drawn menu item?

Kings
kin...@hotmail.com

 

Re:Help please, on Creating Owner-Drawn Menu Items


A quick and Dirty solution for your problem :

I just nedeed PopupMenus to be Ownerdrawn so this program doesn't works
fine with
MainMenus.

I hope it could help you :-)

Jean-Luc Mattei
France
jl...@club-internet.fr

unit ExMenus;

interface

uses Windows, SysUtils, Classes, Messages, Menus, DsgnIntf, Forms,
Controls, StdCtrls, Graphics;

type
  TDrawMenuItemEvent = procedure(Control: TMenu; Index: Integer;
    Rect: TRect; State: TOwnerDrawState) of object;
  TMeasureMenuItemEvent = procedure(Control: TMenu; Index: Integer;
    var Height, Width: Integer) of object;

  TMenuExtender = class(TComponent)
  private
    FCanvas: TCanvas;
    FMenu: TMenu;
    FFont: TFont;
    FBrush: TBrush;
    FItemHeight: Integer;
    FItemWidth: Integer;
    FTPUHandle: THandle;
    FNewWndProcInstance: Pointer;
    FOldWndProc: Pointer;
    FOnDrawItem: TDrawMenuItemEvent;
    FOnMeasureItem: TMeasureMenuItemEvent;
  protected
    procedure SetMenu(Value: TMenu);
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message
CN_MEASUREITEM;
    procedure DrawItem(Index: Integer; Rect: TRect; State:
TOwnerDrawState); virtual;
    procedure MeasureItem(Index: Integer; var Height, Width: Integer);
virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure  NewWndProc(Var Message: TMessage);
  published
    property Menu: TMenu read FMenu write SetMenu;
    property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write
FOnDrawItem;
    property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write
FOnMeasureItem;
    property ItemHeigth: Integer read FItemHeight write FItemHeight;
    property ItemWidth: Integer read FItemWidth write FItemWidth;
    property Font: TFont read FFont write FFont;
    property Color: TBrush read FBrush write FBrush;
    property Canvas: TCanvas read FCanvas;
  end;

procedure Register;

implementation

const FTPUCount: Integer = 0;

{ TMenuExtender }

constructor TMenuExtender.Create(AOwner: TComponent);
begin
  // TPUtilWindow is a @#!!##@& window created by delphi
  // It's defaultProc Eats WM_DRAWITEM and WM_MEASUREITEM from Menus !!!
???
  // So We Have to Override this problem :

  // Get the Handle of this @#!!##@& window
  Inc(FTPUCount);
  if ( FTPUCount = 1 ) then begin
    FTPUHandle:= FindWindow('TPUtilWindow', '');
    // Create a new proc pointer
    FNewWndProcInstance := MakeObjectInstance(NewWndProc);
    // Keep the old DefaultProc
    FOldWndProc := Pointer(GetWindowLong(FTPUHandle, GWL_WNDPROC));
    // Set the new Proc
    SetWindowLong(FTPUHandle, GWL_WNDPROC, Longint(FNewWndProcInstance));
  end;
  FMenu:= nil;
  inherited Create(AOwner);
  FCanvas:= TCanvas.Create;
  FItemHeight:= 15;
  FItemWidth:= 100;

  FFont:= TFont.Create;
  FBrush:= TBrush.Create;
  FBrush.Color:= clBtnFace;
  FOnDrawItem:= nil;
  FOnMeasureItem:= nil;
end;

destructor TMenuExtender.Destroy;
begin
  FFont.Free;
  FBrush.Free;
  FCanvas.Free;
  Dec(FTPUCount);
  // We have to set back the old default Proc
  SetWindowLong(FTPUHandle, GWL_WNDPROC, Longint(FOldWndProc));
  // and to release Our WndProc instance
  FreeObjectInstance(FNewWndProcInstance);
  inherited Destroy;
end;

procedure TMenuExtender.SetMenu(Value: TMenu);
Var i: Integer;
begin
  if ( FMenu <> Value ) then begin
    if ( FMenu <> nil ) and ( Value = nil ) then begin
      for i:= 0 to FMenu.Items.Count - 1 do begin
        if ( FMenu.Items[i].Break <> mbBarBreak ) then
          ModifyMenu(FMenu.Handle, FMenu.Items[i].Command, MF_BYCOMMAND,
FMenu.Items[i].Command, nil);
      end;
    end
    else begin
      if ( FMenu = nil ) and ( Value <> nil ) then begin
        FMenu:= Value;
        for i:= 0 to FMenu.Items.Count - 1 do begin
          if ( FMenu.Items[i].Break <> mbBarBreak ) then
            ModifyMenu(FMenu.Handle, FMenu.Items[i].Command, MF_BYCOMMAND
or MF_OWNERDRAW, FMenu.Items[i].Command, nil)
          else
            ModifyMenu(FMenu.Handle, FMenu.Items[i].Command, MF_BYCOMMAND
or MF_OWNERDRAW or MF_MENUBREAK, FMenu.Items[i].Command, nil)
        end;
      end;
    end;
    FMenu:= Value;
  end;
end;

procedure TMenuExtender.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Message.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    FCanvas.Handle := hDC;
    FCanvas.Font := FFont;
    FCanvas.Brush := FBrush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      FCanvas.Brush.Color := clHighlight;
      FCanvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State) else
      FCanvas.FillRect(rcItem);
    if odFocused in State then DrawFocusRect(hDC, rcItem);
    FCanvas.Handle := 0;
  end;
end;

procedure TMenuExtender.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemHeight := FItemHeight;
    itemWidth := FItemWidth;
    MeasureItem(itemID, Integer(itemHeight), Integer(itemWidth));
  end;
end;

procedure TMenuExtender.NewWndProc(Var Message: TMessage);
begin
  // Only used to handle WM_DRAWITEM and WM_MEASUREITEM from Menus
  if ( FMenu <> nil ) then begin
    case Message.Msg of
      WM_DRAWITEM    : if ( TWMDrawItem(Message).DrawItemStruct^.CtlType =
ODT_MENU ) and
                          ( TWMDrawItem(Message).DrawItemStruct^.hwndItem =
FMenu.Handle ) then begin
                         Message.Msg:= Message.Msg + CN_BASE;
                         Dispatch(Message);
                       end;
      WM_MEASUREITEM : if ( TWMMeasureItem(Message).idCtl = 0 ) then begin
                         Message.Msg:= Message.Msg + CN_BASE;
                         Dispatch(Message);
                       end;
    end;
  end;
  // else we call the old DefaultProc.
  Message.Result:= CallWindowProc(FOldWndProc, FTPUHandle, Message.Msg,
Message.WParam, Message.LParam);
end;

procedure TMenuExtender.MeasureItem(Index: Integer; var Height, Width:
Integer);
begin
  if Assigned(FOnMeasureItem) then FOnMeasureItem(FMenu, Index, Height,
Width)
end;

procedure TMenuExtender.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  if Assigned(FOnDrawItem) then FOnDrawItem(FMenu, Index, Rect, State)
  else
  begin
    FCanvas.FillRect(Rect);
    FCanvas.TextOut(Rect.Left + 2, Rect.Top, FMenu.Items[Index-1].Caption);
  end;
end;

procedure Register;
begin
  RegisterComponents('Exemples', [TMenuExtender]);
end;

end.

Other Threads