expcompf.pas

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

unit ExpCompF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, ComCtrls, Buttons, ExtCtrls, Menus, FileCtrl, ExptIntf;

type
  // expert form
  TCompWizForm = class(TForm)
    PageControl1: TPageControl;
    SheetMain: TTabSheet;
    SheetProperties: TTabSheet;
    SheetSingle: TTabSheet;
    Label1: TLabel;
    EditClassName: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    EditUnitName: TEdit;
    StringGridProps: TStringGrid;
    Label4: TLabel;
    Label5: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    EditPropName: TEdit;
    CheckRead: TCheckBox;
    CheckWrite: TCheckBox;
    EditDefault: TEdit;
    RadioAccess: TRadioGroup;
    BtnRevert: TBitBtn;
    BtnPrev: TBitBtn;
    BtnNext: TBitBtn;
    PopupGrid: TPopupMenu;
    NewProperty1: TMenuItem;
    RemoveProperty1: TMenuItem;
    Label6: TLabel;
    LabelPropNo: TLabel;
    SheetPreview: TTabSheet;
    MemoPreview: TMemo;
    Panel1: TPanel;
    BitBtnGenerate: TBitBtn;
    BitBtnClose: TBitBtn;
    BitBtnExit: TBitBtn;
    ComboParentClass: TComboBox;
    ComboPage: TComboBox;
    ComboTypeName: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure StringGridPropsSelectCell(Sender: TObject; Col, Row: Longint;
      var CanSelect: Boolean);
    procedure PageControl1Change(Sender: TObject);
    procedure BtnPrevClick(Sender: TObject);
    procedure NewProperty1Click(Sender: TObject);
    procedure RemoveProperty1Click(Sender: TObject);
    procedure BtnNextClick(Sender: TObject);
    procedure BtnRevertClick(Sender: TObject);
    procedure EditClassNameExit(Sender: TObject);
    procedure PageControl1Changing(Sender: TObject;
      var AllowChange: Boolean);
    procedure BitBtnGenerateClick(Sender: TObject);
    procedure BitBtnCloseClick(Sender: TObject);
  private
    CurrProp, TotProps: Integer;
    function GetProp (Prop: Integer): string;
    function GetType (Prop: Integer): string;
    function GetRead (Prop: Integer): string;
    function GetWrite (Prop: Integer): string;
    function GetAccess (Prop: Integer): string;
    function GetDefault (Prop: Integer): string;
    function PropertyDefinition (I: Integer): string;
  public
    procedure UpdateSingle;
    procedure UpdateGrid;
    procedure FillMemo;
  end;

  // standard expert
  TExtCompExp = class (TIExpert)
  public
    function GetStyle: TExpertStyle; override;
    function GetName: string; override;
    function GetAuthor: string; override;
    function GetComment: string; override;
    function GetPage: string; override;
    function GetGlyph: HICON; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;
    procedure Execute; override;
  end;

  // project expert
  TPrjExtCompExp = class (TExtCompExp)
  public
    function GetStyle: TExpertStyle; override;
    function GetName: string; override;
    function GetIDString: string; override;
  end;

var
  CompWizForm: TCompWizForm;

procedure Register;

implementation

{$R *.DFM}

uses
  Registry;

// extended component expert form

function TCompWizForm.GetProp (Prop: Integer): string;
begin
  Result := StringGridProps.Cells [0, Prop];
end;

function TCompWizForm.GetType (Prop: Integer): string;
begin
  Result := StringGridProps.Cells [1, Prop];
end;

function TCompWizForm.GetRead (Prop: Integer): string;
begin
  Result := StringGridProps.Cells [2, Prop];
end;

function TCompWizForm.GetWrite (Prop: Integer): string;
begin
  Result := StringGridProps.Cells [3, Prop];
end;

function TCompWizForm.GetAccess (Prop: Integer): string;
begin
  Result := StringGridProps.Cells [4, Prop];
end;

function TCompWizForm.GetDefault (Prop: Integer): string;
begin
  Result := StringGridProps.Cells [5, Prop];
end;

procedure TCompWizForm.UpdateSingle;
begin
  LabelPropNo.Caption := IntToStr (CurrProp);
  EditPropName.Text := GetProp (CurrProp);
  ComboTypeName.Text := GetType (CurrProp);
  EditDefault.Text := GetDefault (CurrProp);
  CheckRead.Checked := GetRead (CurrProp) <> '';
  CheckWrite.Checked := GetWrite (CurrProp) <> '';
  if GetAccess (CurrProp) <> '' then
    RadioAccess.ItemIndex :=
      RadioAccess.Items.IndexOf (GetAccess (CurrProp));
