Самостоятельная отрисовка пунктов меню , В стиле офис ХР (почти)

[Miscђka]

Самостоятельная отрисовка пунктов меню. Почти в стиле Office2003, но с небольшими отличиями. Потому что кое-где вылезают системные ограничения (меню нужно делать не стандартным компонентом, а своим окном), а кое-где мне так больше нравится

Совместимость: Win98/WinNT/Win2000/WinXP (Если найдете несовместимость, прошу сообщить).

Демо-проект с полными комментариями в прикрепленном файле.

implementation
 
{$R *.dfm}
 
const
 MinWidth              = 13;
 MinHeight             = 22;
 _Height               = 3;  
 dWidth                = 7;  
 MenuLeftWidth         = 18;
 CaptionLeftPadding    = 30;
 // Menu Colors
 clMenuLeft            = $FFD0A0;
 clMenuBackground      = $FFFFFF;
 clMenuCaption         = $000000;
 clMenuDisabledCaption = $A0A0A0;
 clMenuSelectedTop     = $80C0FF;
 clMenuSelectedBottom  = $E0F8FF;
 clMenuSelectedBorder  = $C0362C;
 clMenuSelectedText    = $000000;
 clMenuLine            = $D0A070;
 Shadow: array[0..4]of integer = (
  128,
  142,
  175,
  208,
  241
 );
 
var
 MenuSelectedBitmap: TBitmap;
 MenuLeftBitmap: TBitmap;    
 MainMenuShadow: TBitmap;    
 clMainMenuBar: integer;      
 
procedure TForm1.N11Click(Sender: TObject);
begin
 close()
end;
 
procedure TForm1.MeasureMenuBarItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
 if width<MinWidth then width:=MinWidth
end;
 
procedure TForm1.MeasurePopupItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
 Width:=Width+dWidth;
 if (Sender as TMenuItem).Caption='-' then Height:=_Height
 else
  if Height<MinHeight then Height:=MinHeight;
end;
 
procedure TForm1.AdvancedDrawPopupItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
const
 CHECK = 6;
 RADIO = 0;
var
 ImgIndex: integer;
 sc: string;
 r: TRect;
