让主菜单能下拉出颜色选单

为让主菜单能下拉出颜色选单，这需要设置MainMenu的OwnerDraw为True，然后逐个画出来。

为了方便，可以先整个ColorMenu组件，然后直接拉过来用就可以了：

 

ColorMenu组件（代码由本人网上收集修改，建议收藏）：

===================================================================================

unit ColorMenu;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Menus;

 

const

  CPMenuWidth = 80;

  CPDefItemHeight = 16;

  CPColorRectWidth = 24;

 

type

  TColorLanguage = (cpEnglish, cpChinese);

 

  TColorMenu = class(TMenu)

  private

    FItemHeight: Integer;

    FDisplayNames: Boolean;

    FDisplayCustom: Boolean;

    FColorNames: TStrings;

    FLanguage: TColorLanguage;

    FSelectedColor: TColor;

    FCustomColor: TColor;

 

    FOnSelectColor: TNotifyEvent;

 

    function ShowCustomColorDlg: Boolean;

    function GetColorCustomizeName: string;

    procedure SetColorLanguage(Value: TColorLanguage);

    procedure SetDisplayNames(Value: Boolean);

 

    procedure InitializeMenuItems;

    procedure ColorItemDrawItem(Sender: TObject; ACanvas: TCanvas;

      ARect: TRect; Selected: Boolean);

    procedure ColorItemMeasureItem(Sender: TObject;

      ACanvas: TCanvas; var Width, Height: Integer);

    procedure ColorItemClick(Sender: TObject);

  protected

    procedure Loaded; override;

  public

    procedure AddThisMenu(PMenu: TMenuItem);

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    property SelectedColor: TColor read FSelectedColor;

  published

    property DisplayNames: Boolean read FDisplayNames write SetDisplayNames default True;

    property DisplayCustom: Boolean read FDisplayCustom write FDisplayCustom default True;

    property OnSelectColor: TNotifyEvent read FOnSelectColor write FOnSelectColor;

  end;

 

procedure Register;

 

implementation

 

const

  ColorCount = 16;

  ColorValues: array[0..ColorCount - 1] of TColor = (

    clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,

    clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite

    );

  CnColorNames: array[-1..ColorCount - 1] of string = (

    '定制...',

    '黑色', '深红色', '绿色', '橄榄色', '藏青色', '紫色', '青色', '灰色',

    '银色', '红色', '浅绿色', '黄色', '蓝色', '紫红色', '浅绿色', '白色'

    );

  EnColorNames: array[-1..ColorCount - 1] of string = (

    'Customize...',

    'Black', 'Maroon', 'Green', 'Olive', 'Navy', 'Purple', 'Teal', 'Gray',

    'Silver', 'Red', 'Lime', 'Yellow', 'Blue', 'Fuchsia', 'Aqua', 'White'

    );

 

procedure Register;

begin

  RegisterComponents('Samples', [TColorMenu]);

end;

 

{ TColorMenu }

 

constructor TColorMenu.Create(AOwner: TComponent);

begin

  inherited;

  FItemHeight := CPDefItemHeight;

  FColorNames := TStringList.Create;

  FDisplayNames := True;

  FDisplayCustom := True;

  FSelectedColor := clBlack;

  SetColorLanguage(cpChinese);

end;

 

destructor TColorMenu.Destroy;

begin

  FColorNames.Free;

  inherited;

end;

 

procedure TColorMenu.ColorItemDrawItem(Sender: TObject;

  ACanvas: TCanvas; ARect: TRect; Selected: Boolean);

var

  ColorRect: TRect;

  Index, TextH: Integer;

  ColorName: string;

begin

  Index := (Sender as TMenuItem).Tag;

  if (Index >=0) and (Index < ColorCount) or (Index = -1) then

  begin

    if Selected then

    begin

      ACanvas.Brush.Color := clActiveCaption;

      ACanvas.Pen.Color := clWhite;

      ACanvas.Font.Color := clWhite;

    end else

    begin

      ACanvas.Brush.Color := clMenu;

      ACanvas.Pen.Color := clBlack;

      ACanvas.Font.Color := clBlack;

    end;

    ACanvas.FillRect(ARect);

 

    if Index <> -1 then

      ACanvas.Brush.Color := ColorValues[Index]

    // 如果是"定制"项

    else

      ACanvas.Brush.Color := FCustomColor;

    ColorRect.Left := ARect.Left + 2;;

    ColorRect.Top := ARect.Top + 2;;

    if FDisplayNames then

      ColorRect.Right := ColorRect.Left + CPColorRectWidth

    else

      ColorRect.Right := ARect.Right - 2;

    ColorRect.Bottom := ARect.Bottom - 2;

    ACanvas.Rectangle(ColorRect);

 

    if FDisplayNames then

    begin

      ACanvas.Brush.Style := bsClear;

      if Index <> -1 then

        ColorName := FColorNames[Index]

      else

        ColorName := GetColorCustomizeName;

      TextH := ACanvas.TextHeight(ColorName);

      ACanvas.TextOut(ColorRect.Right + 20,

        ARect.Top + (ARect.Bottom - ARect.Top - TextH) div 2,

        ColorName);

    end;

  end;

