expgform.pas

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

unit ExpGForm;

interface

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

type
  TGridExpertForm = 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;
    MemoSource: TMemo;
    MemoForm: TMemo;
    procedure BtnCreateClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  end;

var
  GridExpertForm: TGridExpertForm;
  ResultForm: TResultForm;

implementation

{$R *.DFM}

uses
  Grids, ExtCtrls;

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

procedure TGridExpertForm.BtnSaveClick(Sender: TObject);
var
  I, J: Integer;
  StrBin, StrTxt: TMemoryStream;
begin
  {copy the unit source code in the first memo}
  with MemoSource.Lines do
  begin
    BeginUpdate;
    Add ('unit UnitName; // to be filled');
    Add ('');
    Add ('interface');
    Add ('');
    Add ('uses');
    Add ('  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,');
    Add ('  Forms, Dialogs, ExtCtrls;');
    Add ('');
    Add ('type');
    Add ('  T' + ResultForm.Caption + ' = class (TForm)');

    // add each component
    for I := 0 to ResultForm.ComponentCount - 1 do
      Add ('    ' + ResultForm.Components[I].Name +
        ': ' + ResultForm.Components[I].ClassName + ';');
    Add ('    procedure FormCreate(Sender: TObject);');
    Add ('  private');
    Add ('    { Private declarations }');
    Add ('  public');
    Add ('    { Public declarations }');
    Add ('  end;');
    Add ('');
    Add ('var');
    Add ('  '+ ResultForm.Caption +
      ': T' + ResultForm.Caption + ';');
    Add ('');
    Add ('implementation');
    Add ('');
    Add ('{$R *.DFM}');
    Add ('');
    Add ('procedure T' + ResultForm.Caption +
      '.FormCreate(Sender: TObject);');
    Add ('begin');
    Add ('{initialize the string grid items}');
    Add ('  with StringGrid1 do');
    Add ('  begin');

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

  // remove the speedbutton events
  for I := 0 to ResultForm.ComponentCount - 1 do
    if ResultForm.Components [I] is TSpeedButton then
      TSpeedButton (ResultForm.Components [I]).OnClick := nil;

  {copy the form textual description to the second memo}
  StrBin := TMemoryStream.Create;
  StrTxt := TMemoryStream.Create;
  try
    // write the form to a memory stream
    StrBin.WriteComponentRes (
      ResultForm.Name, ResultForm);
    // go back the the beginning
    StrBin.Position := 0;
    // convert the form to text
    ObjectResourceToText (StrBin, StrTxt);
    // go back at the beginning
    StrTxt.Position := 0;
    // load the text
    MemoForm.Lines.LoadFromStream (StrTxt);

    // delete the form
    ResultForm.Free;
    ResultForm := nil;
  finally
    StrBin.Free;
    StrTxt.Free;
  end;

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

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

end.