Give your menus a (customisable) new look with this component

Create a new look for your menus with this VCL.

Set the Ownerdraw property of the Menu you wish to change to true, and call the Execute method.





unit XpMenu;



interface



uses

  Windows, Classes, Graphics, Menus;



type

  TXpMenu = class(TComponent)

  private

    { Private declarations }

   FSelColor:TColor;

   FStripColor:TColor;

   FBackColor:TColor;

   FStripWidth:integer;

   FSelFontColor:TColor;

   FNotSelFontColor:TColor;

   FNotActiveColor:TColor;

  protected

    { Protected declarations }

  public

    { Public declarations }

    Procedure Execute;

    Procedure RemoveXPs;

    Constructor Create(AOwner:TComponent);override;

  published

    { Published declarations }

    procedure DefMenuDrawItem(Sender: TObject; ACanvas: TCanvas;

      ARect: TRect; Selected: Boolean);

    procedure DefMenuMeasureItem(Sender: TObject; ACanvas: TCanvas;

      var Width, Height: Integer);

    procedure DefMenuAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;

      ARect: TRect; State: TOwnerDrawState);

    property SelectionColor:TColor read FSelColor write FSelColor;

    property SelectionFontColor: TColor read FSelFontColor write FSelFontColor;

    property NotSelectedFontColor: TColor read FNotSelFontColor write FNotSelFontColor;

    property NotActiveColor: TColor read FNotActiveColor write FNotActiveColor;

    property StripColor:TColor read FStripColor write FStripColor;

    property BackColor:TColor read FBackColor write FBackColor;

    property StripWidth:integer read FStripWidth write FStripWidth;



  end;



procedure Register;



implementation



constructor TXpMenu.Create(AOwner:TComponent);

begin

  inherited Create(AOwner);

  FSelFontColor:=clWhite;

  FSelColor:=$00FEC0D0;

  FStripColor:=clGray;

  FBackColor:=clWhite;

  FNotSelFontColor:=clBlack;

  FNotActiveColor:=clGray;

  FStripWidth:=20;

end;





procedure TXpMenu.DefMenuDrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; Selected: Boolean);

const

  cHotkeyPrefix='&';

  Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

var

  myBaseR:TRect;

  myrect:TRect;

  myBRect:TRect;

  mySrect:TRect;

  vCaption:String;

  vColumn:integer;

  ParentMenu:TMenu;

  Flags:integer;

  NotEnabled:boolean;

  Alignment: TPopupAlignment;

  BitMp:TBitmap;

begin

  BitMp:=TBitmap.Create;

  ParentMenu := TMenuItem(Sender).GetParentMenu;

  NotEnabled:= TMenuItem(Sender).Enabled = false;

  //outputdebugstring(pchar(string(ParentMenu.ClassName)));

  if ParentMenu is TMenu then

    Alignment := paLeft

  else if ParentMenu is TPopupMenu then

    Alignment := TPopupMenu(ParentMenu).Alignment

  else

    Alignment := paLeft;

  myBaseR.Left:=ARect.Left;

  myBaseR.Right:=myBaseR.Left+FStripWidth;

  myBaseR.Top:=ARect.Top;

  myBaseR.Bottom:=ARect.Bottom;

  Myrect.Left:=ARect.Left+FStripWidth;

  Myrect.Right:=ARect.Right;

  Myrect.Top:=ARect.Top;

  Myrect.Bottom:=ARect.Bottom;

  mySrect.Left:=ARect.Left;

  mySrect.Right:=ARect.Right;

  mySrect.Top:=ARect.Top;

  mySrect.Bottom:=ARect.Bottom;

  if not ((Sender as TMenuItem).Parent.Name='') then

   begin

      ACanvas.Brush.Color:=FStripColor;

      ACanvas.FillRect(myBaseR);

      if not ((Sender as TMenuItem).Caption='-') then

        begin

          if Selected then

            begin

              ACanvas.Brush.Color:=FSelColor;//clSilver;

              ACanvas.FillRect(Myrect);

              ACanvas.Rectangle(mySrect);

              if (Sender as TMenuItem).Bitmap<>nil then

                begin

                  MyBrect.Left:=ARect.Left+2;

                  MyBrect.Right:=MyBrect.Left+(Sender as TMenuItem).Bitmap.Width;

                  MyBrect.Top:=ARect.Top+2;

                  MyBrect.Bottom:=ARect.Top+(Sender as TMenuItem).Bitmap.Height;

                  ACanvas.Brush.Color:=FStripColor;

                  ACanvas.FillRect(MyBrect);

                  //If (Sender as TMenuItem).ImageIndex>-1 then

                  // begin

                  // (ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);

                  // end;



                  If (Sender as TMenuItem).ImageIndex>-1 then

                    begin

                      if (ParentMenu is TMainMenu) then

                        begin

                          if not ((ParentMenu as TMainMenu).Images=nil) then

                            (ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);

                        end

                      else

                        begin

                          if not ((ParentMenu as TPopupMenu).Images=nil) then

                            (ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);

                        end;

                      ACanvas.Draw(mySrect.left+2,arect.top+2,BitMp);

                    end

                  else

                    ACanvas.Draw(mySrect.left,mySrect.top,(Sender as TMenuItem).Bitmap);

                  ACanvas.Brush.Color:=FSelColor;//clSilver;

                end;

            end

          else

            begin

              ACanvas.Brush.Color:=FBackColor;

              ACanvas.FillRect(Myrect);

              If (Sender as TMenuItem).ImageIndex>-1 then

                begin

                  if (ParentMenu is TMainMenu) then

                    begin

                      if not ((ParentMenu as TMainMenu).Images=nil) then

                        (ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);

