source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Design/TntForms_Design.pas@ 1806

Last change on this file since 1806 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 10.6 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntForms_Design;
13
14{$INCLUDE ..\Source\TntCompilers.inc}
15
16interface
17
18uses
19 Classes, Windows, DesignIntf, ToolsApi;
20
21type HICON = LongWord;
22
23type
24 TTntNewFormWizard = class(TNotifierObject, IOTAWizard, IOTARepositoryWizard,
25 IOTAFormWizard
26 {$IFDEF COMPILER_6_UP}, IOTARepositoryWizard60{$ENDIF}
27 {$IFDEF COMPILER_9_UP}, IOTARepositoryWizard80{$ENDIF})
28 protected
29 function ThisFormName: WideString;
30 function ThisFormClass: TComponentClass; virtual; abstract;
31 function ThisFormUnit: WideString;
32 public
33 // IOTAWizard
34 function GetIDString: AnsiString;
35 function GetName: AnsiString; virtual;
36 function GetState: TWizardState;
37 procedure Execute;
38 // IOTARepositoryWizard
39 function GetAuthor: AnsiString;
40 function GetComment: AnsiString; virtual; abstract;
41 function GetPage: AnsiString;
42 function GetGlyph: HICON;
43 {$IFDEF COMPILER_6_UP}
44 // IOTARepositoryWizard60
45 function GetDesigner: AnsiString;
46 {$ENDIF}
47 {$IFDEF COMPILER_9_UP}
48 // IOTARepositoryWizard80
49 function GetGalleryCategory: IOTAGalleryCategory;
50 function GetPersonality: AnsiString;
51 {$ENDIF}
52 end;
53
54procedure Register;
55
56implementation
57
58uses
59 TntForms, DesignEditors, WCtlForm, TypInfo, SysUtils;
60
61type
62 TTntNewTntFormWizard = class(TTntNewFormWizard)
63 protected
64 function ThisFormClass: TComponentClass; override;
65 public
66 function GetName: AnsiString; override;
67 function GetComment: AnsiString; override;
68 end;
69
70 TTntNewTntFrameWizard = class(TTntNewFormWizard)
71 protected
72 function ThisFormClass: TComponentClass; override;
73 public
74 function GetName: AnsiString; override;
75 function GetComment: AnsiString; override;
76 end;
77
78 TTntFrameCustomModule = class(TWinControlCustomModule)
79 public
80 function Nestable: Boolean; override;
81 end;
82
83 TTntFormCustomModule = class(TCustomModule)
84 public
85 class function DesignClass: TComponentClass; override;
86 end;
87
88procedure Register;
89begin
90 RegisterCustomModule(TTntFrame, TTntFrameCustomModule);
91 RegisterPackageWizard(TTntNewTntFrameWizard.Create);
92 //--
93 RegisterCustomModule(TTntForm, TTntFormCustomModule);
94 //--
95 RegisterPackageWizard(TTntNewTntFormWizard.Create);
96end;
97
98function GetFirstModuleSupporting(const IID: TGUID): IOTAModule;
99var
100 ModuleServices: IOTAModuleServices;
101 i: integer;
102begin
103 Result := nil;
104 if Assigned(BorlandIDEServices) then
105 begin
106 // look for the first project
107 ModuleServices := BorlandIDEServices as IOTAModuleServices;
108 for i := 0 to ModuleServices.ModuleCount - 1 do
109 if Supports(ModuleServices.Modules[i], IID, Result) then
110 Break;
111 end;
112end;
113
114function MyGetActiveProject: IOTAProject;
115{$IFDEF COMPILER_7_UP}
116begin
117 Result := ToolsAPI.GetActiveProject;
118{$ELSE}
119var
120 ProjectGroup: IOTAProjectGroup;
121begin
122 ProjectGroup := GetFirstModuleSupporting(IOTAProjectGroup) as IOTAProjectGroup;
123 if ProjectGroup = nil then
124 Result := nil
125 else
126 Result := ProjectGroup.ActiveProject;
127{$ENDIF}
128 if (Result = nil) then
129 Result := GetFirstModuleSupporting(IOTAProject) as IOTAProject;
130end;
131
132{ TTntNewFormCreator }
133type
134 TTntNewFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator)
135 private
136 FAncestorName: WideString;
137 FUnitName: WideString;
138 public
139 // IOTACreator
140 function GetCreatorType: AnsiString;
141 function GetExisting: Boolean;
142 function GetFileSystem: AnsiString;
143 function GetOwner: IOTAModule;
144 function GetUnnamed: Boolean;
145 // IOTAModuleCreator
146 function GetAncestorName: AnsiString;
147 function GetImplFileName: AnsiString;
148 function GetIntfFileName: AnsiString;
149 function GetFormName: AnsiString;
150 function GetMainForm: Boolean;
151 function GetShowForm: Boolean;
152 function GetShowSource: Boolean;
153 function NewFormFile(const FormIdent, AncestorIdent: AnsiString): IOTAFile;
154 function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
155 function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
156 procedure FormCreated(const FormEditor: IOTAFormEditor);
157 public
158 constructor Create(const UnitName, AncestorName: WideString);
159 end;
160
161 TTntSourceFile = class(TInterfacedObject, IOTAFile)
162 private
163 FSource: AnsiString;
164 public
165 function GetSource: AnsiString;
166 function GetAge: TDateTime;
167 constructor Create(const Source: AnsiString);
168 end;
169
170constructor TTntNewFormCreator.Create(const UnitName, AncestorName: WideString);
171begin
172 inherited Create;
173 FUnitName := UnitName;
174 FAncestorName := AncestorName;
175end;
176
177procedure TTntNewFormCreator.FormCreated(const FormEditor: IOTAFormEditor);
178begin
179end;
180
181function TTntNewFormCreator.GetAncestorName: AnsiString;
182begin
183 Result := FAncestorName;
184end;
185
186function TTntNewFormCreator.GetCreatorType: AnsiString;
187begin
188 Result := sForm;
189end;
190
191function TTntNewFormCreator.GetExisting: Boolean;
192begin
193 Result := False;
194end;
195
196function TTntNewFormCreator.GetFileSystem: AnsiString;
197begin
198 Result := '';
199end;
200
201function TTntNewFormCreator.GetFormName: AnsiString;
202begin
203 Result := '';
204end;
205
206function TTntNewFormCreator.GetImplFileName: AnsiString;
207begin
208 Result := '';
209end;
210
211function TTntNewFormCreator.GetIntfFileName: AnsiString;
212begin
213 Result := '';
214end;
215
216function TTntNewFormCreator.GetMainForm: Boolean;
217begin
218 Result := False;
219end;
220
221function TTntNewFormCreator.GetOwner: IOTAModule;
222begin
223 Result := MyGetActiveProject;
224end;
225
226function TTntNewFormCreator.GetShowForm: Boolean;
227begin
228 Result := True;
229end;
230
231function TTntNewFormCreator.GetShowSource: Boolean;
232begin
233 Result := True;
234end;
235
236function TTntNewFormCreator.GetUnnamed: Boolean;
237begin
238 Result := True;
239end;
240
241function TTntNewFormCreator.NewFormFile(const FormIdent, AncestorIdent: AnsiString): IOTAFile;
242begin
243 Result := nil;
244end;
245
246function TTntNewFormCreator.NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
247const
248 cSource =
249 'unit %s;' + #13#10 +
250 '' + #13#10 +
251 'interface' + #13#10 +
252 '' + #13#10 +
253 'uses' + #13#10 +
254 ' Windows, Messages, SysUtils' + {$IFDEF COMPILER_6_UP}', Variants' + {$ENDIF}
255 ', Classes, Graphics, Controls, Forms,' + #13#10 + ' Dialogs, %s;' + #13#10 +
256 '' + #13#10 +
257 'type' + #13#10 +
258 ' T%s = class(T%s)' + #13#10 +
259 ' private' + #13#10 +
260 ' { Private declarations }' + #13#10 +
261 ' public' + #13#10 +
262 ' { Public declarations }' + #13#10 +
263 ' end;' + #13#10 +
264 '' + #13#10 +
265 'var' + #13#10 +
266 ' %s: T%s;' + #13#10 +
267 '' + #13#10 +
268 'implementation' + #13#10 +
269 '' + #13#10 +
270 '{$R *.DFM}' + #13#10 +
271 '' + #13#10 +
272 'end.';
273begin
274 Result := TTntSourceFile.Create(Format{TNT-ALLOW Format}(cSource,
275 [ModuleIdent, FUnitName, FormIdent, AncestorIdent, FormIdent, FormIdent]));
276end;
277
278function TTntNewFormCreator.NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
279begin
280 Result := nil;
281end;
282
283{ TTntNewFormWizard }
284
285function TTntNewFormWizard.ThisFormName: WideString;
286begin
287 Result := ThisFormClass.ClassName;
288 Delete(Result, 1, 1); // drop the 'T'
289end;
290
291function TTntNewFormWizard.ThisFormUnit: WideString;
292begin
293 Result := GetTypeData(ThisFormClass.ClassInfo).UnitName;
294end;
295
296function TTntNewFormWizard.GetName: AnsiString;
297begin
298 Result := ThisFormName;
299end;
300
301function TTntNewFormWizard.GetAuthor: AnsiString;
302begin
303 Result := 'Troy Wolbrink';
304end;
305
306function TTntNewFormWizard.GetPage: AnsiString;
307begin
308 Result := 'New';
309end;
310
311function TTntNewFormWizard.GetGlyph: HICON;
312begin
313 Result := 0;
314end;
315
316function TTntNewFormWizard.GetState: TWizardState;
317begin
318 Result := [wsEnabled];
319end;
320
321function TTntNewFormWizard.GetIDString: AnsiString;
322begin
323 Result := 'Tnt.Create_'+ThisFormName+'.Wizard';
324end;
325
326procedure TTntNewFormWizard.Execute;
327var
328 Module: IOTAModule;
329begin
330 Module := (BorlandIDEServices as IOTAModuleServices).CreateModule(TTntNewFormCreator.Create(ThisFormUnit, ThisFormName));
331end;
332
333{$IFDEF COMPILER_6_UP}
334function TTntNewFormWizard.GetDesigner: AnsiString;
335begin
336 Result := dVCL;
337end;
338{$ENDIF}
339
340{$IFDEF COMPILER_9_UP}
341function TTntNewFormWizard.GetGalleryCategory: IOTAGalleryCategory;
342var
343 Manager: IOTAGalleryCategoryManager;
344begin
345 Result := nil;
346 Manager := BorlandIDEServices as IOTAGalleryCategoryManager;
347 if Assigned(Manager) then
348 Result := Manager.FindCategory(sCategoryDelphiNew);
349end;
350
351function TTntNewFormWizard.GetPersonality: AnsiString;
352begin
353 Result := sDelphiPersonality;
354end;
355{$ENDIF}
356
357{ TTntSourceFile }
358
359constructor TTntSourceFile.Create(const Source: AnsiString);
360begin
361 FSource := Source;
362end;
363
364function TTntSourceFile.GetAge: TDateTime;
365begin
366 Result := -1;
367end;
368
369function TTntSourceFile.GetSource: AnsiString;
370begin
371 Result := FSource;
372end;
373
374{ TTntNewTntFormWizard }
375
376function TTntNewTntFormWizard.ThisFormClass: TComponentClass;
377begin
378 Result := TTntForm;
379end;
380
381function TTntNewTntFormWizard.GetName: AnsiString;
382begin
383 Result := ThisFormName + ' (Unicode)'
384end;
385
386function TTntNewTntFormWizard.GetComment: AnsiString;
387begin
388 Result := 'Creates a new Unicode enabled TntForm';
389end;
390
391{ TTntNewTntFrameWizard }
392
393function TTntNewTntFrameWizard.ThisFormClass: TComponentClass;
394begin
395 Result := TTntFrame;
396end;
397
398function TTntNewTntFrameWizard.GetName: AnsiString;
399begin
400 Result := ThisFormName + ' (Unicode)'
401end;
402
403function TTntNewTntFrameWizard.GetComment: AnsiString;
404begin
405 Result := 'Creates a new Unicode enabled TntFrame';
406end;
407
408{ TTntFrameCustomModule }
409
410function TTntFrameCustomModule.Nestable: Boolean;
411begin
412 Result := True;
413end;
414
415{ TTntFormCustomModule }
416
417class function TTntFormCustomModule.DesignClass: TComponentClass;
418begin
419 Result := TTntForm;
420end;
421
422end.
Note: See TracBrowser for help on using the repository browser.