{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{       Custom Forms Pack (CFPack)                      }
{                                                       }
{       Copyright (c) 1997-99 Sergey Orlik              }
{                                                       }
{     Written by:                                       }
{       Sergey Orlik                                    }
{       product manager                                 }
{       Russia, C.I.S. and Baltic States (former USSR)  }
{       Inprise Moscow office                           }
{       Internet:  sorlik@inprise.ru                    }
{       www.geocities.com/SiliconValley/Way/9006/       }
{                                                       }
{*******************************************************}
{$I CFPDEF.INC}
{$Warnings OFF}

unit FrmsExpt;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus,
  ComCtrls, ExtCtrls, StdCtrls,
  DesignIntf, ExptIntf, ToolIntf, EditIntf, VirtIntf, TypInfo, 
  CustFrms;

type
  { TCustFormExpert }

  TNewFormOption = (nfRegister,nfAddToProject,nfSimple);

  TCustFormExpert = class(TIExpert)
  private
    procedure RunExpert(ToolServices: TIToolServices);
  public
    function GetName: string; override;
    function GetComment: string; override;
    function GetGlyph: HICON; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetAuthor: string; override;
    function GetPage: string; override;
    procedure Execute; override;
  end;

  TNewCustFormDlg = class(TForm)
    Bevel1: TBevel;
    BtnCancel: TButton;
    BtnCreate: TButton;
    Label3: TLabel;
    EdAncestor: TComboBox;
    RadioProject: TRadioButton;
    RadioRegister: TRadioButton;
    RadioSimple: TRadioButton;
    procedure FormCreate(Sender: TObject);
  end;

var
  NewCustFormDlg: TNewCustFormDlg;

procedure Register;

implementation

{$R *.DFM}
{$R *.RES}

const
  CRLF = #13#10;
  CRLF2 = #13#10#13#10;
  DefaultModuleFlags = [cmShowSource, cmShowForm, cmMarkModified, cmUnNamed];

resourcestring
  sCustFormExpertAuthor = 'Sergey Orlik';
  sCustFormExpertName   = 'Custom Form';
  sCustFormExpertDesc   = 'Create a new custom form';

{ TCustFormModuleCreator }

type
{$IFDEF VER_CB}
  TCustFormModuleCreator = class(TIModuleCreatorEx)
{$ELSE}
  TCustFormModuleCreator = class(TIModuleCreator)
{$ENDIF}
  private
    FAncestorIdent : string;
    FAncestorClass : TClass;
    FNewFormOption : TNewFormOption;
    FFormIdent : string;
    FUnitIdent : string;
    FFileName  : string;
  public
    function Existing: Boolean; override;
    function GetFileName: string; override;
    function GetFileSystem: string; override;
    function GetFormName: string; override;
    function GetAncestorName: string; override;
  {$IFNDEF VER100}
    {$IFDEF VER_CB}
    function GetIntfName: string; override;
    function NewIntfSource(const UnitIdent, FormIdent,
      AncestorIdent: string): string; override;
    {$ENDIF}
    function NewModuleSource(const UnitIdent, FormIdent,
      AncestorIdent: string): string; override;
  {$ELSE}
    function NewModuleSource(UnitIdent, FormIdent,
      AncestorIdent: string): string; override;
  {$ENDIF}
    procedure FormCreated(Form: TIFormInterface); override;
  end;

function TCustFormModuleCreator.Existing:boolean;
begin
  Result:=False
end;

function TCustFormModuleCreator.GetFileName:string;
begin
  Result:=FFileName; //'';
end;

function TCustFormModuleCreator.GetFileSystem:string;
begin
  Result:='';
end;

function TCustFormModuleCreator.GetFormName:string;
begin
  Result:=FFormIdent;
end;

function TCustFormModuleCreator.GetAncestorName:string;
begin
  Result:=FAncestorIdent;
end;

{$IFDEF VER_CB}
function UnitName2Namespace(const Value:string):string;
var
  s1,s2 : string;
begin
  s1:=Value[1];
  s2:=LowerCase(Value);
  System.Delete(s2,1,1);
  Result:=UpperCase(s1)+s2;
end;

function TCustFormModuleCreator.GetIntfName: string;
begin
  Result:='';
end;

function TCustFormModuleCreator.NewIntfSource(const UnitIdent, FormIdent,
      AncestorIdent: string): string;
var
  s : string;
begin
  s:=s+'//---------------------------------------------------------------------------'+
      CRLF+
      '#ifndef '+UnitIdent+'H'+CRLF+
      '#define '+UnitIdent+'H'+CRLF+
      '//---------------------------------------------------------------------------'+
      CRLF+
      '#include <Classes.hpp>'+CRLF+
      '#include <Controls.hpp>'+CRLF+
      '#include <StdCtrls.hpp>'+CRLF+
      '#include <Forms.hpp>'+CRLF;

  if (AncestorIdent<>'Form') and  (AncestorIdent<>'DataModule') then
    s:=s+
     '#include "'+GetCustomFormUnit(FAncestorClass.ClassName)+'.h"'+CRLF;

  s:=s+'//---------------------------------------------------------------------------'+
      CRLF+
      'class T'+FormIdent+' : public '+FAncestorClass.ClassName+CRLF+
      '{'+CRLF+
      '__published:'+CRLF+
      'private:'+CRLF+
      'protected:'+CRLF+
      'public:'+CRLF+
      '        __fastcall T'+FormIdent+'(TComponent* Owner);'+CRLF+
      '};'+CRLF;

  if FNewFormOption<>nfRegister then
   s:=s+
      '//---------------------------------------------------------------------------'+
      CRLF+
      'extern PACKAGE T'+FormIdent+' *'+FormIdent+';'+CRLF;

   s:=s+
      '//---------------------------------------------------------------------------'+
      CRLF+
      '#endif';
  Result:=s;
end;

function TCustFormModuleCreator.NewModuleSource(const UnitIdent, FormIdent,
      AncestorIdent: string): string;
var
  s : string;
begin

  s:='//---------------------------------------------------------------------------'+
     CRLF+
     '#include <vcl.h>'+CRLF;

  if FNewFormOption=nfRegister then
   s:=s+
     '#include "CustFrms.hpp"'+CRLF;

  s:=s+
     '#pragma hdrstop'+CRLF2+

     '#include "'+UnitIdent+'.h"'+CRLF+
     '//---------------------------------------------------------------------------'+
     CRLF+
     '#pragma package(smart_init)'+CRLF;

  if (AncestorIdent<>'Form') and  (AncestorIdent<>'DataModule') then
    s:=s+
     '#pragma link "'+GetCustomFormUnit(FAncestorClass.ClassName)+'"'+CRLF;

  if FNewFormOption<>nfRegister then
    s:=s+
     '#pragma resource "*.dfm"'+CRLF+
     'T'+FormIdent+' *'+FormIdent+';'+CRLF;

  s:=s+
     '//---------------------------------------------------------------------------'+
     CRLF+
     '__fastcall T'+FormIdent+'::T'+FormIdent+'(TComponent* Owner)'+CRLF+
     '        : '+FAncestorClass.ClassName+'(Owner)'+CRLF+
     '{'+CRLF+
     '}'+CRLF+
     '//---------------------------------------------------------------------------'+
     CRLF;

  if FNewFormOption=nfRegister then
    s:=s+
     'namespace '+UnitName2Namespace(UnitIdent)+CRLF+
     '{'+CRLF+
     '        void __fastcall PACKAGE Register()'+CRLF+
     '        {'+CRLF+
     '                 RegisterCustomFormClass(__classid(T'+FormIdent+'));'+CRLF+
     '        }'+CRLF+
     '}'+CRLF+
     '//---------------------------------------------------------------------------'+
     CRLF;

  Result:=s;
end;

{$ELSE} 
  {$IFDEF VER100}
function TCustFormModuleCreator.NewModuleSource(UnitIdent,FormIdent,AncestorIdent:string):string;
  {$ELSE}
function TCustFormModuleCreator.NewModuleSource(const UnitIdent,FormIdent,AncestorIdent:string):string;
  {$ENDIF}
var
  s : string;
begin
  s:='unit '+FUnitIdent+';'+CRLF2+
      'interface'+CRLF2+
      'uses'+CRLF+
      '  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs';

  if (FAncestorIdent<>'Form') and (FAncestorIdent<>'DataModule') then
    s:=s+','+CRLF+
      '  '+GetCustomFormUnit(FAncestorClass.ClassName);

  if FNewFormOption=nfRegister then
    s:=s+','+
      ' CustFrms';

    s:=s+';'+CRLF2+
      'type'+CRLF+
      '  T'+FFormIdent+' = class('+FAncestorClass.ClassName+')'+CRLF+
      '  private'+CRLF+
      '  protected'+CRLF+
      '  public'+CRLF+
      '  published'+CRLF+
      '  end;'+CRLF2;

  if FNewFormOption=nfRegister then
    s:=s+
      'procedure Register;'+CRLF2
  else
    s:=s+
      'var'+CRLF+
      '  '+FFormIdent+' : T'+FFormIdent+';'+CRLF2;

  s:=s+
      'implementation'+CRLF2;

  if FNewFormOption=nfRegister then
    s:=s+
      'procedure Register;'+CRLF+
      'begin'+CRLF+
      '  RegisterCustomFormClass(T'+FFormIdent+');'+CRLF+
      'end;'+CRLF2
  else
    s:=s+
      '{$R *.DFM}'+CRLF2;

  s:=s+
      'end.';

  Result:=s;
end;
{$ENDIF}

procedure TCustFormModuleCreator.FormCreated(Form:TIFormInterface);
begin
end;

{ HandleException }

procedure HandleException;
begin
  ToolServices.RaiseException(ReleaseException);
end;

{ TCustFormExpert }

function TCustFormExpert.GetName: string;
begin
  try
    Result := sCustFormExpertName;
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetComment: string;
begin
  try
    Result := sCustFormExpertDesc;
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetGlyph: HICON;
begin
  try
    Result := LoadIcon(HInstance, 'NEWCUSTFORM');
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetStyle: TExpertStyle;
begin
  try
    Result := esForm;
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetState: TExpertState;
begin
  try
    Result := [esEnabled];
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetIDString: string;
begin
  try
    Result := 'Borland.'+sCustFormExpertName;
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetAuthor: string;
begin
  try
    Result := sCustFormExpertAuthor;
  except
    HandleException;
  end;
end;

function TCustFormExpert.GetPage: string;
begin
  try
    Result := 'New';
  except
    HandleException;
  end;
end;

procedure TCustFormExpert.Execute;
begin
  try
    RunExpert(ToolServices);
  except
    HandleException;
  end;
end;

procedure TCustFormExpert.RunExpert(ToolServices: TIToolServices);
var
  ModuleFlags : TCreateModuleFlags;
  IModuleCreator : TCustFormModuleCreator;
  IModule : TIModuleInterface;
  s : string;
begin
  if ToolServices = nil then Exit;
  NewCustFormDlg:=TNewCustFormDlg.Create(Application);
  if NewCustFormDlg.ShowModal=mrCancel then
  begin
    NewCustFormDlg.Free;
    Exit;
  end;
  IModuleCreator:=TCustFormModuleCreator.Create;
  if NewCustFormDlg.RadioRegister.Checked then
    IModuleCreator.FNewFormOption:=nfRegister
  else
    if NewCustFormDlg.RadioProject.Checked then
      IModuleCreator.FNewFormOption:=nfAddToProject
    else
      IModuleCreator.FNewFormOption:=nfSimple;
  s:=NewCustFormDlg.EdAncestor.Text;
  if s<>EmptyStr then
    System.Delete(s,1,1);
  IModuleCreator.FAncestorIdent:=s;
  IModuleCreator.FAncestorClass:=GetCustomFormClass(NewCustFormDlg.EdAncestor.Items[NewCustFormDlg.EdAncestor.ItemIndex]);
  ToolServices.GetNewModuleAndClassName(IModuleCreator.FAncestorIdent,
    IModuleCreator.FUnitIdent,IModuleCreator.FFormIdent,IModuleCreator.FFileName);
  ModuleFlags:=DefaultModuleFlags;
  if IModuleCreator.FNewFormOption=nfAddToProject then
    ModuleFlags:=ModuleFlags+[cmAddToProject];
  try
{$IFDEF VER_CB}
    IModule:=ToolServices.ModuleCreateEx(IModuleCreator,ModuleFlags);
{$ELSE}
    IModule:=ToolServices.ModuleCreate(IModuleCreator,ModuleFlags);
{$ENDIF}
    IModule.Free;
  finally
    IModuleCreator.Free;
    NewCustFormDlg.Free;
  end;
end;

{ TNewCustFormDlg }

procedure TNewCustFormDlg.FormCreate(Sender: TObject);
type
  TGetStrFunc = function(const Value: string): Integer of object;
var
  Func : TGetStrFunc;
begin
  Func:=EdAncestor.Items.Add;
  GetCustomFormClasses(TGetStrProc(Func));
  EdAncestor.ItemIndex:=0;
end;

{ Register }

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

end.