怎样做“开始”菜单那样的菜单? item也有自己的右键菜单,有Hint,支持拖放…… (100分)

  • 主题发起人 主题发起人 wy0311
  • 开始时间 开始时间
W

wy0311

Unregistered / Unconfirmed
GUEST, unregistred user!
也就是item也有自己的右键菜单,有Hint,支持拖放……

帮忙提一下[:)]
 
好像有这样的控件。但是我既不得叫什么了
 
[^]有控件,绝对有控件!我前几天刚看见,就是忽然想不起来了!
 
COOLMENU(好像叫这个名字吧?)我到用过,不爽,寻求其他好方法ing。
 
procedure TForm1.Button1Click(Sender: TObject);
var
p:TPoint;
begin
p:=clienttoScreen(Point(button1.left,button1.top));
TrackPopupMenu(popupmenu1.Handle,
TPM_LEFTALIGN or TPM_BOTTOMALIGN,
p.x,p.y,0,handle,nil);
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P:TPoint;
begin
if Button=mbRight then
begin
p:=button1.ClientToScreen(point(x,y));
TrackPopupMenu(popupmenu2.Handle,
TPM_LEFTALIGN or TPM_BOTTOMALIGN,
p.x,p.y,0,handle,nil);
end;
end;
 
ObjectBar V15很不错,把微软的任务栏整个换掉了,变成了WinXP风格,可惜是工具,没有源代码。
 
[:D]我有一个用右键菜单做的,载公司,要得留下E-mail,我的是lsssxs@360cn.com
 
我有一个VB的例子,不错。要的话给我E-MAIL
inhu@21cn.com
 
lsssxs 我要一份你的'我有一个用右键菜单做的“开始”菜单那样的菜单'
email:nxyzg@163.com
 
wy0311@163.com
谢谢!
 
qq式样的,该一点点就可以了.
unit Unit1;

interface

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

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Friend1: TMenuItem;
Zhumin1: TMenuItem;
anli1: TMenuItem;
Zhushenhui1: TMenuItem;
Mojunyi1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
ImageList1: TImageList;
Image1: TImage;
ColorDialog1: TColorDialog;
Button1: TButton;
fjsdkf1: TMenuItem;
procedure Zhumin1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Zhumin1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
CanvasColor:TColor=clBtnface;
implementation

{$R *.dfm}
procedure DrawBevel(ARect:TRect;ACanvas:TCanvas;Bevel:Boolean);
var
Color1,Color2:TColor;
begin
if Bevel then
begin
Color1:=clWhite;
Color2:=clBlack;
end
else
begin
Color1:=clBlack;
Color2:=clWhite;
end;
with ACanvas do
begin
Pen.Color:=Color1;
MoveTo(ARect.Left,ARect.Top);
LineTo(ARect.Right,ARect.Top);
MoveTo(ARect.Left,ARect.Top);
LineTo(ARect.Left,ARect.Bottom);
Pen.Color:=Color2;
MoveTo(ARect.Right,ARect.Bottom);
LineTo(ARect.Left,ARect.Bottom);
MoveTo(ARect.Right,ARect.Bottom);
LineTo(ARect.Right,ARect.Top);
end;
end;

procedure DrawArrow(ACanvas: TCanvas;ARect:TRect);
var
X,Y:integer;
begin
X:=ARect.Right-2;
Y:=ARect.Top-2;
ACanvas.MoveTo(X, Y);
ACanvas.LineTo(X + 5, Y);

ACanvas.MoveTo(X + 1, Y + 2);
ACanvas.LineTo(X + 5, Y);

ACanvas.MoveTo(X + 2, Y + 3);
ACanvas.LineTo(X + 4, Y+1);

end;

procedure TForm1.Zhumin1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
MenuName:pchar;
index:integer;
begin
MenuName:=PChar(TMenuItem(Sender).Caption);
index:=TMenuItem(Sender).ImageIndex;
if TMenuItem(Sender).Count>0 then
DrawArrow(ACanvas,ARect);
if Selected then
begin
ARect.Left:=ARect.Left+21;
DrawBevel(Rect(ARect.Left + 1, ARect.Top + 1,
ARect.Left + 18, ARect.Bottom - 1), ACanvas , true);
DrawBevel(Rect(ARect.Left +18, ARect.Top + 1,
ARect.Right - 1, ARect.Bottom - 1), ACanvas, false);
end
else
begin
BitBlt(ACanvas.Handle,ARect.Left,ARect.Top,ARect.Right-ARect.Left,ARect.Bottom-ARect.Top,
Image1.Canvas.Handle,ARect.Left,ARect.Top,SRCCOPY);
ARect.Left:=ARect.Left+21;
ACanvas.Brush.Color:=CanvasColor;
ACanvas.FillRect(ARect);
end;
ACanvas.Brush.Style:=bsClear;
if TMenuItem(Sender).Caption<>'-' then
begin
ImageList1.Draw(ACanvas,ARect.Left+2,ARect.Top+2,index,True);
ACanvas.Font.Color:=clBlack;
ARect.Left:=ARect.Left+21;
ARect.Top:=ARect.Top+4;
DrawText(ACanvas.Handle,MenuName,strlen(MenuName),ARect,DT_LEFT);
end
else
DrawBevel(Rect(ARect.Left + 1, ARect.Top + 2, ARect.Right - 1,
ARect.Top + 3), ACanvas, false);
end;

procedure TForm1.Zhumin1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
MenuName:string;
begin
MenuName:=TMenuItem(Sender).Caption;
if MenuName='-' then
Height:=4
else
Height:=22;
Width:=140;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if ColorDialog1.Execute then
begin
CanvasColor:=ColorDialog1.Color
end
else
end;

end.
 
上面的代码不已经有这个功能,还想干什么?
 
jsxjd:
TrackPopupMenu 是什么函数?
 

Similar threads

回复
0
查看
1K
不得闲
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
825
DelphiTeacher的专栏
D
后退
顶部