菜单中增加竖条图片(50分)

怎样在菜单中增加竖条图片，就象Windows开始菜单一样的？

用第三方控件

如果想自己写的话，以下这段代码这复杂了点，你可以根据你的情况精检一下：
如果觉得复杂的话，你可以把前面的两个函数跳过去不看，而是完整的Copy到你
的窗口所在的单截取的第一个事件或过程的前面然后在后面编写事件。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, jpeg, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
MainMenu1: TMainMenu;
A1: TMenuItem;
A2: TMenuItem;
B1: TMenuItem;
C1: TMenuItem;
D1: TMenuItem;
E1: TMenuItem;
F1: TMenuItem;
G1: TMenuItem;
procedure G1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure G1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
private
FBitMap:TBitmap;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
Uses ImgList;
{$R *.dfm}

procedure DoDrawText(MenuItem:TMenuItem;ACanvas: TCanvas; const ACaption: string;
var Rect: TRect; Selected: Boolean; Flags: Longint);
var
Text: string;
R: TRect;
ParentMenu: TMenu;
begin
ParentMenu := MenuItem.GetParentMenu;
if (ParentMenu <> nil) and (ParentMenu.IsRightToLeft) then
begin
if Flags and DT_LEFT = DT_LEFT then
Flags := Flags and (not DT_LEFT) or DT_RIGHT
else if Flags and DT_RIGHT = DT_RIGHT then
Flags := Flags and (not DT_RIGHT) or DT_LEFT;
Flags := Flags or DT_RTLREADING;
end;
Text := ACaption;
if (Flags and DT_CALCRECT <> 0) and ((Text = '') or
(Text[1] = cHotkeyPrefix) and (Text[2] = #0)) then Text := Text + ' ';
with ACanvas do
begin
if Text = cLineCaption then
begin
if Flags and DT_CALCRECT = 0 then
begin
R := Rect;
Inc(R.Top, 4);
DrawEdge(Handle, R, EDGE_ETCHED, BF_TOP);
end;
end
else
begin
Brush.Style := bsClear;
if MenuItem.Default then
Font.Style := Font.Style + [fsBold];
if not MenuItem.Enabled then
begin
if not Selected then
begin
OffsetRect(Rect, 1, 1);
Font.Color := clBtnHighlight;
DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
end;
if Selected and (ColorToRGB(clHighlight) = ColorToRGB(clBtnShadow)) then
Font.Color := clBtnHighlight else
Font.Color := clBtnShadow;
end;
DrawText(Handle, PChar(Text), Length(Text), Rect, Flags);
end;
end;
end;

procedure AdvancedDrawItem(MenuItem:TMenuItem;ACanvas: TCanvas; ARect: TRect;
State: TOwnerDrawState; TopLevel: Boolean);
const
Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
EdgeStyle: array[Boolean] of Longint = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
var
ImageList: TCustomImageList;
ParentMenu: TMenu;
Alignment: TPopupAlignment;
DrawImage, DrawGlyph: Boolean;
GlyphRect, SaveRect: TRect;
DrawStyle: Longint;
Glyph: TBitmap;
OldBrushColor: TColor;
Selected: Boolean;
Win98Plus: Boolean;
Win2K: Boolean;

procedure NormalDraw;
begin
with ACanvas do
begin
if not Selected then FillRect(ARect);
if ParentMenu is TMenu then
Alignment := paLeft
else if ParentMenu is TPopupMenu then
Alignment := TPopupMenu(ParentMenu).Alignment
else
Alignment := paLeft;
GlyphRect.Left := ARect.Left + 1;
GlyphRect.Top := ARect.Top + 1;
if MenuItem.Caption = cLineCaption then
begin
FillRect(ARect);
GlyphRect.Left := 0;
GlyphRect.Right := -4;
DrawGlyph := False;
end
else
begin
DrawImage := (ImageList <> nil) and ((MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < ImageList.Count) or MenuItem.Checked and ((MenuItem.Bitmap = nil) or
MenuItem.Bitmap.Empty));
if DrawImage or Assigned(MenuItem.Bitmap) and not MenuItem.Bitmap.Empty then
begin
DrawGlyph := True;

if DrawImage then
begin
GlyphRect.Right := GlyphRect.Left + ImageList.Width;
GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
end
else
begin
GlyphRect.Right := GlyphRect.Left + 16;
GlyphRect.Bottom := GlyphRect.Top + 16;
end;

if MenuItem.Checked then
begin
Inc(GlyphRect.Right);
Inc(GlyphRect.Bottom);
OldBrushColor := Brush.Color;
if not (odSelected in State) then
begin
OldBrushColor := Brush.Color;
Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
FillRect(GlyphRect);
end
else
begin
Brush.Color := clBtnFace;
FillRect(GlyphRect);
end;
Brush.Color := OldBrushColor;
Inc(GlyphRect.Left);
Inc(GlyphRect.Top);
end;

if DrawImage then
begin
if (MenuItem.ImageIndex > -1) and (MenuItem.ImageIndex < ImageList.Count) then
ImageList.Draw(ACanvas, GlyphRect.Left, GlyphRect.Top, MenuItem.ImageIndex,
MenuItem.Enabled)
else
begin
Glyph := TBitmap.Create;
try
Glyph.Transparent := True;
Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
OldBrushColor := Font.Color;
Font.Color := clBtnText;
Draw(GlyphRect.Left + (GlyphRect.Right - GlyphRect.Left - Glyph.Width) div 2 + 1,
GlyphRect.Top + (GlyphRect.Bottom - GlyphRect.Top - Glyph.Height) div 2 + 1, Glyph);
Font.Color := OldBrushColor;
finally
Glyph.Free;
end;
end;
end
else
begin
SaveRect := GlyphRect;
if MenuItem.Bitmap.Width < GlyphRect.Right - GlyphRect.Left then
with GlyphRect do
begin
Left := Left + ((Right - Left) - MenuItem.Bitmap.Width) div 2 + 1;
Right := Left + MenuItem.Bitmap.Width;
end;
if MenuItem.Bitmap.Height < GlyphRect.Bottom - GlyphRect.Top then
with GlyphRect do
begin
Top := Top + ((Bottom - Top) - MenuItem.Bitmap.Height) div 2 + 1;
Bottom := Top + MenuItem.Bitmap.Height;
end;
StretchDraw(GlyphRect, MenuItem.Bitmap);
GlyphRect := SaveRect;
end;

if MenuItem.Checked then
begin
Dec(GlyphRect.Right);
Dec(GlyphRect.Bottom);
end;
end
else
begin
if (ImageList <> nil) and not TopLevel then
begin
GlyphRect.Right := GlyphRect.Left + ImageList.Width;
GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
end
else
begin
GlyphRect.Right := GlyphRect.Left;
GlyphRect.Bottom := GlyphRect.Top;
end;
DrawGlyph := False;
end;
end;
with GlyphRect do
begin
Dec(Left);
Dec(Top);
Inc(Right, 2);
Inc(Bottom, 2);
end;

if MenuItem.Checked or Selected and DrawGlyph then
DrawEdge(Handle, GlyphRect, EdgeStyle[MenuItem.Checked], BF_RECT);

if Selected then
begin
if DrawGlyph then ARect.Left := GlyphRect.Right + 1;
if not (Win98Plus and TopLevel) then
Brush.Color := clHighlight;
FillRect(ARect);
end;
if TopLevel and Win98Plus then
begin
if Selected then
DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_RECT)
else if odHotLight in State then
DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_RECT);
if not Selected then
OffsetRect(ARect, 0, -1);
end;
if not (Selected and DrawGlyph) then
ARect.Left := GlyphRect.Right + 1;
Inc(ARect.Left, 2);
Dec(ARect.Right, 1);

DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or Alignments[Alignment];
if Win2K and (odNoAccel in State) then
DrawStyle := DrawStyle or DT_HIDEPREFIX;
SaveRect := ARect;
if odDefault in State then
Font.Style := [fsBold];
DoDrawText(MenuItem,ACanvas, MenuItem.Caption, ARect, Selected, DrawStyle or DT_CALCRECT or DT_NOCLIP);
OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2);
if TopLevel and Selected and Win98Plus then
OffsetRect(ARect, 1, 0);
DoDrawText(MenuItem,ACanvas, MenuItem.Caption, ARect, Selected, DrawStyle);
if (MenuItem.ShortCut <> 0) and not TopLevel then
begin
ARect.Left := ARect.Right;
ARect.Right := SaveRect.Right - 10;
DoDrawText(MenuItem,ACanvas, ShortCutToText(MenuItem.ShortCut), ARect, Selected, DT_RIGHT);
end;
end;
end;

procedure BiDiDraw;
var
S: string;
begin
with ACanvas do
begin
if not Selected then FillRect(ARect);
if ParentMenu is TMenu then
Alignment := paLeft
else if ParentMenu is TPopupMenu then
Alignment := TPopupMenu(ParentMenu). Alignment
else
Alignment := paLeft;
GlyphRect.Right := ARect.Right - 1;
GlyphRect.Top := ARect.Top + 1;
if MenuItem.Caption = cLineCaption then
begin
FillRect(ARect);
GlyphRect.Left := GlyphRect.Right + 2;
GlyphRect.Right := 0;
DrawGlyph := False;
end
else
begin
DrawImage := (ImageList <> nil) and ((MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < ImageList. Count) or MenuItem.Checked and ((MenuItem.Bitmap = nil) or
MenuItem.Bitmap. Empty));
if DrawImage or Assigned(MenuItem.Bitmap) and not MenuItem.Bitmap. Empty then
begin
DrawGlyph := True;