end;

procedure TCompWizForm.UpdateGrid;
begin
  with StringGridProps do
  begin
    Cells [0, CurrProp] := EditPropName.Text;
    Cells [1, CurrProp] := ComboTypeName.Text;
    if CheckRead.Checked then
      Cells [2, CurrProp] := 'Get' + EditPropName.Text
    else
      Cells [2, CurrProp] := '';
    if CheckWrite.Checked then
      Cells [3, CurrProp] := 'Set' + EditPropName.Text
    else
      Cells [3, CurrProp] := '';
    if RadioAccess.ItemIndex >= 0 then
      Cells [4, CurrProp] := RadioAccess.Items [
        RadioAccess.ItemIndex];
    Cells [5, CurrProp] := EditDefault.Text;
    Row := CurrProp;
  end;
end;

procedure TCompWizForm.FormCreate(Sender: TObject);
var
  nMod, nComp: Integer;
  CompClass: TClass;
  Reg: TRegistry;
begin
  with StringGridProps do
  begin
    Cells [0, 0] := 'property';
    Cells [1, 0] := 'type';
    Cells [2, 0] := 'read';
    Cells [3, 0] := 'write';
    Cells [4, 0] := 'access';
    Cells [5, 0] := 'default';
  end;
  CurrProp := 1;
  TotProps := 1;
  PageControl1.ActivePage := SheetMain;

  // get the list of palette pages
  Reg := TRegistry.Create;
  if Reg.OpenKey (
      'Software\Borland\Delphi\3.0\Palette',
      False) then
    Reg.GetValueNames (ComboPage.Items);
  Reg.Free;

  // special code for the expert
  if ToolServices <> nil then
  begin
    // get the list of installed components
    // plus their parent classes
    for nMod := 0 to
        ToolServices.GetModuleCount - 1 do
      for nComp := 0 to
          ToolServices.GetComponentCount (nMod) - 1 do
        begin
          ComboParentClass.Items.Add (
            ToolServices.GetComponentName (nMod, nComp));
          try
            CompClass := FindClass (ToolServices.
              GetComponentName (nMod, nComp)).ClassParent;
            while (CompClass <> TComponent) and
              (ComboParentClass.Items.IndexOf (
                CompClass.ClassName) = -1) do
            begin
              ComboParentClass.Items.Add (
                CompClass.ClassName);
              CompClass := CompClass.ClassParent;
            end;
          except on E: Exception do
            ShowMessage (E.Message);
          end;
        end;
  end; // end of special expert code
end;

procedure TCompWizForm.StringGridPropsSelectCell(Sender: TObject; Col,
  Row: Longint; var CanSelect: Boolean);
begin
  if (Row <> 0) then
    CurrProp := Row;
end;

procedure TCompWizForm.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePage = SheetSingle then
    UpdateSingle
  else
    UpdateGrid;
  if PageControl1.ActivePage = SheetPreview then
    FillMemo;
end;

procedure TCompWizForm.BtnPrevClick(Sender: TObject);
begin
  UpdateGrid;
  if CurrProp > 1 then
  begin
    Dec (CurrProp);
    UpdateSingle;
  end;
end;

procedure TCompWizForm.NewProperty1Click(Sender: TObject);
begin
  Inc (TotProps);
  StringGridProps.RowCount := StringGridProps.RowCount + 1;
end;

procedure TCompWizForm.RemoveProperty1Click(Sender: TObject);
var
  I: Integer;
begin
  if MessageDlg ('Are you sure you want to delete the ' +
      StringGridProps.Cells [0, CurrProp] + ' property?',
      mtConfirmation, [mbYes, mbNo], 0) = idYes then
    // set the line to ''
    for I := 0 to 5 do
      StringGridProps.Cells [I, CurrProp] := '';
end;

procedure TCompWizForm.BtnNextClick(Sender: TObject);
begin
  UpdateGrid;
  if CurrProp < TotProps then
  begin
    Inc (CurrProp);
    UpdateSingle;
  end
  else
    if MessageDlg ('Do you want to add a new property?',
      mtConfirmation, [mbYes, mbNo], 0) = idYes then
    begin
      NewProperty1Click (self);
      Inc (CurrProp);