david
e439ebec6f
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.CFPack@2 b7f3c34e-793e-314d-bf25-335ee4f4fe12
479 lines
12 KiB
ObjectPascal
479 lines
12 KiB
ObjectPascal
{*******************************************************}
|
|
{ }
|
|
{ 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.
|
|
|
|
|