expgpform.pas

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

unit ExpGPForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, ExpGPResF, StdCtrls, Buttons, ComCtrls;

type
  TGridExpertPForm = class(TForm)
    BtnCreate: TBitBtn;
    Label1: TLabel;
    EditCaption: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    EditH: TEdit;
    EditV: TEdit;
    UpDownH: TUpDown;
    UpDownV: TUpDown;
    BtnSave: TBitBtn;
    Label4: TLabel;
    EditBtns: TEdit;
    UpDownBtns: TUpDown;
    Label5: TLabel;
    EditUnit: TEdit;
    procedure BtnCreateClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  public
    StrUnit, StrForm: TMemoryStream;
  end;

var
  GridExpertPForm: TGridExpertPForm;
  ResultPForm: TResultPForm;

implementation

{$R *.DFM}

uses
  Grids, ExtCtrls, Proxies;

procedure TGridExpertPForm.BtnCreateClick(Sender: TObject);
var
  I: Integer;
  SpeedButton: TSpeedButton;
begin
  if Assigned (ResultPForm) then
  begin
    ResultPForm.Free;
    ResultPForm := nil;
  end;
  // create the new form...
  ResultPForm := TResultPForm.Create (Application);
  ResultPForm.Caption := EditCaption.Text;
  for I := 1 to UpDownBtns.Position do
  begin
    SpeedButton := TSpeedButton.Create (ResultPForm);
    SpeedButton.Parent := ResultPForm.Panel1;
    SpeedButton.Name := 'SpeedButton' + IntToStr (I);
    SpeedButton.Left := 8 + (I - 1) * SpeedButton.Width;
    SpeedButton.Top := 8;
    SpeedButton.OnClick := ResultPForm.SpeedClick;
  end;
  ResultPForm.Show;
  BtnSave.Enabled := True;
end;

procedure TGridExpertPForm.BtnSaveClick(Sender: TObject);
var
  I, J: Integer;
  S: String;
  CreateMethod: TMethod;
begin
  if not IsValidIdent (EditUnit.Text) or
    not IsValidIdent (ResultPForm.Caption) then
    raise Exception.Create ('Invalid form or unit name');

  StrUnit := TMemoryStream.Create;
  StrForm := TMemoryStream.Create;

  {copy the unit source code to a string, then a stream}
  SetLength (S, 20000);
  S := 'unit ' + EditUnit.Text + ';'#13#13 +
    'interface'#13#13 +
    'uses'#13 +
    '  SysUtils, WinTypes, WinProcs, Messages, Classes,'#13 +
    '  Graphics, Controls, Forms, Dialogs, ExtCtrls;'#13#13 +
    'type'#13 +
    '  T' + ResultPForm.Caption + ' = class (TForm)'#13;

    // add each component
    for I := 0 to ResultPForm.ComponentCount - 1 do
      S := S + '    ' + ResultPForm.Components[I].Name +
        ': ' + ResultPForm.Components[I].ClassName + ';'#13;

    S := S +
    '    procedure FormCreate(Sender: TObject);'#13 +
    '  private'#13 +
    '    { Private declarations }'#13 +
    '  public'#13 +
    '    { Public declarations }'#13 +
    '  end;'#13#13 +
    'var'#13 +
    '  ' + ResultPForm.Caption + ': T' +
      ResultPForm.Caption + ';'#13#13 +
    'implementation'#13#13 +
    '{$R *.DFM}'#13#13 +
    'procedure T' + ResultPForm.Caption +
      '.FormCreate(Sender: TObject);'#13 +
    'begin'#13 +
    '{initialize the string grid items}'#13 +
    '  with StringGrid1 do'#13 +
    '  begin'#13;

    // add the initialization code
    with ResultPForm.StringGrid1 do
      for I := 0 to ColCount - 1 do
        for J := 0 to RowCount - 1 do
          if Cells [I, J] <> '' then
            S := S + Format ('    Cells [%d, %d] := ''%s'';'#13,
              [I, J, Cells [I, J]]);

    S := S + '  end;'#13 +
    'end;'#13#13 +
    'end.'#13;

  // save the string to the stream
  StrUnit.WriteBuffer (Pointer(S)^, Length (S));
  StrUnit.Position := 0;

  {copy the form to the second stream}
  // create a proxy
  Proxies.CreateSubclass (ResultPForm,
    'T' + EditCaption.Text, TForm);
  // change the name
  ResultPForm.Name := EditCaption.Text;
  // re-install the event handler
  CreateMethod.Code := CreateSubclassMethod (
    ResultPForm, 'FormCreate');
  CreateMethod.Data := ResultPForm;
  ResultPForm.OnCreate := TNotifyEvent (CreateMethod);
  // write the form to a memory stream
  StrForm.WriteComponentRes (
    EditCaption.Text, ResultPForm);
  StrForm.Position := 0;

  // delete the form
  ResultPForm.Free;
  ResultPForm := nil;

  // close the expert form,
  // skipping the confirmation message
  OnClose := nil;
  ModalResult := mrOk;
end;

procedure TGridExpertPForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if MessageDlg ('Do you want to quit the Grid Expert?',
    mtConfirmation, [mbYes, mbNo], 0) = idYes then
  begin
    ResultPForm.Free;
    ResultPForm := nil;
  end
  else
    Action := caNone;
end;

end.