if DrawImage then
begin
GlyphRect.Left := GlyphRect.Right - ImageList.Width;
GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
end
else
begin
GlyphRect.Left := GlyphRect.Right - 16;
GlyphRect.Bottom := GlyphRect.Top + 16;
end;

if MenuItem.Checked then
begin
Dec(GlyphRect.Left);
Inc(GlyphRect.Bottom);
OldBrushColor := Brush.Color;
if not Selected then
begin
OldBrushColor := Brush.Color;
Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
FillRect(GlyphRect);
end
else
begin
Brush.Color := clBtnFace;
FillRect(GlyphRect);
end;
Brush.Color := OldBrushColor;
Dec(GlyphRect.Right);
Inc(GlyphRect.Top);
end;

if DrawImage then
begin
if (MenuItem.ImageIndex > -1) and (MenuItem.ImageIndex < ImageList.Count) then
ImageList.Draw(ACanvas, GlyphRect.Left, GlyphRect.Top, MenuItem.ImageIndex,
MenuItem.Enabled)
else
begin
Glyph := TBitmap.Create;
try
Glyph.Transparent := True;
Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
OldBrushColor := Font.Color;
Font.Color := clBtnText;
Draw(GlyphRect.Left + (GlyphRect.Right - GlyphRect.Left - Glyph.Width) div 2 + 1,
GlyphRect.Top + (GlyphRect.Bottom - GlyphRect.Top - Glyph.Height) div 2 + 1, Glyph);
Font.Color := OldBrushColor;
finally
Glyph.Free;
end;
end;
end
else
begin
SaveRect := GlyphRect;
if MenuItem.Bitmap.Width < GlyphRect.Right - GlyphRect.Left then
with GlyphRect do
begin
Right := Right - ((Right - Left) - MenuItem.Bitmap.Width) div 2 + 1;
Left := Right - MenuItem.Bitmap.Width;
end;
if MenuItem.Bitmap.Height < GlyphRect.Bottom - GlyphRect.Top then
with GlyphRect do
begin
Top := Top + ((Bottom - Top) - MenuItem.Bitmap.Height) div 2 + 1;
Bottom := Top + MenuItem.Bitmap.Height;
end;
StretchDraw(GlyphRect, MenuItem.Bitmap);
GlyphRect := SaveRect;
end;

if MenuItem.Checked then
begin
Dec(GlyphRect.Right);
Dec(GlyphRect.Bottom);
end;
end
else
begin
if (ImageList <> nil) and not TopLevel then
begin
GlyphRect.Left := GlyphRect.Right - ImageList.Width;
GlyphRect.Bottom := GlyphRect.Top + ImageList.Height;
end
else
begin
GlyphRect.Left := GlyphRect.Right;
GlyphRect.Bottom := GlyphRect.Top;
end;
DrawGlyph := False;
end;
end;
with GlyphRect do
begin
Dec(Left);
Dec(Top);
Inc(Right, 2);
Inc(Bottom, 2);
end;

if MenuItem.Checked or Selected and DrawGlyph then
DrawEdge(Handle, GlyphRect, EdgeStyle[MenuItem.Checked], BF_RECT);

