Design/TntForms_Design.pas

   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
  12 unit TntForms_Design;
  13
  14 {$INCLUDE ..\Source\TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Classes, Windows, DesignIntf, ToolsApi;
  20
  21 type HICON = LongWord;
  22
  23 type
  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
  54 procedure Register;
  55
  56 implementation
  57
  58 uses
  59   TntForms, DesignEditors, WCtlForm, TypInfo, SysUtils;
  60
  61 type
  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
  88 procedure Register;
  89 begin
  90   RegisterCustomModule(TTntFrame, TTntFrameCustomModule);
  91   RegisterPackageWizard(TTntNewTntFrameWizard.Create);
  92   //--
  93   RegisterCustomModule(TTntForm, TTntFormCustomModule);
  94   //--
  95   RegisterPackageWizard(TTntNewTntFormWizard.Create);
  96 end;
  97
  98 function GetFirstModuleSupporting(const IID: TGUID): IOTAModule;
  99 var
 100   ModuleServices: IOTAModuleServices;
 101   i: integer;
 102 begin
 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;
 112 end;
 113
 114 function MyGetActiveProject: IOTAProject;
 115 {$IFDEF COMPILER_7_UP}
 116 begin
 117   Result := ToolsAPI.GetActiveProject;
 118 {$ELSE}
 119 var
 120   ProjectGroup: IOTAProjectGroup;
 121 begin
 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;
 130 end;
 131
 132 { TTntNewFormCreator }
 133 type
 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
 170 constructor TTntNewFormCreator.Create(const UnitName, AncestorName: WideString);
 171 begin
 172   inherited Create;
 173   FUnitName := UnitName;
 174   FAncestorName := AncestorName;
 175 end;
 176
 177 procedure TTntNewFormCreator.FormCreated(const FormEditor: IOTAFormEditor);
 178 begin
 179 end;
 180
 181 function TTntNewFormCreator.GetAncestorName: AnsiString;
 182 begin
 183   Result := FAncestorName;
 184 end;
 185
 186 function TTntNewFormCreator.GetCreatorType: AnsiString;
 187 begin
 188   Result := sForm;
 189 end;
 190
 191 function TTntNewFormCreator.GetExisting: Boolean;
 192 begin
 193   Result := False;
 194 end;
 195
 196 function TTntNewFormCreator.GetFileSystem: AnsiString;
 197 begin
 198   Result := '';
 199 end;
 200
 201 function TTntNewFormCreator.GetFormName: AnsiString;
 202 begin
 203   Result := '';
 204 end;
 205
 206 function TTntNewFormCreator.GetImplFileName: AnsiString;
 207 begin
 208   Result := '';
 209 end;
 210
 211 function TTntNewFormCreator.GetIntfFileName: AnsiString;
 212 begin
 213   Result := '';
 214 end;
 215
 216 function TTntNewFormCreator.GetMainForm: Boolean;
 217 begin
 218   Result := False;
 219 end;
 220
 221 function TTntNewFormCreator.GetOwner: IOTAModule;
 222 begin
 223   Result := MyGetActiveProject;
 224 end;
 225
 226 function TTntNewFormCreator.GetShowForm: Boolean;
 227 begin
 228   Result := True;
 229 end;
 230
 231 function TTntNewFormCreator.GetShowSource: Boolean;
 232 begin
 233   Result := True;
 234 end;
 235
 236 function TTntNewFormCreator.GetUnnamed: Boolean;
 237 begin
 238   Result := True;
 239 end;
 240
 241 function TTntNewFormCreator.NewFormFile(const FormIdent, AncestorIdent: AnsiString): IOTAFile;
 242 begin
 243   Result := nil;
 244 end;
 245
 246 function TTntNewFormCreator.NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
 247 const
 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.';
 273 begin
 274   Result := TTntSourceFile.Create(Format{TNT-ALLOW Format}(cSource,
 275     [ModuleIdent, FUnitName, FormIdent, AncestorIdent, FormIdent, FormIdent]));
 276 end;
 277
 278 function TTntNewFormCreator.NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
 279 begin
 280   Result := nil;
 281 end;
 282
 283 { TTntNewFormWizard }
 284
 285 function TTntNewFormWizard.ThisFormName: WideString;
 286 begin
 287   Result := ThisFormClass.ClassName;
 288   Delete(Result, 1, 1); // drop the 'T'
 289 end;
 290
 291 function TTntNewFormWizard.ThisFormUnit: WideString;
 292 begin
 293   Result := GetTypeData(ThisFormClass.ClassInfo).UnitName;
 294 end;
 295
 296 function TTntNewFormWizard.GetName: AnsiString;
 297 begin
 298   Result := ThisFormName;
 299 end;
 300
 301 function TTntNewFormWizard.GetAuthor: AnsiString;
 302 begin
 303   Result := 'Troy Wolbrink';
 304 end;
 305
 306 function TTntNewFormWizard.GetPage: AnsiString;
 307 begin
 308   Result := 'New';
 309 end;
 310
 311 function TTntNewFormWizard.GetGlyph: HICON;
 312 begin
 313   Result := 0;
 314 end;
 315
 316 function TTntNewFormWizard.GetState: TWizardState;
 317 begin
 318   Result := [wsEnabled];
 319 end;
 320
 321 function TTntNewFormWizard.GetIDString: AnsiString;
 322 begin
 323   Result := 'Tnt.Create_'+ThisFormName+'.Wizard';
 324 end;
 325
 326 procedure TTntNewFormWizard.Execute;
 327 var
 328   Module: IOTAModule;
 329 begin
 330   Module := (BorlandIDEServices as IOTAModuleServices).CreateModule(TTntNewFormCreator.Create(ThisFormUnit, ThisFormName));
 331 end;
 332
 333 {$IFDEF COMPILER_6_UP}
 334 function TTntNewFormWizard.GetDesigner: AnsiString;
 335 begin
 336   Result := dVCL;
 337 end;
 338 {$ENDIF}
 339
 340 {$IFDEF COMPILER_9_UP}
 341 function TTntNewFormWizard.GetGalleryCategory: IOTAGalleryCategory;
 342 var
 343   Manager: IOTAGalleryCategoryManager;
 344 begin
 345   Result := nil;
 346   Manager := BorlandIDEServices as IOTAGalleryCategoryManager;
 347   if Assigned(Manager) then
 348     Result := Manager.FindCategory(sCategoryDelphiNew);
 349 end;
 350
 351 function TTntNewFormWizard.GetPersonality: AnsiString;
 352 begin
 353   Result := sDelphiPersonality;
 354 end;
 355 {$ENDIF}
 356
 357 { TTntSourceFile }
 358
 359 constructor TTntSourceFile.Create(const Source: AnsiString);
 360 begin
 361   FSource := Source;
 362 end;
 363
 364 function TTntSourceFile.GetAge: TDateTime;
 365 begin
 366   Result := -1;
 367 end;
 368
 369 function TTntSourceFile.GetSource: AnsiString;
 370 begin
 371   Result := FSource;
 372 end;
 373
 374 { TTntNewTntFormWizard }
 375
 376 function TTntNewTntFormWizard.ThisFormClass: TComponentClass;
 377 begin
 378   Result := TTntForm;
 379 end;
 380
 381 function TTntNewTntFormWizard.GetName: AnsiString;
 382 begin
 383   Result := ThisFormName + ' (Unicode)'
 384 end;
 385
 386 function TTntNewTntFormWizard.GetComment: AnsiString;
 387 begin
 388   Result := 'Creates a new Unicode enabled TntForm';
 389 end;
 390
 391 { TTntNewTntFrameWizard }
 392
 393 function TTntNewTntFrameWizard.ThisFormClass: TComponentClass;
 394 begin
 395   Result := TTntFrame;
 396 end;
 397
 398 function TTntNewTntFrameWizard.GetName: AnsiString;
 399 begin
 400   Result := ThisFormName + ' (Unicode)'
 401 end;
 402
 403 function TTntNewTntFrameWizard.GetComment: AnsiString;
 404 begin
 405   Result := 'Creates a new Unicode enabled TntFrame';
 406 end;
 407
 408 { TTntFrameCustomModule }
 409
 410 function TTntFrameCustomModule.Nestable: Boolean;
 411 begin
 412   Result := True;
 413 end;
 414
 415 { TTntFormCustomModule }
 416
 417 class function TTntFormCustomModule.DesignClass: TComponentClass;
 418 begin
 419   Result := TTntForm;
 420 end;
 421
 422 end.