explist.pas

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

unit ExpList;

interface

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

type
  // standard expert
  TExpList = 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;
    procedure ApplyTemplate (SourceStr: TStrings;
      TypeName: string);
  end;

procedure Register;

implementation

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

function TExpList.GetName: String;
begin
  // official name
  Result := 'List Wizard'
end;

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

function TExpList.GetComment: String;
begin
  Result := 'List Wizard';
end;

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

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

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

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

function TExpList.GetMenuText: String;
begin
  // the text of the menu item
  Result := '&List Wizard'
end;

procedure TExpList.Execute;
var
  SourceStr: TStrings;
  OpenDial: TOpenDialog;
  SaveDial: TSaveDialog;
  TypeName: string;
begin
  // 1: choose template file
  OpenDial := TOpenDialog.Create (nil);
  SaveDial := TSaveDialog.Create (nil);
  SourceStr := TStringList.Create;
  try
    OpenDial.Filter := 'Template file (*.ttt)|*.ttt';
    TypeName := 'TObject';
    if OpenDial.Execute then
    begin
      SourceStr.LoadFromFile (OpenDial.FileName);
      // 2: ask for type name
      if InputQuery ('List Wizard', 'Template type:',
        TypeName) then
      begin
        ApplyTemplate (SourceStr, TypeName);
        // 3: save the file and add it to the project
        SaveDial.Filter := 'Pascal file (*.pas)|*.pas';
        SaveDial.DefaultExt := 'pas'; 
        if SaveDial.Execute then
        begin
          // fix unit name (removing path and filename)
          SourceStr.Strings [0] := 'unit ' +
            ChangeFileExt (ExtractFileName (
              SaveDial.FileName), '') + ';';
          SourceStr.SaveToFile (SaveDial.FileName);
          // add the file to the Delphi project
          ToolServices.CreateModuleEx (SaveDial.FileName,
            '', '', '', nil, nil,
            [cmAddToProject, cmExisting, cmShowSource]);
        end;
      end;
    end;
  finally
    OpenDial.Free;
    SaveDial.Free;
    SourceStr.Free;
  end;
end;

procedure TExpList.ApplyTemplate (
  SourceStr: TStrings; TypeName: string);
var
  I, nPos, nDone: Integer;
begin
  nDone := 0;
  for I := 0 to SourceStr.Count - 1 do
  begin
    repeat
      nPos := Pos ('TTT', SourceStr [I]);
      if nPos > 0 then
      begin
        // replace template with typename
        SourceStr [I] :=
          Copy (SourceStr [I], 0, nPos - 1) +
          TypeName +
          Copy (SourceStr [I], nPos + 3, 10000);
        Inc (nDone);
      end;
    until nPos = 0;
  end;
  ShowMessage ('The List Wizard has inserted the ' +
    TypeName + ' type ' + IntToStr (nDone) + ' times');
end;

procedure Register;
begin
  RegisterLibraryExpert(TExpList.Create);
end;

end.