利用Delphi美化你的菜單
Windows下的許多程式都有十分漂亮的選單,例如Windows「開始」選單左方從上到下的長條形的Windows Banner 又或者是向Word那樣在每個選單條左邊都有一個小圖標,看到這些很Cool的菜單,你是否覺得自己的菜單顯得單調乏味呢?不需要第三方控件,利用Delphi就可以實現上面的功能。
如果要實現自訂選單就需要在繪製選單時改變選單的大小以適應在選單上繪製圖形,然後再在上面繪製自己所需的選單效果。在Delphi中,每個選單項目對應一個TmenuItem控件,這類控制項都有兩個事件:OnDrawItem和OnMeasureItem,要實作自訂選單,首先要介紹這兩個事件:
OnMeasureItem事件的定義如下:
type TMenuMeasureItemEvent = PRocedure (Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer) of object;
property OnMeasureItem: TMenuMeasureItemEvent;
此事件在選單條監測自身的尺寸時產生,其中參數Acanvas定義繪製的繪圖對象,參數Width、Height制定選單項目的預設尺寸,注意到這兩個定義前的var了嗎,說明你可以在OnMeasureItem事件處理函數中改變這兩個值,也就是改變選單的大小。
OnDrawItem事件的定義如下:
type TMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean) of object;
property OnDrawItem: TMenuDrawItemEvent;
此事件在選單繪製時引發,其中參數Acanvas定義選單繪製對象,參數Arect制定選單的繪製區域,參數Selected定義目前選單項目是否被選取。
從上面的介紹可以看到,要實現自訂的選單,只要在OnMeasureItem事件中編寫程式碼改變選單項目的尺寸,然後在OnDrawItem事件中繪製自己需要的效果就可以了。
下面我痛過具體的範例來做說明,這個範例是讓自己的選單實現象Windows開始選單一樣的顯示Banner條的功能。同時這個程式也能實現將被選取的選單條進行漸層色填入(就像3721中文網址軟體的任務列選單那樣)。程式的想法是這樣的,首先建立一個長條型的點陣圖,然後在每一個選單條的OnMeasureItem事件中根據要顯示在選單上的文字和圖像以及程式的需要改變選單項目的寬度和高度,然後在OnDrawItem事件中將位圖中的相應部分拷貝到選單項目上。如果該選單條被選中,首先要改變Acanvas參數的畫刷顏色,然後再依序填滿選單條上的相應部分,這樣就實現了對選取的選單條實現漸變色填滿。最後將文字輸出到選單條上。
以下來介紹具體的程序,首先利用影像軟體建立一個長條型的點陣圖檔案(你可以根據你的需要設定影像的高寬比,在我的影像中是10:1)。在Delphi中建立一個新的工程,在Form1中加入一個TImage控件,將控件的AutoSize屬性設定為True。然後在Form1中加入一個TMainMenu控件,將它的OwnerDraw屬性設定為True(這一點很重要,否則程式無法實現)在該TMainMenu下加入6個TMenuItem物件(滑鼠右健點擊TMainMenu控件,然後點擊彈出式選單的Menu Designer 項,就可以在設計視窗中新增選單條了),將它們的Name屬性分別設定為Caption1、Caption2、…、Caption6。
下面是具體的程序清單:
unit OwnerMenu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, StdCtrls, ImgList;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Main1: TMenuItem;
Caption1: TMenuItem;
Caption2: TMenuItem;
Caption3: TMenuItem;
Caption4: TMenuItem;
Caption5: TMenuItem;
Caption6: TMenuItem;
Image1: TImage;
procedure Caption1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Caption2MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Caption3MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Caption4MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Caption5MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Caption6MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Caption1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Caption2DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Caption3DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Caption4DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Caption5DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Caption6DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
private
{ Private declarations }
public
procedure DrawItem(Sender: TMenuItem; ACanvas: TCanvas;ARect: TRect;
Selected: Boolean;strOUt:String);
{ Public declarations }
end;
var
Form1: TForm1;
i,iH,Ind,iW,iRate:Integer;
rTemp:TRect;
iG1,iG2:Integer;
implementation
{$R *.DFM}
procedure TForm1.DrawItem(Sender: TMenuItem; ACanvas: TCanvas;ARect: TRect;
Selected: Boolean;strOut:String);
var
j:Integer;
begin
i:=ARect.Bottom -ARect.Top; //取得貼圖的高度和寬度
Ind:=Sender.MenuIndex;
iH:=Round(Image1.Height/6*Ind); //取得貼圖位置
//將Image上對應位置的點陣圖複製到選單上
StretchBlt(ACanvas.Handle,ARect.Left,ARect.Top,iW,i,Image1.Canvas.Handle,0,iH,
Image1.Width,Round(Image1.Height/6),SRCCOPY);
if Selected then begin //該選單項目被選中
ACanvas.Font.Color := clWhite;
rTemp:=ARect;
rTemp.Left := rTemp.left+iW;
iG1:=Round((rTemp.Right - rTemp.Left)/10);
rTemp.Right := rTemp.Left +iG1;
for j:= 0 to 9 do begin //透過循環設定色彩漸層效果
ACanvas.Brush.Color := RGB(0,0,j*25);
ACanvas.FillRect(rTemp);
rTemp.Left := rTemp.Left +iG1;
rTemp.Right := rTemp.Left +iG1;
end;
end
else begin //該選單項目沒有被選中
ACanvas.Brush.Color := cl3DLight; //設定背景色為淺灰
rTemp:=ARect;
rTemp.Left := rTemp.left+iW;
ACanvas.FillRect(rTemp);
ACanvas.Font.Color := clBlack;
end;
//設定Canvas的畫筆填滿模式為透明
ACanvas.Brush.Style:=bsClear;
//在選單上輸出文字
ACanvas.TextOut(ARect.Left+iW+5,ARect.Top,strOut);
end;
procedure TForm1.Caption1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
//在OnMeasureItem事件中改變選單的寬度和高度,下面5個程式同
//改變選單的寬度和高度以容納文本
Height:=ACanvas.TextHeight('Caption1')+5;
Width:=ACanvas.TextWidth('Caption1')+5;
iRate:=Round(Image1.Height/(Height*6));
iW:=Round(Image1.Width /iRate);
Width:=Width+iW; //根據計算改變選單寬度以容納附加的文本
end;
procedure TForm1.Caption2MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
Height:=ACanvas.TextHeight('Caption1')+5;
Width:=ACanvas.TextWidth('Caption1')+5;
iRate:=Round(Image1.Height/(Height*6));
iW:=Round(Image1.Width /iRate);
Width:=Width+iW;
end;
procedure TForm1.Caption3MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
Height:=ACanvas.TextHeight('Caption1')+5;
Width:=ACanvas.TextWidth('Caption1')+5;
iRate:=Round(Image1.Height/(Height*6));
iW:=Round(Image1.Width /iRate);
Width:=Width+iW;
end;
procedure TForm1.Caption4MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
Height:=ACanvas.TextHeight('Caption1')+5;
Width:=ACanvas.TextWidth('Caption1')+5;
iRate:=Round(Image1.Height/(Height*6));
iW:=Round(Image1.Width /iRate);
Width:=Width+iW;
end;
procedure TForm1.Caption5MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
Height:=ACanvas.TextHeight('Caption1')+5;
Width:=ACanvas.TextWidth('Caption1')+5;
iRate:=Round(Image1.Height/(Height*6));
iW:=Round(Image1.Width /iRate);
Width:=Width+iW;
end;
procedure TForm1.Caption6MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
Height:=ACanvas.TextHeight('Caption1')+5;
Width:=ACanvas.TextWidth('Caption1')+5;
iRate:=Round(Image1.Height/(Height*6));
iW:=Round(Image1.Width /iRate);
Width:=Width+iW;
end;
procedure TForm1.Caption1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption1');
end;
procedure TForm1.Caption2DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption2');
end;
procedure TForm1.Caption3DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption3');
end;
procedure TForm1.Caption4DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption4');
end;
procedure TForm1.Caption5DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption5');
end;
procedure TForm1.Caption6DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption6');
end;
end.