if Selected then
begin
if DrawGlyph then ARect.Right := GlyphRect.Left - 1;
if not (Win98Plus and TopLevel) then
Brush.Color := clHighlight;
FillRect(ARect);
end;
if TopLevel and Win98Plus then
begin
if Selected then
DrawEdge(Handle, ARect, BDR_SUNKENOUTER, BF_RECT)
else if odHotLight in State then
DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_RECT);
if not Selected then
OffsetRect(ARect, 0, -1);
end;
if not (Selected and DrawGlyph) then
ARect.Right := GlyphRect.Left - 1;
Inc(ARect.Left, 2);
Dec(ARect.Right, 1);

DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or Alignments[Alignment];
if Win2K and (odNoAccel in State) then
DrawStyle := DrawStyle or DT_HIDEPREFIX;
SaveRect := ARect;
if odDefault in State then
Font.Style := [fsBold];
DoDrawText(MenuItem,ACanvas, MenuItem.Caption, ARect, Selected, DrawStyle or DT_CALCRECT or DT_NOCLIP);
ARect.Left := SaveRect.Left;
ARect.Right := SaveRect.Right;
OffsetRect(ARect, 0, ((SaveRect.Bottom - SaveRect.Top) - (ARect.Bottom - ARect.Top)) div 2);
if TopLevel and Selected and Win98Plus then
OffsetRect(ARect, 1, 0);
DoDrawText(MenuItem,ACanvas, MenuItem.Caption, ARect, Selected, DrawStyle);
if (MenuItem.ShortCut <> 0) and not TopLevel then
begin
S := ShortCutToText(MenuItem.ShortCut);
ARect.Left := 10;
ARect.Right := ARect.Left + ACanvas.TextWidth(S);
DoDrawText(MenuItem,ACanvas, S, ARect, Selected, DT_RIGHT);
end;
end;
end;

begin
ParentMenu := MenuItem.GetParentMenu;
ImageList := MenuItem.GetImageList;
Selected := odSelected in State;
Win98Plus := (Win32MajorVersion > 4) or
((Win32MajorVersion = 4) and (Win32MinorVersion > 0));
Win2K := (Win32MajorVersion > 4) and (Win32Platform = VER_PLATFORM_WIN32_NT);
if (ParentMenu <> nil) and (not ParentMenu.IsRightToLeft) then
NormalDraw
else
BiDiDraw;
end;

在每个菜单的OnMeasureItem事件中写入：
procedure TForm1.G1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
Width:=Width+25;
end;

在Form的OnCreate事件中写入，生成需要绘在菜单上的图片：
procedure TForm1.FormCreate(Sender: TObject);
begin
FBitMap:=TBitmap.Create;
FBitMap.Width:=Screen.Width;
FBitMap.Height:=Screen.Height;
FBitMap.Canvas.StretchDraw(Screen.DesktopRect,Image1.Picture.Graphic);
end;

在Form的OnDestroy事件中写入，释放资源：
procedure TForm1.FormDestroy(Sender: TObject);
begin
FBitMap.Free;
end;

在每个菜单的OnAdvanceDrawItem事件中写入，绘制菜单和图片：
procedure TForm1.G1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
Var R:TRect;
begin
R:=ARect;
R.Right:=R.Left+24;
ARect.Left:=R.Right;
ACanvas.CopyRect(R,FBitMap.Canvas,R);
AdvancedDrawItem((Sender as TMenuItem),ACanvas,ARect,State,False);
end;

end.

<<先人的DELPHI基础开发技巧>>中的代码，没试过：
◇[DELPHI]制作竖式菜单图片的关键代码
ONDrawItem事件
begin
Canvas.Draw(0,2,image1.picture.bitmap); Canvas.TextOut(arect.left+image1.picture.bitmap.width+2,arect.top,tmenuitem(sender).caption);
end;

呵呵！代码看起来和独帅的代码一样啊！不过我试试过的，绝对通过！
procedure TForm1.bbb1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
acanvas.Draw(0,2,image1.picture.bitmap);
acanvas.TextOut(arect.left+image1.picture.bitmap.width+2,arect.top,tmenuitem(sender).caption);
end;

上面两位朋友的代码最简单实用，不过没有处理比如分隔条等特列情况，也没有处理快捷键输出。

ph11.126.com上面有，很简单的，自己去看看

我试过地，绝对可用

试了一下，还行

[^]