end;

 

 

procedure TColorMenu.ColorItemMeasureItem(Sender: TObject;

  ACanvas: TCanvas; var Width, Height: Integer);

begin

  Width := CPMenuWidth;

  Height := FItemHeight;

end;

 

procedure TColorMenu.ColorItemClick(Sender: TObject);

var

  Index: Integer;

  Selected: Boolean;

begin

  Index := (Sender as TMenuItem).Tag;

  Selected := False;

  if (Index >=0) and (Index < ColorCount) then

  begin

    FSelectedColor := ColorValues[Index];

    Selected := True;

  end;

  if Index = -1 then

    Selected := ShowCustomColorDlg;

   

  if Selected and Assigned(FOnSelectColor) then

    FOnSelectColor(Self);

end;

 

procedure TColorMenu.Loaded;

begin

  inherited;

  OwnerDraw := True;

  InitializeMenuItems;

end;

 

procedure TColorMenu.InitializeMenuItems;

var

  I: Integer;

  MenuItem: TMenuItem;

begin

  Items.Clear;

  for I := 0 to ColorCount - 1 do

  begin

    MenuItem := TMenuItem.Create(Self);

    Items.Add(MenuItem);

    MenuItem.Tag := I;

  end;

  if FDisplayCustom then

  begin

    MenuItem := TMenuItem.Create(Self);

    Items.Add(MenuItem);

    MenuItem.Tag := -1;   //"定制"项

  end;

 

  for I := 0 to Items.Count - 1 do

  begin

    MenuItem := Items.Items[I];

    MenuItem.OnDrawItem := ColorItemDrawItem;

    MenuItem.OnMeasureItem := ColorItemMeasureItem;

    MenuItem.OnClick := ColorItemClick;

  end;

end;

 

 

procedure TColorMenu.AddThisMenu(PMenu: TMenuItem);

var

  I: Integer;

  MenuItem: TMenuItem;

begin

  PMenu.Clear;

  for I := 0 to ColorCount - 1 do

  begin

    MenuItem := TMenuItem.Create(Self);

    PMenu.Add(MenuItem);

    MenuItem.Tag := I;

  end;

  if FDisplayCustom then

  begin

    MenuItem := TMenuItem.Create(Self);

    PMenu.Add(MenuItem);

    MenuItem.Tag := -1;   //"定制"项

  end;

 

  for I := 0 to PMenu.Count - 1 do

  begin

    MenuItem := PMenu.Items[I];

    MenuItem.OnDrawItem := ColorItemDrawItem;

    MenuItem.OnMeasureItem := ColorItemMeasureItem;

    MenuItem.OnClick := ColorItemClick;

  end;

end;

 

 

function TColorMenu.ShowCustomColorDlg: Boolean;

var

  ColorDlg: TColorDialog;

begin

  ColorDlg := TColorDialog.Create(Application);

  try

    ColorDlg.Options := ColorDlg.Options;

    ColorDlg.Color := FCustomColor;

    Result := ColorDlg.Execute;

    if Result then

    begin

      FCustomColor := ColorDlg.Color;

      FSelectedColor := ColorDlg.Color;

    end;

  finally

    ColorDlg.Free;

  end;

end;

 

function TColorMenu.GetColorCustomizeName: string;

begin

  if FLanguage = cpEnglish then Result := EnColorNames[-1]

  else Result := CnColorNames[-1];

end;

 

procedure TColorMenu.SetColorLanguage(Value: TColorLanguage);

var

  I: Integer;

begin

  FLanguage := Value;

  FColorNames.Clear;

  case Value of

    cpEnglish:

      for I := 0 to ColorCount - 1 do

        FColorNames.Add(EnColorNames[I]);

    cpChinese:

      for I := 0 to ColorCount - 1 do

        FColorNames.Add(CnColorNames[I]);

  end;

end;

 

procedure TColorMenu.SetDisplayNames(Value: Boolean);

begin

  if FDisplayNames <> Value then

  begin

    FDisplayNames := Value;

  end;

end;

 

end.

===================================================================================

 

安装该组件后，在Form1上添加Mainmenu1和ColorMenu1，代码如下：

===================================================================================

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Menus, ColorMenu;

 

type

  TForm1 = class(TForm)

    MainMenu1: TMainMenu;

    ColorMenu1: TColorMenu;

    M_Color: TMenuItem;

    M_File: TMenuItem;

    M_Open: TMenuItem;

    procedure FormCreate(Sender: TObject);

    procedure ColorMenu1SelectColor(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  ColorMenu1.AddThisMenu(M_Color);

end;

 

procedure TForm1.ColorMenu1SelectColor(Sender: TObject);

begin

  self.color :=  ColorMenu1.SelectedColor;

end;

 

end.

===================================================================================

 

最后，效果图：