unit1.pas

将fastreport2系列frf文件自动生成form

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxExEdtr, FR_Class, StdCtrls, ExtCtrls, DBCtrls, CSDBNavigator,
  CSdxDBNavigator, dxTL, dxDBCtrl, dxDBGrid, dxCntner, DB, DBClient,
  FR_Desgn, FR_DSet, FR_DBSet, dxEditor, dxEdLib;

type
  TForm1 = class(TForm)
    frReport1: TfrReport;
    btnGenForm: TButton;
    mPas: TdxMemo;
    mDfm: TdxMemo;
    btnClose: TButton;
    odFile: TOpenDialog;
    procedure btnGenFormClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    procedure GenPas(Ac_Form: TForm);
    procedure GenDfm(Ac_Form: TForm);
  public
  end;

var
  Form1: TForm1;

implementation

uses
  ufrmAutoGen;

{$R *.dfm}

procedure TForm1.btnGenFormClick(Sender: TObject);
var
  lc_Label: TLabel;
  li_i, li_PageCount, li_j, li_ObjectCount: Integer; //
  lc_Obj: TfrView;
  lc_Page: TfrPage;
  ls_Dir: string;
begin
  if not odFile.Execute then
    Exit;

  frReport1.LoadFromFile(odFile.FileName);
  li_PageCount := frReport1.Pages.Count;
  for li_i := 0 to li_PageCount - 1 do
  begin
    lc_Page := frReport1.Pages[li_i];

    frmAutoGen := TfrmAutoGen.Create(nil);
    try
      li_ObjectCount := lc_Page.Objects.Count;
      for li_j := 0 to li_ObjectCount - 1 do
      begin
        lc_Obj := TfrView(lc_Page.Objects[li_j]);

        //if Pos(' ', lc_Obj.Name) > 0 then
        //  lc_Obj.Name := Trim(lc_Obj.Name);
        lc_Label := TLabel.Create(frmAutoGen);
        lc_Label.Parent := frmAutoGen;
        lc_Label.Name := Format('Label%d', [li_j]);
        lc_Label.Caption := lc_Obj.Memo.Text;
        lc_Label.Left := lc_Obj.x;
        lc_Label.Top := lc_Obj.y;
        lc_Label.Width := lc_Obj.dx;
        lc_Label.Height := lc_Obj.dy;
      end;

      GenPas(frmAutoGen);
      GenDfm(frmAutoGen);
      ls_Dir := ExtractFilePath(Application.ExeName) + Format('gen\%d', [li_i]);
      if not DirectoryExists(ls_Dir) then
        CreateDir(ls_Dir);
      mPas.Lines.SaveToFile(ls_Dir + '\ufrmAutoGen.pas');
      mDfm.Lines.SaveToFile(ls_Dir + '\ufrmAutoGen.dfm');
    finally
      FreeAndNil(frmAutoGen);
    end;
  end;

  ShowMessage('done');
end;

procedure TForm1.GenDfm(Ac_Form: TForm);
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create('');
    try
      BinStream.WriteComponent(Ac_Form);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      mDfm.Lines.Text := StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
end;

procedure TForm1.GenPas(Ac_Form: TForm);
var
  li_i: Integer;
begin
  mPas.Lines.Clear;
  mPas.Lines.Add('unit ufrmAutoGen;                                                           ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('interface                                                                   ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('uses                                                                        ');
  mPas.Lines.Add('  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,');
  mPas.Lines.Add('  Dialogs;                                                                  ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('type                                                                        ');
  mPas.Lines.Add('  TfrmAutoGen = class(TForm)                                                ');

  for li_i := 0 to Ac_Form.ComponentCount - 1 do
  begin
    mPas.Lines.Add('    ' + Ac_Form.Components[li_i].Name + ': ' +
      Ac_Form.Components[li_i].ClassName + ';');
  end;

  mPas.Lines.Add('  private                                                                   ');
  mPas.Lines.Add('  public                                                                    ');
  mPas.Lines.Add('  end;                                                                      ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('var                                                                         ');
  mPas.Lines.Add('  frmAutoGen: TfrmAutoGen;                                                  ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('implementation                                                              ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('{$R *.dfm}                                                                  ');
  mPas.Lines.Add('                                                                            ');
  mPas.Lines.Add('end.                                                                        ');
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.