begin
 if (odSelected in State) and (Sender as TMenuItem).Enabled then
 begin
  ACanvas.StretchDraw(ARect, MenuSelectedBitmap);
  ACanvas.Pen.Style:=psSolid;
  ACanvas.Pen.Color:=clMenuSelectedBorder;
  ACanvas.Brush.Style:=bsClear;
  ACanvas.Rectangle(ARect);
  ACanvas.Font.Color:=clMenuSelectedText
 end
 else
 begin
  ACanvas.Pen.Style:=psClear;
  ACanvas.StretchDraw(Rect(ARect.Left, ARect.Top, ARect.Left+MenuLeftWidth, ARect.Bottom+1), MenuLeftBitmap);
  ACanvas.Brush.Color:=clMenuBackground;
  ACanvas.Rectangle(ARect.Left+17, ARect.Top, ARect.Right+1, ARect.Bottom+1);
  if (Sender as TMenuItem).Enabled then ACanvas.Font.Color:=clMenuCaption
  else ACanvas.Font.Color:=clMenuDisabledCaption
 end;
 if (Sender as TMenuItem).Caption='-' then
 begin
  ACanvas.Pen.Color:=clMenuLine;
  ACanvas.Pen.Style:=psSolid;
  ACanvas.moveTo(ARect.Left+31, ARect.Top+1);
  ACanvas.lineTo(ARect.Right, ARect.Top+1)
 end
 else  
 begin
  if (Sender as TMenuItem).Default then ACanvas.Font.Style:=ACanvas.Font.Style+[fsBold];
  ACanvas.Brush.Style:=bsClear;
  r:=Rect(ARect.Left+CaptionLeftPadding, ARect.Top, ARect.Right, ARect.Bottom);
  ImgIndex:=DT_NOCLIP or DT_SINGLELINE or DT_VCENTER;
  ImgIndex:=ImgIndex or DT_LEFT;
  if odNoAccel in State then ImgIndex:=ImgIndex or DT_HIDEPREFIX;
  drawText(ACanvas.Handle, PChar((Sender as TMenuItem).Caption), length((Sender as TMenuItem).Caption), r, ImgIndex);
  sc:=ShortcutToText((Sender as TMenuItem).ShortCut);
  if sc<>'' then
  begin
   inc(r.Right, -10);
   ImgIndex:=DT_RIGHT or DT_VCENTER or DT_NOCLIP or DT_SINGLELINE;
   drawText(ACanvas.Handle, PChar(sc), length(sc), r, ImgIndex)
  end;
  if (Sender as TMenuItem).ImageIndex>=0 then
   ImageList1.draw(ACanvas, ARect.Left+4, ARect.Top+3, (Sender as TMenuItem).ImageIndex{, (Sender as TMenuItem).Enabled});
  if (Sender as TMenuItem).Checked then
  begin
   if (Sender as TMenuItem).RadioItem then ImgIndex:=RADIO else ImgIndex:=CHECK;
   ACanvas.Pen.Style:=psSolid;
   if (Sender as TMenuItem).ImageIndex<0 then
    ImageList1.draw(ACanvas, ARect.Left+5, ARect.Top+4, ImgIndex);
   ACanvas.Pen.Color:=clBlack;
   ACanvas.moveTo(ARect.Left+2, ARect.Bottom-3);
   ACanvas.lineTo(ARect.Left+2, ARect.Top+1);
   ACanvas.lineTo(ARect.Left+22, ARect.Top+1);
   ACanvas.Pen.Color:=clWhite;
   ACanvas.moveTo(ARect.Left+21, ARect.Top+2);
   ACanvas.lineTo(ARect.Left+21, ARect.Bottom-2);
   ACanvas.lineTo(ARect.Left+1, ARect.Bottom-2)
  end
 end
end;
 
procedure TForm1.AdvancedDrawMainMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
 Flag: integer;
begin
 if odSelected in State then
 begin
  ACanvas.Brush.Color:=clMenuBackground;
  ACanvas.FillRect(ARect);
  ACanvas.StretchDraw(Rect(ARect.Left+3, ARect.Top+3, ARect.Left+20, ARect.Bottom-2), MenuLeftBitmap);
  ACanvas.StretchDraw(Rect(ARect.Right, ARect.Top+3, ARect.Right+5, ARect.Bottom), MainMenuShadow);
  ACanvas.Pen.Color:=clBtnShadow;
  ACanvas.moveTo(ARect.Left, ARect.Bottom);
  ACanvas.lineTo(ARect.Left, ARect.Top);
  ACanvas.lineTo(ARect.Right-1, ARect.Top);
  ACanvas.lineTo(ARect.Right-1, ARect.Bottom);
  ACanvas.Font.Color:=clMenuText; //clMenuSelectedText
 end
 else
  if odHotLight in State then
  begin
   ACanvas.Brush.Color:=clMenuLeft;
   ACanvas.Pen.Color:=clMenuSelectedBorder;
   ACanvas.Rectangle(ARect);
   ACanvas.Font.Color:=clMenuCaption
  end
  else
  begin
   ACanvas.Brush.Color:=clMainMenuBar;
   ACanvas.fillRect(Rect(ARect.Left, ARect.Top, ARect.Right+5, ARect.Bottom));
   ACanvas.Font.Color:=clMenuText
  end;
  ACanvas.Brush.Style:=bsClear;
  Flag:=DT_NOCLIP or DT_SINGLELINE or DT_CENTER or DT_VCENTER;
  if odNoAccel in State then Flag:=Flag or DT_HIDEPREFIX;
  drawText(ACanvas.Handle, PChar((Sender as TMenuItem).Caption), length((Sender as TMenuItem).Caption), ARect, Flag)
end;
 
