dynamenufrm.~pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit DynaMenuFrm;

interface

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

type
  TFormColorText = class(TForm)
    Label1: TLabel;
    ColorDialog1: TColorDialog;
    MainMenu1: TMainMenu;
    FontDialog1: TFontDialog;
    Options1: TMenuItem;
    Font1: TMenuItem;
    BackColor1: TMenuItem;
    N1: TMenuItem;
    Left1: TMenuItem;
    Center1: TMenuItem;
    Right1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N3: TMenuItem;
    DisableHelp1: TMenuItem;
    HideHelp1: TMenuItem;
    procedure Font1Click(Sender: TObject);
    procedure BackColor1Click(Sender: TObject);
    procedure Left1Click(Sender: TObject);
    procedure Center1Click(Sender: TObject);
    procedure Right1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure DisableHelp1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure HideHelp1Click(Sender: TObject);
  public
    procedure SizeItemClick(Sender: TObject);
    procedure SizeClick(Sender: TObject);
  end;

var
  FormColorText: TFormColorText;

implementation

{$R *.DFM}

procedure TFormColorText.Font1Click(Sender: TObject);
begin
  with FontDialog1 do
  begin
    Font := Label1.Font;
    if Execute then
      Label1.Font := Font;
  end;
end;

procedure TFormColorText.BackColor1Click(Sender: TObject);
begin
  with ColorDialog1 do
  begin
    Color := Label1.Color;
    if Execute then
      Label1.Color := Color;
  end;
end;

procedure TFormColorText.Left1Click(Sender: TObject);
begin
  Label1.Alignment := taLeftJustify;
  Left1.Checked := True;
end;

procedure TFormColorText.Center1Click(Sender: TObject);
begin
  Label1.Alignment := taCenter;
  Center1.Checked := True;
end;

procedure TFormColorText.Right1Click(Sender: TObject);
begin
  Label1.Alignment := taRightJustify;
  Right1.Checked := True;
end;

procedure TFormColorText.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TFormColorText.DisableHelp1Click(Sender: TObject);
begin
  DisableHelp1.Checked := not DisableHelp1.Checked;
  Help1.Enabled := not Help1.Enabled;
end;

procedure TFormColorText.FormCreate(Sender: TObject);
var
  PullDown, Item: TMenuItem;
  Position, I: Integer;
begin
  PullDown := TMenuItem.Create (Self);
  PullDown.AutoHotkeys := maManual;
  PullDown.Caption := '大小';
  PullDown.OnClick := SizeClick;
  { 获得“选项”菜单项的位置 }
  Position := MainMenu1.Items.IndexOf (Options1);
  { 插入到“选项”菜单项之后 }
  MainMenu1.Items.Insert (Position + 1, PullDown);
  { 建立若干个选择字体大小的命令 }
  I := 8;
  while I <= 40 do
  begin
    Item := TMenuItem.Create (Self);
    Item.Caption := IntToStr (I);
    { 将它们设置为多中取一菜单项 }
    Item.GroupIndex := 1;
    Item.RadioItem := True;
    { 为它们设置OnClick事件响应 }
    Item.OnClick := SizeItemClick;
    PullDown.Insert (PullDown.Count, Item);
    I := I + 4;
  end;
  // add extra item at the end
  Item := TMenuItem.Create (Self);
  Item.Caption := '定制(&M)';
  Item.GroupIndex := 1;
  Item.RadioItem := True;
  {为其设置OnClick事件响应 }
  Item.OnClick := Font1Click;
  PullDown.Insert (PullDown.Count, Item);
end;

procedure TFormColorText.SizeItemClick(Sender: TObject);
begin
  with Sender as TMenuItem do
    Label1.Font.Size := StrToInt (Caption);
end;

procedure TFormColorText.SizeClick (Sender: TObject);
var
  I: Integer;
  Found: Boolean;
begin
  Found := False;
  with Sender as TMenuItem do
  begin
    { 忽略最后一个定制菜单项 }
    for I := 0 to Count - 2 do
      if StrToInt (Items [I].Caption) =
        Label1.Font.Size then
      begin
        Items [I].Checked := True;
        Found := True;
        {一旦找到符合条件的命令，就退出循环}
        System.Break; 
      end;
    if not Found then
      Items [Count - 1].Checked := True;
  end;
end;

procedure TFormColorText.HideHelp1Click(Sender: TObject);
begin
  //HideHelp1.Checked := not HideHelp1.Checked;
  Help1.Visible := not Help1.Visible;
end;

end.