expgrid.pas

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

unit ExpGrid;

interface

uses
  Windows, Dialogs, Classes, SysUtils, ExptIntf, ToolIntf,
  VirtIntf, FileCtrl, Controls, ExpGForm, IStreams, ExpGResF;

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

  TGridFormExpert = class (TGridExpert)
  public
    function GetStyle: TExpertStyle; override;
    function GetName: string; override;
    function GetIDString: string; override;
  end;

  procedure Register;

implementation

uses
  Buttons, Forms;

{$R GRIDICON.RES}

function TGridExpert.GetStyle: TExpertStyle;
begin
  Result := esStandard;
end;
function TGridFormExpert.GetStyle: TExpertStyle;
begin
  Result := esForm;
end;

function TGridExpert.GetName: string;
begin
  Result := 'DDH Grid Expert'
end;
function TGridFormExpert.GetName: string;
begin
  Result := 'DDH Grid Form Expert'
end;

function TGridExpert.GetComment: string;
begin
  Result := 'String Grid Form Expert';
end;

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

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

function TGridExpert.GetPage: string;
begin
  Result := 'Forms'; 
end;

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

function TGridExpert.GetIDString: string;
begin
  Result := 'DDHandbook.GridStandardExpert'
end;
function TGridFormExpert.GetIDString: string;
begin
  Result := 'DDHandbook.GridFormExpert'
end;

function TGridExpert.GetMenuText: string;
begin
  Result := '&Grid Expert...'
end;

procedure TGridExpert.Execute;
var
  FormName, UnitIdent, UnitFileName: string;
  FormStream, FormTextStream, UnitStream: TMemoryStream;
  FormIStream, UnitIStream: TIMemoryStream;
begin
  ToolServices.GetNewModuleName (
    UnitIdent, UnitFileName);
  FormName := 'Form' + Copy (UnitIdent, 5,
    Length (UnitIdent) - 4);
  // create and show the main form
  GridExpertForm :=
    TGridExpertForm.Create (Application);
  try
    // set the result form caption
    GridExpertForm.EditCaption.Text := FormName;
    if GridExpertForm.ShowModal = idOK then
    begin
      // create the three memory streams
      FormStream := TMemoryStream.Create;
      FormTextStream := TMemoryStream.Create;
      UnitStream := TMemoryStream.Create;
      // set some naming details
      GridExpertForm.MemoSource.Lines [0] :=
        'unit ' + UnitIdent + ';';
      GridExpertForm.MemoForm.Lines [0] :=
        'object ' + FormName + ': T' + FormName;
      // save the two memos to streams
      GridExpertForm.MemoForm.Lines.SaveToStream (FormTextStream);
      GridExpertForm.MemoSource.Lines.SaveToStream (UnitStream);
      // convert the form stream
      FormTextStream.Position := 0;
      ObjectTextToResource (FormTextStream, FormStream);
      // reset the two streams (just in case)
      FormStream.Position := 0;
      UnitStream.Position := 0;
      // create the two interface streams
      FormIStream := TIMemoryStream.Create (FormStream);
      UnitIStream := TIMemoryStream.Create (UnitStream);
      // let them own the actual streams
      FormIStream.OwnStream := True;
      UnitIStream.OwnStream := True;
      // create the new module
      ToolServices.CreateModule (
        UnitFileName, UnitIStream, FormIStream,
        [cmAddToProject, cmShowSource, cmShowForm,
        cmUnnamed, cmMarkModified]);
      // free the temporary stream
      FormTextStream.Free;
    end;
  finally
    // free the main form
    GridExpertForm.Free;
  end;
end;

procedure Register;
begin
  RegisterLibraryExpert(TGridExpert.Create);
  RegisterLibraryExpert(TGridFormExpert.Create);
end;

end.