procedure paintMenuSelectedBitmap();
var
 i: integer;
 dr, dg, db: real;
 r, g, b: integer;
begin
 r:=getRValue(clMenuSelectedTop);
 g:=getGValue(clMenuSelectedTop);
 b:=getBValue(clMenuSelectedTop);
 dr:=(getRValue(clMenuSelectedBottom)-r)/MenuSelectedBitmap.Height;
 dg:=(getGValue(clMenuSelectedBottom)-g)/MenuSelectedBitmap.Height;
 db:=(getBValue(clMenuSelectedBottom)-b)/MenuSelectedBitmap.Height;
 for i:=0 to MenuSelectedBitmap.Height-1 do
  MenuSelectedBitmap.Canvas.Pixels[0, i]:=rgb(round(r+dr*i), round(g+dg*i), round(b+db*i))
end;
 
procedure paintMenuLeftBitmap();
var
 i: integer;
 dr, dg, db: real;
 r, g, b: integer;
begin
 r:=getRValue(clMenuLeft);
 g:=getGValue(clMenuLeft);
 b:=getBValue(clMenuLeft);
 dr:=(255-r)/MenuLeftBitmap.Width;
 dg:=(255-g)/MenuLeftBitmap.Width;
 db:=(255-b)/MenuLeftBitmap.Width;
 for i:=0 to MenuLeftBitmap.Width-1 do
  MenuLeftBitmap.Canvas.Pixels[i, 0]:=rgb(round(r+dr*i), round(g+dg*i), round(b+db*i))
end;
 
procedure paintMainMenuShadow();
var
 r, g, b: real;
 i: integer;
begin
 MainMenuShadow.Canvas.Brush.Color:=clMainMenuBar;
 MainMenuShadow.Canvas.fillRect(MainMenuShadow.Canvas.ClipRect);
 r:=getRValue(colorToRGB(clMainMenuBar))/255;
 g:=getGValue(colorToRGB(clMainMenuBar))/255;
 b:=getBValue(colorToRGB(clMainMenuBar))/255;
 for i:=4 downto 0 do
 begin
  MainMenuShadow.Canvas.Pen.Color:=rgb(round(r*Shadow[i]), round(g*Shadow[i]), round(b*Shadow[i]));
  MainMenuShadow.Canvas.Brush.Color:=MainMenuShadow.Canvas.Pen.Color;
  MainMenuShadow.Canvas.RoundRect(-i, MainMenuShadow.Width-1-i, i+1, MainMenuShadow.Height+20, i, i)
 end;
end;
 
procedure checkMenuColor();
var
 Ver: LongWord;
begin
 Ver:=getVersion();
 if Lo(Ver)<5 then clMainMenuBar:=clMenu
 else clMainMenuBar:=clMenuBar
end;
 
initialization
 
begin
 checkMenuColor();
 MenuSelectedBitmap:=TBitmap.create();
 MenuSelectedBitmap.PixelFormat:=pf24bit;
 MenuSelectedBitmap.Width:=1;
 MenuSelectedBitmap.Height:=32;
 paintMenuSelectedBitmap();
 MenuLeftBitmap:=TBitmap.create();
 MenuLeftBitmap.PixelFormat:=pf24bit;
 MenuLeftBitmap.Width:=32;
 MenuLeftBitmap.Height:=1;
 paintMenuLeftBitmap();
 MainMenuShadow:=TBitmap.create();
 MainMenuShadow.PixelFormat:=pf24bit;
 MainMenuShadow.Width:=5;
 MainMenuShadow.Height:=9;
 paintMainMenuShadow()
end;
 
finalization
 
begin
 MenuSelectedBitmap.free();
 MenuLeftBitmap.free()
end;

Прикреплённый файлmenu.zip (19.16 Кбайт, скачиваний: 246)

[Miscђka]

вот еще в стиле Office2003. В принципе вроде неплохо получилось
Прикреплённый файлOffice2003Menu.zip (19.14 Кбайт, скачиваний: 258)