// (ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);

                    end

                  else

                    begin

                      if not ((ParentMenu as TPopupMenu).Images=nil) then

                        (ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);

// (ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);

                    end;

                  ACanvas.Draw(mySrect.left+2,arect.top+2,BitMp);

                end

              else

                ACanvas.Draw(mySrect.left+2,arect.top+2,(Sender as TMenuItem).Bitmap);

            end;

          Myrect.left:=Myrect.left+4;

          myrect.top:=myrect.top+1;

          flags:=DT_EXPANDTABS {or DT_SINGLELINE or DT_CALCRECT }or DT_NOCLIP or Alignments[Alignment];

          if Selected then

            begin

              if NotEnabled then

                ACanvas.Font.Color:=FNotActiveColor

              else

                ACanvas.Font.Color:=FSelFontColor;

              DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),Myrect,Flags);

            end

          else

            begin

              if NotEnabled then

                ACanvas.Font.Color:=FNotActiveColor

              else

                ACanvas.Font.Color:=FNotSelFontColor;

              DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),Myrect,Flags);

            end;

          if not (TMenuItem(Sender).GetParentComponent is TMainMenu) then

            begin

          //outputDebugstring(pchar( ));

              Myrect.left:=MyRect.right-ACanvas.TextWidth(shortcuttotext((Sender as TMenuItem).shortcut))-1;

              if Selected then

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FSelFontColor;

                  DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);

                end

              else

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FNotSelFontColor;

                  DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);

                end;

            end;

          //ACanvas.TextOut(Myrect.Left+4,arect.top+1,(Sender as TMenuItem).Caption);//+shortcuttotext((Sender as TMenuItem).shortcut));

        end

      else

        begin

          ACanvas.Brush.Color:=FBackColor;

          ACanvas.FillRect(Myrect);

          myrect.top:=myrect.top+1;

          myrect.bottom:=myrect.top+1;

          myrect.Left:=myrect.Left+12;

          ACanvas.Brush.Color:=FStripColor;

          ACanvas.FillRect(Myrect);

        end;

    end;

  BitMp.free;

end;



procedure TXpMenu.DefMenuMeasureItem(Sender: TObject; ACanvas: TCanvas;

  var Width, Height: Integer);

begin

  width:=width+FStripWidth;

  if (not (shortcuttotext((Sender as TMenuItem).ShortCut)='')) or (TMenuItem(Sender).GetParentComponent is TPopupMenu) then

    width:=width+ACanvas.TextWidth(shortcuttotext((Sender as TMenuItem).shortcut));

end;



procedure TXpMenu.DefMenuAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; State: TOwnerDrawState);

const

  cHotkeyPrefix='&';


  Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

var

  myBaseR:TRect;

  myrect:TRect;

  myBRect:TRect;

  mySrect:TRect;

  selected:boolean;

  NotEnabled:boolean;

  pl:Array [0..3] of tpoint;

  ParentMenu:TMenu;

  Flags:integer;

  Alignment: TPopupAlignment;

