expblank.pas

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

unit ExpBlank;

interface

uses
  Windows, Dialogs, ExptIntf, ToolIntf,
  FileCtrl, SysUtils, EditIntf;

type
  // standard expert
  TBlankExpert = 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
  TBlankProjectExpert = class (TBlankExpert)
  public
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
    function GetGlyph: HICON; override;
    function GetPage: string; override;
  end;

// **********************************************
// for the advanced project creator-based version
// **********************************************

  TBlankPrjCreator = class (TIProjectCreator)
  public
    FileName, PrjName: String;
    function Existing: Boolean; override;
    function GetFileName: string; override;
    function GetFileSystem: string; override;
    function NewProjectSource(const ProjectName: string): string; override;
    procedure NewDefaultModule; override;
    procedure NewProjectResource(Module: TIModuleInterface); override;
  end;

procedure Register;

implementation

// "standard" blank project expert

function TBlankExpert.GetStyle: TExpertStyle;
begin
  // show up in the Help menu
  Result := esStandard;
end;

function TBlankExpert.GetName: String;
begin
  // official name
  Result := 'Blank Project Wizard'
end;

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

function TBlankExpert.GetComment: String;
begin
  Result := 'First DCU expert';
end;

function TBlankExpert.GetPage: string;
begin
  Result := '';
end;

function TBlankExpert.GetGlyph: HICON;
begin
  Result := 0;
end;

function TBlankExpert.GetState: TExpertState;
begin
  // always enabled, never checked
  Result := [esEnabled];
end;

function TBlankExpert.GetIDString: String;
begin
  // must be unique
  Result := 'DDHandbook.BlankWizard'
end;

function TBlankExpert.GetMenuText: String;
begin
  // the text of the menu item
  Result := '&Blank Project Wizard'
end;

procedure TBlankExpert.Execute;
var
  DirName: string;
  I: Integer;
  BlankPrjCreator: TBlankPrjCreator;  
begin
  // try closing the project
  if ToolServices.CloseProject and
    // try selecting a directory
    SelectDirectory (DirName,
      [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
  begin
    // look for a unique project name in the directory
    I := 1;
    while FileExists (DirName + '\Project' +
        IntToStr (I) + '.dpr') do
      Inc (I);
    // open a project with that (unique) name
    // basic version of the code...
    {    ToolServices.OpenProject (DirName + '\Project' +
      IntToStr (I) + '.dpr');}

    // ******************************************
    // the advanced project creator-based version
    // ******************************************
    BlankPrjCreator := TBlankPrjCreator.Create;
    try
      BlankPrjCreator.PrjName := 'Project' + IntToStr (I);
      BlankPrjCreator.FileName := DirName + '\Project' +
        IntToStr (I) + '.dpr';
      (ToolServices.ProjectCreate (
        BlankPrjCreator, [cpCanShowSource])).Free;
    finally
      BlankPrjCreator.Free;
    end;
  end;
end;

// "project" blank project expert

function TBlankProjectExpert.GetStyle: TExpertStyle;
begin
  // show up in the Object Repository
  Result := esProject;
end;

function TBlankProjectExpert.GetIDString: string;
begin
  // must be unique
  Result := 'DDHandbook.BlankProjectWizard'
end;

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

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

// ******************************************
// the advanced project creator-based version
// ******************************************

function TBlankPrjCreator.Existing: Boolean;
begin
  // the project file doesn't exist
  Result := False;
end;

function TBlankPrjCreator.GetFileName: string;
begin
  // the file name defined by the wizard
  Result := FileName;
end;

function TBlankPrjCreator.GetFileSystem: string;
begin
  // default
  Result := '';
end;

function TBlankPrjCreator.NewProjectSource(const ProjectName: string): string;
begin
  // return the source code
  Result :=
    'program ' + PrjName + ';' + #13#10 +
    #13#10 +
    'uses' + #13#10 +
    '  Forms;' + #13#10 +
    #13#10 +
    '{$R *.RES}' + #13#10 +
    #13#10 +
    'begin' + #13#10 +
    '  Application.Initialize;' + #13#10 +
    '  Application.Run;' + #13#10 +
    'end.'+ #13#10;
end;

procedure TBlankPrjCreator.NewDefaultModule;
begin
  // no new modules
end;

procedure TBlankPrjCreator.NewProjectResource(
  Module: TIModuleInterface);
begin
  // must free the module passed as parameter
  Module.Free;
end;

{$R BLANKPRJ.RES}

procedure Register;
begin
  RegisterLibraryExpert(TBlankExpert.Create);
  RegisterLibraryExpert(TBlankProjectExpert.Create);
end;

end.