mydeform.pas

Delphi高级开发指南是开发程序的好帮手

unit MyDeForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons;

type
  TMyDelphiForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    BtnInspectorFont: TButton;
    BtnPaletteFont: TButton;
    CheckMultiline: TCheckBox;
    Label3: TLabel;
    Edit1: TEdit;
    UdHeight: TUpDown;
    BtnRefreshMenu: TButton;
    FontDialog1: TFontDialog;
    BitBtn1: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure CheckMultilineClick(Sender: TObject);
    procedure UdHeightClick(Sender: TObject; Button: TUDBtnType);
    procedure BtnRefreshMenuClick(Sender: TObject);
    procedure BtnInspectorFontClick(Sender: TObject);
    procedure BtnPaletteFontClick(Sender: TObject);
  private
    Palette: TTabControl;
    Inspector: TForm;
  public
    procedure ChangeTab (Sender: TObject);
  end;

var
  MyDelphiForm: TMyDelphiForm;

implementation

{$R *.DFM}

uses
  Menus;

procedure TMyDelphiForm.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  // get Delphi objects
  Palette := Application.MainForm.
    FindComponent ('TabControl') as TTabControl;
  Inspector := nil;
  for I := 0 to Screen.FormCount - 1 do
    if Screen.Forms[I].ClassName = 'TPropertyInspector' then
      Inspector := Screen.Forms[I];
  if not Assigned (Inspector) then
    raise Exception.Create ('Object Inspector not found');
  // set palette menu
  BtnRefreshMenuClick (self);
  // initialize editors
  CheckMultiline.Checked := Palette.Multiline;
  UdHeight.Position := Palette.Height;
end;

procedure TMyDelphiForm.ChangeTab (Sender: TObject);
begin
  Palette.TabIndex := Palette.Tabs.IndexOf (
    (Sender as TMenuItem).Caption);
  Palette.OnChange (self);
end;

procedure TMyDelphiForm.CheckMultilineClick(Sender: TObject);
begin
  Palette.Multiline := CheckMultiline.Checked;
end;

procedure TMyDelphiForm.UdHeightClick(Sender: TObject; Button: TUDBtnType);
begin
  Palette.Height := UdHeight.Position;
  // force resize
  SendMessage (Application.MainForm.Handle,
    wm_Size, 0, 0);
end;

procedure TMyDelphiForm.BtnRefreshMenuClick(Sender: TObject);
var
  i: Integer;
  mi: TMenuItem;
begin
  // remove extra items
  with Palette.PopupMenu do
    if Items.Count > 5 then
      for i := Items.Count - 1 downto 5 do
        Items[i].Free;
  // add separator
  mi := TMenuItem.Create (Application);
  mi.Caption := '-';
  Palette.PopupMenu.Items.Add (mi);
  // add one item for every tab
  for i := 0 to Palette.Tabs.Count - 1 do
  begin
    mi := TMenuItem.Create (Application);
    mi.Caption := Palette.Tabs [i];
    mi.OnClick := ChangeTab;
    Palette.PopupMenu.Items.Add (mi);
  end;
end;

procedure TMyDelphiForm.BtnInspectorFontClick(Sender: TObject);
begin
  FontDialog1.Font := Inspector.Font;
  if FontDialog1.Execute then
    Inspector.Font := FontDialog1.Font;
end;

procedure TMyDelphiForm.BtnPaletteFontClick(Sender: TObject);
begin
  FontDialog1.Font := Palette.Font;
  if FontDialog1.Execute then
    Palette.Font := FontDialog1.Font;
end;

end.