begin

  ParentMenu := TMenuItem(Sender).GetParentMenu;

  if ParentMenu is TMenu then

    Alignment := paLeft

  else if ParentMenu is TPopupMenu then

    Alignment := TPopupMenu(ParentMenu).Alignment

  else

    Alignment := paLeft;

  Selected := odSelected in State;

  NotEnabled:= odDisabled in State;

  myBaseR.Left:=ARect.Left;

  myBaseR.Right:=myBaseR.Left+FStripWidth;

  myBaseR.Top:=ARect.Top;

  myBaseR.Bottom:=ARect.Bottom;

  Myrect.Left:=ARect.Left+FStripWidth;

  Myrect.Right:=ARect.Right;

  Myrect.Top:=ARect.Top;

  Myrect.Bottom:=ARect.Bottom;

  mySrect.Left:=ARect.Left;

  mySrect.Right:=ARect.Right;

  mySrect.Top:=ARect.Top;

  mySrect.Bottom:=ARect.Bottom;

  pl[0].x:=mySRect.Left;

  pl[0].y:=mySRect.Bottom;

  pl[1]:=mySRect.TopLeft;

  pl[2].x:=mySRect.Right;

  pl[2].y:=mySRect.Top;

  pl[3]:=mySRect.BottomRight;

  ACanvas.Brush.Color:=FStripColor;



  if (TMenuItem(Sender).GetParentComponent is TPopupMenu) then

     ACanvas.FillRect(myBaseR);



  if not ((Sender as TMenuItem).Caption='-') then

    begin

      if ((Sender as TMenuItem).Parent.Name='') then

        begin

          if Selected then

            begin

              if (TMenuItem(Sender).GetParentComponent is TPopupMenu) then

                begin

                  ACanvas.Brush.Color:=FSelColor;//clSilver;

                  ACanvas.FillRect(mySrect);

                  ACanvas.Rectangle(mySrect);

                  if (Sender as TMenuItem).Bitmap<>nil then

                    begin

                      MyBrect.Left:=ARect.Left+2;

                      MyBrect.Right:=MyBrect.Left+(Sender as TMenuItem).Bitmap.Width;

                      MyBrect.Top:=ARect.Top+2;

                      MyBrect.Bottom:=ARect.Top+(Sender as TMenuItem).Bitmap.Height;

                      ACanvas.Brush.Color:=FStripColor;

                      ACanvas.FillRect(MyBrect);

                      ACanvas.Draw(mySrect.left,mySrect.top,(Sender as TMenuItem).Bitmap);

                      ACanvas.Brush.Color:=FSelColor;//clSilver;

                    end;

                end

              else

                begin

                  ACanvas.Brush.Color:=FBackColor;

                  ACanvas.FillRect(mySrect);

                  ACanvas.Rectangle(mySrect);

                end;



            end

          else

            begin

              if (TMenuItem(Sender).GetParentComponent is TPopupMenu) then

                begin

                  ACanvas.Brush.Color:=FBackColor;

                  ACanvas.FillRect(Myrect);

                  If (Sender as TMenuItem).ImageIndex>-1 then

                    begin

                      if not ((ParentMenu as TPopupMenu).Images=nil) then

                        (ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);

                    end;

                  ACanvas.Draw(mySrect.left+2,arect.top+2,(Sender as TMenuItem).Bitmap);

                end

              else

                begin

                  ACanvas.Brush.Color:=clBtnFace;

                  ACanvas.FillRect(mySrect);

                  if odHotLight in State then

                    begin

                      ACanvas.Brush.Color:=FSelColor;//clSilver;

                      ACanvas.FillRect(mySrect);

                      ACanvas.Rectangle(mySrect);

                    end;

                end;

            end;

          mySrect.left:=mySrect.left+4;

          mySrect.top:=mySrect.top+1;

          flags:=DT_EXPANDTABS {or DT_SINGLELINE or DT_CALCRECT }or DT_NOCLIP or Alignments[Alignment];

          if not (TMenuItem(Sender).GetParentComponent is TPopupMenu) then

            begin

              if Selected then

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FSelFontColor;

                  DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),mySrect,Flags)

                end

              else

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FNotSelFontColor;

                  DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),mySrect,Flags)

                end;

            end

          else

            begin

              myrect.left:=myrect.left+4;

              myrect.top:=myrect.top+1;

              if Selected then

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FSelFontColor;

                  DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),myrect,Flags);

                end

              else

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FNotSelFontColor;

                  DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),myrect,Flags);

                end;

              Myrect.left:=MyRect.right-ACanvas.TextWidth(shortcuttotext((Sender as TMenuItem).shortcut))-1;

              if Selected then

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FSelFontColor;

                  DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);

                end

              else

                begin

                  if NotEnabled then

                    ACanvas.Font.Color:=FNotActiveColor

                  else

                    ACanvas.Font.Color:=FNotSelFontColor;

                  DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);

                end;

            end;

          //ACanvas.TextOut(mySrect.Left+4,mySrect.top+1,(Sender as TMenuItem).Caption);

        end;

      end

    else

      begin

        ACanvas.Brush.Color:=FBackColor;

        ACanvas.FillRect(Myrect);

        myrect.top:=myrect.top+1;

        myrect.bottom:=myrect.top+1;

        myrect.Left:=myrect.Left+12;

        ACanvas.Brush.Color:=FStripColor;

        ACanvas.FillRect(Myrect);

      end;

end;



Procedure TXpMenu.RemoveXPs;

var

  i:Integer;

begin

  with owner do

    begin

      for i:=0 to ComponentCount-1 do

        begin

          if Components[i] is TMenuItem then

            begin

               (Components[i] as TMenuItem).OnDrawItem:=nil;

               (Components[i] as TMenuItem).OnMeasureItem:=nil;

               (Components[i] as TMenuItem).OnAdvancedDrawItem:=nil;

            end;

        end;

    end;

end;



Procedure TXpMenu.Execute;

var

  i:Integer;

begin

  with owner do

    begin

      for i:=0 to ComponentCount-1 do

        begin

          if Components[i] is TMenuItem then

            begin

               (Components[i] as TMenuItem).OnDrawItem:=Self.DefMenuDrawItem;

               (Components[i] as TMenuItem).OnMeasureItem:=Self.DefMenuMeasureItem;

               (Components[i] as TMenuItem).OnAdvancedDrawItem:=Self.DefMenuAdvancedDrawItem;

            end;

        end;

    end;

end;



procedure Register;

begin

  RegisterComponents('VNPVcls', [TXpMenu]);

end;



end.

 

Share this article!

Follow us!

Find more helpful articles: