395 lines
12 KiB
ObjectPascal
395 lines
12 KiB
ObjectPascal
unit uDAClientDataModuleWizard;
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses DesignEditors, ToolsAPI, Windows, ActnList, Menus, Classes;
|
|
|
|
const CRLF = #13#10; // Carriage-return line-feed.
|
|
|
|
resourcestring
|
|
sBasicDfmSource =
|
|
'object %0:s: T%0:s' + crlf +
|
|
' Left = 200' + crlf +
|
|
' Top = 200' + crlf +
|
|
' Height = 300' + crlf +
|
|
' Width = 300' + crlf +
|
|
' RemoteService = RORemoteService' + crlf +
|
|
' Adapter = DABinAdapter' + crlf +
|
|
' SchemaCall.MethodName = ''GetSchemaAsXML''' + crlf +
|
|
' SchemaCall.Params = <' + crlf +
|
|
' item' + crlf +
|
|
' Name = ''Result''' + crlf +
|
|
' ParamType = fResult' + crlf +
|
|
' DataType = rtString' + crlf +
|
|
' end>' + crlf +
|
|
' object ROChannel: TROWinInetHTTPChannel' + crlf +
|
|
' UserAgent = ''RemObjects SDK''' + crlf +
|
|
' TargetURL = ''http://localhost:8099/bin''' + crlf +
|
|
' Left = 40' + crlf +
|
|
' Top = 8' + crlf +
|
|
' end' + crlf +
|
|
' object ROMessage: TROBinMessage' + crlf +
|
|
' Left = 40' + crlf +
|
|
' Top = 52' + crlf +
|
|
' end' + crlf +
|
|
' object RORemoteService: TRORemoteService' + crlf +
|
|
' Message = ROMessage' + crlf +
|
|
' Channel = ROChannel' + crlf +
|
|
' Left = 40' + crlf +
|
|
' Top = 96' + crlf +
|
|
' end' + crlf +
|
|
' object DABinAdapter: TDABINAdapter' + crlf +
|
|
' Left = 40' + crlf +
|
|
' Top = 144' + crlf +
|
|
' end' + crlf +
|
|
'end';
|
|
|
|
sBasicFormSource =
|
|
'unit %0:s;' + crlf +
|
|
crlf +
|
|
'interface' + crlf +
|
|
crlf +
|
|
'uses {vcl:} SysUtils, Classes, DB, DBClient, ' + crlf +
|
|
' {RemObjects:} %3:s;' + crlf +
|
|
crlf +
|
|
'type' + crlf +
|
|
' T%1:s = class(%2:s)' + crlf +
|
|
' ROChannel: TROWinInetHTTPChannel;' + crlf +
|
|
' ROMessage: TROBinMessage;' + crlf +
|
|
' RORemoteService: TRORemoteService;' + crlf +
|
|
' DABinAdapter: TDABINAdapter;' + crlf +
|
|
' private' + crlf +
|
|
' { Private declarations }' + crlf +
|
|
' public' + crlf +
|
|
' { Public declarations }' + crlf +
|
|
' end;' + crlf +
|
|
crlf +
|
|
'var' + crlf +
|
|
' %1:s: T%1:s;' + crlf +
|
|
crlf +
|
|
'implementation' + crlf +
|
|
crlf +
|
|
'{$R *.DFM}' + crlf +
|
|
crlf +
|
|
'initialization' + crlf +
|
|
'end.' ;
|
|
|
|
type TSourceFile = class(TInterfacedObject, IOTAFile)
|
|
private
|
|
fAge: TDateTime;
|
|
fSource:string;
|
|
public
|
|
function GetSource: string;
|
|
function GetAge: TDateTime;
|
|
constructor Create(const iSource:string);
|
|
end;
|
|
|
|
TBaseFormCreator = class(TInterfacedObject, IOTAModuleCreator)
|
|
public
|
|
function GetCreatorType: string;
|
|
function GetExisting: Boolean;
|
|
function GetFileSystem: string;
|
|
function GetOwner: IOTAModule;
|
|
function GetUnnamed: Boolean;
|
|
|
|
function GetAncestorName: string;
|
|
function GetImplFileName: string;
|
|
function GetIntfFileName: string;
|
|
function GetFormName: string;
|
|
function GetMainForm: Boolean;
|
|
function GetShowForm: Boolean;
|
|
function GetShowSource: Boolean;
|
|
function NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
|
|
function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
|
|
function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
|
|
|
|
procedure FormCreated(const FormEditor: IOTAFormEditor);
|
|
end; { TBaseFormCreator }
|
|
|
|
TNewModuleExpert = class(TInterfacedObject,
|
|
IOTAWizard,
|
|
IOTARepositoryWizard,
|
|
IOTAFormWizard,
|
|
{$IFDEF BDS}
|
|
IOTARepositoryWizard80,
|
|
{$ENDIF}
|
|
IOTARepositoryWizard60)
|
|
public
|
|
|
|
constructor Create();
|
|
destructor Destroy(); override;
|
|
|
|
procedure AfterSave;
|
|
procedure BeforeSave;
|
|
procedure Destroyed;
|
|
procedure Modified;
|
|
|
|
procedure Execute;
|
|
function GetAuthor: String;
|
|
function GetComment: String;
|
|
function GetGlyph: Cardinal;
|
|
function GetIDString: String;
|
|
function GetName: String;
|
|
function GetPage: String;
|
|
function GetState: TWizardState;
|
|
function GetDesigner: String;
|
|
|
|
{$IFDEF BDS}
|
|
function GetGalleryCategory: IOTAGalleryCategory;
|
|
function GetPersonality: string;
|
|
{$ENDIF}
|
|
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses SysUtils, Graphics,
|
|
uRORes, uDADataAbstractEditors, Dialogs, uDAClientDataModuleEditorForm, Forms,
|
|
uDAClientDataModule;
|
|
|
|
{ TBaseFormCreator }
|
|
|
|
procedure TBaseFormCreator.FormCreated(const FormEditor: IOTAFormEditor);
|
|
begin
|
|
|
|
end;
|
|
|
|
function TBaseFormCreator.GetAncestorName: string;
|
|
begin
|
|
result := 'TDAClientDataModule';
|
|
end;
|
|
|
|
function TBaseFormCreator.GetCreatorType: string;
|
|
begin
|
|
result := sForm;
|
|
end;
|
|
|
|
function TBaseFormCreator.GetExisting: Boolean;
|
|
begin
|
|
result := false;
|
|
end;
|
|
|
|
function TBaseFormCreator.GetFileSystem: string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TBaseFormCreator.GetFormName: string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TBaseFormCreator.GetImplFileName: string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TBaseFormCreator.GetIntfFileName: string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TBaseFormCreator.GetMainForm: Boolean;
|
|
begin
|
|
result := false;
|
|
end;
|
|
|
|
function TBaseFormCreator.GetOwner: IOTAModule;
|
|
var
|
|
ModuleServices: IOTAModuleServices;
|
|
Module: IOTAModule;
|
|
NewModule: IOTAModule;
|
|
begin
|
|
Result := nil;
|
|
if BorlandIDEServices.QueryInterface(IOTAModuleServices, ModuleServices) =
|
|
S_OK then
|
|
begin
|
|
Module := ModuleServices.CurrentModule;
|
|
if Module <> nil then
|
|
if Module.GetOwnerCount > 0 then
|
|
begin
|
|
NewModule := Module.GetOwner(0);
|
|
if NewModule <> nil then
|
|
if NewModule.QueryInterface(IOTAProject, Result) <> S_OK then
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TBaseFormCreator.GetShowForm: Boolean;
|
|
begin
|
|
result := true;
|
|
end;
|
|
|
|
function TBaseFormCreator.GetShowSource: Boolean;
|
|
begin
|
|
result := true;
|
|
end;
|
|
|
|
function TBaseFormCreator.GetUnnamed: Boolean;
|
|
begin
|
|
result := true;
|
|
end;
|
|
|
|
function RemoveInitialT(const iString:string):string;
|
|
begin
|
|
result := iString;
|
|
if (result <> '') and (result[1] = 'T') then Delete(result,1,1);
|
|
//ShowMessage(iString+' '+result);
|
|
end;
|
|
|
|
function TBaseFormCreator.NewFormFile(const FormIdent,
|
|
AncestorIdent: string): IOTAFile;
|
|
begin
|
|
result := TSourceFile.Create(Format(sBasicDfmSource,[RemoveInitialT(FormIdent)]));
|
|
end;
|
|
|
|
function TBaseFormCreator.NewImplSource(const ModuleIdent, FormIdent,
|
|
AncestorIdent: string): IOTAFile;
|
|
begin
|
|
result := TSourceFile.Create(Format(sBasicFormSource,[ModuleIdent,RemoveInitialT(FormIdent),AncestorIdent,'uDAClientDataModule']));
|
|
end;
|
|
|
|
function TBaseFormCreator.NewIntfSource(const ModuleIdent, FormIdent,
|
|
AncestorIdent: string): IOTAFile;
|
|
begin
|
|
|
|
end;
|
|
|
|
{ TSourceFile }
|
|
|
|
constructor TSourceFile.Create(const iSource: string);
|
|
begin
|
|
inherited Create();
|
|
fSource := iSource;
|
|
fAge := Now;
|
|
end;
|
|
|
|
function TSourceFile.GetAge: TDateTime;
|
|
begin
|
|
result := fAge;
|
|
end;
|
|
|
|
function TSourceFile.GetSource: string;
|
|
begin
|
|
result := fSource;
|
|
end;
|
|
|
|
{ TNewModuleExpert }
|
|
|
|
constructor TNewModuleExpert.Create;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
destructor TNewModuleExpert.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TNewModuleExpert.Execute;
|
|
var
|
|
lModuleServices: IOTAModuleServices;
|
|
lModuleCreator: IOTAModuleCreator;
|
|
lModule: IOTAModule;
|
|
begin
|
|
if BorlandIDEServices.QueryInterface(IOTAModuleServices, lModuleServices) = S_OK then
|
|
begin
|
|
lModuleCreator := TBaseFormCreator.Create();
|
|
lModule := lModuleServices.CreateModule(lModuleCreator);
|
|
TDAClientDataModuleEditorForm.Execute(Application,
|
|
(lModule.GetCurrentEditor as INTAFormEditor).FormDesigner.Root as TDAClientDataModule,
|
|
(lModule.GetCurrentEditor as INTAFormEditor).FormDesigner);
|
|
end;
|
|
end;
|
|
|
|
function TNewModuleExpert.GetAuthor: String;
|
|
begin
|
|
result := 'RemObjects Software';
|
|
end;
|
|
|
|
function TNewModuleExpert.GetComment: String;
|
|
begin
|
|
result := 'Data Abstract ClientDataModule';
|
|
end;
|
|
|
|
function TNewModuleExpert.GetGlyph: Cardinal;
|
|
begin
|
|
result := LoadIcon(hInstance,'DAClientDataModule');
|
|
end;
|
|
|
|
function TNewModuleExpert.GetIDString: String;
|
|
begin
|
|
result := 'RemObjectsDAClientDataModule';
|
|
end;
|
|
|
|
function TNewModuleExpert.GetName: String;
|
|
begin
|
|
result := 'Data Abstract ClientDataModule';
|
|
end;
|
|
|
|
function TNewModuleExpert.GetPage: String;
|
|
begin
|
|
result := 'RemObjects Data Abstract';
|
|
end;
|
|
|
|
{$IFDEF BDS}
|
|
function TNewModuleExpert.GetGalleryCategory: IOTAGalleryCategory;
|
|
var
|
|
lGalleryManager: IOTAGalleryCategoryManager;
|
|
begin
|
|
lGalleryManager := BorlandIDEServices as IOTAGalleryCategoryManager;
|
|
result := lGalleryManager.FindCategory('RemObjectsDataAbstractDelphi');
|
|
end;
|
|
|
|
function TNewModuleExpert.GetPersonality: string;
|
|
begin
|
|
result := sDelphiPersonality;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TNewModuleExpert.GetState: TWizardState;
|
|
begin
|
|
result := [wsEnabled];
|
|
end;
|
|
|
|
procedure TNewModuleExpert.AfterSave;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TNewModuleExpert.BeforeSave;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TNewModuleExpert.Destroyed;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TNewModuleExpert.Modified;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
//RegisterPackageWizard(TNewModuleExpert.Create as IOTAFormWizard);
|
|
end;
|
|
|
|
{$R 'uDAClientModuleWizard.res' 'uDAClientModuleWizard.rc'}
|
|
|
|
function TNewModuleExpert.GetDesigner: String;
|
|
begin
|
|
Result := dAny;
|
|
end;
|
|
|
|
initialization
|
|
finalization
|
|
end.
|