expcompf.pas

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

      UpdateSingle;
    end;
end;

procedure TCompWizForm.BtnRevertClick(Sender: TObject);
begin
  // re-update the value, loosing changes
  UpdateSingle;
end;

function TCompWizForm.PropertyDefinition (I: Integer): string;
begin
  Result := 'property ' + GetProp (I) +
    ': ' + GetType (I);
  if GetRead (I) <> '' then
    Result := Result + ' read ' + GetRead (I)
  else
    Result := Result + ' read f' + GetProp (I);
  if GetWrite (I) <> '' then
    Result := Result + ' write ' + GetWrite (I)
  else
    Result := Result + ' write f' + GetProp (I);
  if GetDefault (I) <> '' then
    Result := Result + ' default ' + GetDefault (I);
  Result := Result + ';'
end;

procedure TCompWizForm.FillMemo;
var
  I: Integer;
begin
  with MemoPreview.Lines do
  begin
    Clear;
    BeginUpdate;
    // intestation
    Add ('unit ' + EditUnitName.Text + ';');
    Add ('');
    Add ('interface');
    Add ('');
    Add ('uses');
    Add ('  Windows, Messages, SysUtils, Classes, Graphics,');
    Add ('  Controls, Forms, Dialogs, StdCtrls;');
    Add ('');
    Add ('type');
    Add ('  ' + EditClassName.Text +
      ' = class(' + ComboParentClass.Text + ')');
    Add ('  private');
    // add a field for each property
    Add ('    {data fields for properties}');
    for I := 1 to TotProps do
      if GetProp (I) <> '' then
        Add ('    f' + GetProp (I) + ': ' +
          GetType (I) + ';');

    // add get functions and set procedures
    Add ('  protected');
    Add ('    {set and get methods}');
    for I := 1 to TotProps do
    begin
      if GetRead (I) <> '' then
        Add ('    function ' + GetRead (I) +
          ': ' + GetType (I) + ';');
      if GetWrite (I) <> '' then
        Add ('    procedure ' + GetWrite (I) +
          '(Value: ' + GetType (I) + ');');
    end;

    // add public and published properties,
    // plus the constructor
    Add ('  public');
    for I := 1 to TotProps do
      if (GetProp (I) <> '') and
        (GetAccess (I) = 'public') then
          Add ('    ' + PropertyDefinition (I));
    Add ('    constructor Create (AOwner: TComponent); override;');
    Add ('  published');
    for I := 1 to TotProps do
      if (GetProp (I) <> '') and
        (GetAccess (I) = 'published') then
          Add ('    ' + PropertyDefinition (I));
    Add ('  end;');
    Add ('');
    Add ('procedure Register;');
    Add ('');
    Add ('implementation');
    Add ('');

    // constructor
    Add ('constructor ' + EditClassName.Text +
      '.Create (AOwner: TComponent);');
    Add ('begin');
    Add ('  inherited Create (AOwner);');
    Add ('  // set default values');
    for I := 1 to TotProps do
      if (GetProp (I) <> '') and (GetDefault (I) <> '') then
        Add ('  f' + GetProp (I) + ' := ' + GetDefault (I) + ';');
    Add ('end;');
    Add ('');
    // rough code of the functions
    Add ('{property access functions}');
    Add ('');
    for I := 1 to TotProps do
    begin
      if GetRead (I) <> '' then
      begin
        Add ('function ' + EditClassName.Text + '.' +
          GetRead (I) + ': ' + GetType (I) + ';');
        Add ('begin');
        Add ('  Result := f' + GetProp (I) + ';');
        Add ('end;');
        Add ('');
      end;
      if GetWrite (I) <> '' then
      begin
        Add ('procedure ' + EditClassName.Text + '.' +
          GetWrite (I) + '(Value: ' + GetType (I) + ');');
        Add ('begin');
        Add ('  if Value <> f' + GetProp (I) + ' then');
        Add ('  begin');
        Add ('    f' + GetProp (I) + ' := Value;');
        Add ('    // to do: add side effect as: Invalidate;');
        Add ('  end;');
        Add ('end;');
        Add ('');
      end;
    end;
    Add ('{registration procedure}');
    Add ('');
    Add ('procedure Register;');
    Add ('begin');
    Add ('  RegisterComponents (''' + ComboPage.Text +
       ''', [' + EditClassName.Text + ']);');
    Add ('end;');
    Add ('');
    Add ('end.');
    EndUpdate;
  end;
end;

procedure TCompWizForm.EditClassNameExit(Sender: TObject);
begin
  // copies the initial part of the class name
  // (8 characters, but not the initial 'T')
  if EditUnitName.Text = '' then
    EditUnitName.Text := Copy (EditClassName.Text, 2, 8);
end;

procedure TCompWizForm.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  if PageControl1.ActivePage = SheetMain then
    if (EditClassName.Text = '') or (ComboParentClass.Text = '')
      or (ComboPage.Text = '') then
    begin
      AllowChange := False;
      MessageDlg ('You must fill the main form data first',
        mtError, [mbOK], 0);
    end;
end;

procedure TCompWizForm.BitBtnGenerateClick(Sender: TObject);
var
  Directory, Filename: string;
begin
  if SelectDirectory (Directory,
      [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
  begin
    Filename := Directory + '\' +
      EditUnitName.Text + '.pas';
    // checks if the file already exists
    if not FileExists (Filename) then
      // save the file
      MemoPreview.Lines.SaveToFile (Filename)
    else
      MessageDlg ('The file ' + Filename +
        ' already exists'#13#13 +
        'Choose a new unit name in the Main page'#13 +
        'or select a new directory for the file',
        mtError, [mbOK], 0);

    // special code for the expert
    if ToolServices <> nil then
      // open the component file as a project
      ToolServices.OpenProject (Filename);
  end;
end;

procedure TCompWizForm.BitBtnCloseClick(Sender: TObject);
begin
  // alternative code (modal expert form - main window)
  if MessageDlg ('Are you sure you want to quit the'#13 +
    'Extended Component Wizard, loosing your work?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    ModalResult := mrCancel;
    Close;
  end;
end;

// ***********************************
// standard + project component expert
// ***********************************

function TExtCompExp.GetStyle: TExpertStyle;
begin
  Result := esStandard;
end;

function TPrjExtCompExp.GetStyle: TExpertStyle;
begin
  Result := esProject;
end;

function TExtCompExp.GetName: String;
begin
  Result := 'Standard Extended Component Wizard'
end;

function TPrjExtCompExp.GetName: String;
begin
  Result := 'Project Extended Component Wizard'
end;

function TExtCompExp.GetAuthor: string;
begin
  Result := 'Marco and Tim';
end;

function TExtCompExp.GetComment: String;
begin
  Result := 'Extended Component Wizard';
end;

function TExtCompExp.GetPage: string;
begin
  Result := 'Projects';
end;

function TExtCompExp.GetGlyph: HICON;
begin
  Result := LoadIcon (HInstance,
    MakeIntResource ('EXTCOMPEXP'));
end;

function TExtCompExp.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

function TExtCompExp.GetIDString: String;
begin
  Result := 'DDHandbook.ExtCompExp'
end;

function TPrjExtCompExp.GetIDString: String;
begin
  Result := 'DDHandbook.PrjExtCompExp'; 
end;

function TExtCompExp.GetMenuText: String;
begin
  Result := '&Extended Component Wizard...';
end;

procedure TExtCompExp.Execute;
begin
  // try closing the project
  if ToolServices.CloseProject then
  begin
    CompWizForm := TCompWizForm.Create (Application);
    try
      CompWizForm.ShowModal;
    finally
      CompWizForm.Free;
    end;
  end;
end;

// include icon
{$R ECEICON.RES}

// registration

procedure Register;
begin
  RegisterLibraryExpert(TExtCompExp.Create);
  RegisterLibraryExpert(TPrjExtCompExp.Create);
end;

end.