利用Delphi訊息處理建立類似Windows開始選單 (轉)

worldblog發表於2007-12-04
Windows
利用Delphi訊息處理建立類似Windows開始選單 (轉)[@more@] 

利用美化你的選單:namespace prefix = o ns = "urn:schemas--com::office" />

  下的很多都有十分漂亮的選單，例如Windows“開始”選單左方從上到下的長條形的Windows Banner 又或者是向那樣在每一個選單條左邊都有一個小圖示，看到這些很Cool的選單，你是否覺得自己的選單顯得單調乏味呢？不需要第三方，利用Delphi就可以實現上面的功能。

  如果要實現自定義選單就需要在繪製選單時改變選單的大小以適應在選單上繪製圖形，然後再在上面繪製自己所需要的選單效果。在Delphi中，每一個選單項對應一個TmenuItem控制元件，這類控制元件都有兩個事件：OnDrawItem和OnMeasureItem，要實現自定義選單，首先要介紹一下這兩個事件：

  OnMeasureItem事件的定義如下：

  type TMenuMeasureItemEvent = procedure (Sender: T; 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; ed: 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.

 

 


來自 “ ITPUB部落格 ” ，連結：http://blog.itpub.net/10752043/viewspace-988117/，如需轉載，請註明出處，否則將追究法律責任。

相關文章