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
char;
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.