home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / GradFormReg.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-27  |  15KB  |  502 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. unit GradFormReg;
  4.  
  5. {$IFNDEF DFS_WIN32}
  6.   Error!  This unit is only available for Win32.
  7. {$ENDIF}
  8.  
  9. interface
  10.  
  11. uses
  12.   {$IFDEF DFS_COMPILER_3_UP} ExptIntf, EditIntf, {$ENDIF}
  13.   Windows, SysUtils, StdCtrls, GradForm, DFSAbout, Consts;
  14.  
  15. const
  16.   { This is the name of the page in the Object Repository (File | New) that the
  17.     form expert will be created on.  I chose DFS (for Delphi Free Stuff) so
  18.     that it remained seperate from the standard items in the repository.
  19.     However, you may find it more convenient to change this string to 'Forms'
  20.     so that it shows up with all the other new types of forms you have in the
  21.     repository. }
  22.   // The page name for the Gradient Form Wizard
  23.   sGradFormObjRepositoryPage = 'DFS';
  24.   // The page name for the Gradient Form Project wizard
  25.   sGradFormProjObjRepositoryPage = 'DFS';
  26.  
  27. type
  28.  
  29. {$IFDEF DFS_COMPILER_3_UP}
  30.   {: Registers the class for use in the IDE of Delphi 3, 4, and C++Builder.
  31.      Previous versions of Delphi and C++Builder 1.0 do <B>NOT</>
  32.      support design-time access of TForm descendants.  Sorry.  Unlike a normal
  33.      component, TForm descendant classes must have an expert that creates the
  34.      custom form instance for the process to work. }
  35.   { The IDE expert that allows the class to work at design-time in the IDE }
  36.   TdfsGradientFormExpert = class(TIExpert)
  37.   public
  38.     function GetStyle: TExpertStyle; override;
  39.     function GetName: string; override;
  40.     function GetAuthor: string; override;
  41.     function GetComment: string; override;
  42.     function GetPage: string; override;
  43.     function GetGlyph: HICON; override;
  44.     function GetState: TExpertState; override;
  45.     function GetIDString: string; override;
  46.     function GetMenuText: string; override;
  47.     procedure Execute; override;
  48.   end;
  49.  
  50. {$IFDEF DFS_DELPHI_3_UP}
  51.   { Generating a project file for C++Builder is more work than I want to
  52.     even try.  If somone has a go at this, let me know. }
  53.   TdfsGradientFormProjectExpert = class(TIExpert)
  54.   public
  55.     function GetStyle: TExpertStyle; override;
  56.     function GetName: string; override;
  57.     function GetAuthor: string; override;
  58.     function GetComment: string; override;
  59.     function GetPage: string; override;
  60.     function GetGlyph: HICON; override;
  61.     function GetState: TExpertState; override;
  62.     function GetIDString: string; override;
  63.     function GetMenuText: string; override;
  64.     procedure Execute; override;
  65.   end;
  66.  
  67.   TdfsGradientFormProjectCreator = class(TIProjectCreator)
  68.   public
  69.     function Existing: boolean; override;
  70.     function GetFileName: string; override;
  71.     function GetFileSystem: string; override;
  72.     function NewProjectSource(const ProjectName: string): string; override;
  73.     procedure NewDefaultModule; override;
  74.     procedure NewProjectResource(Module: TIModuleInterface); override;
  75.   end;
  76. {$ENDIF}
  77.  
  78.   procedure Register;
  79. {$ENDIF}
  80.  
  81.  
  82. implementation
  83.  
  84. {$IFDEF DFS_COMPILER_3_UP}
  85. uses
  86.   {$IFDEF DFS_NO_DSGNINTF}
  87.   DesignIntf,
  88.   DesignEditors,
  89.   {$ELSE}
  90.   DsgnIntf,
  91.   {$ENDIF}
  92.   ToolIntf, TypInfo;
  93.  
  94.  
  95. const
  96.   CRLF = #13#10;
  97.  
  98.  
  99. procedure Register;
  100. begin
  101.   RegisterCustomModule(TdfsGradientForm, TCustomModule);
  102.   RegisterLibraryExpert(TdfsGradientFormExpert.Create);
  103. {$IFDEF DFS_DELPHI_3_UP}
  104.   RegisterLibraryExpert(TdfsGradientFormProjectExpert.Create);
  105. {$ENDIF}  
  106.   RegisterPropertyEditor(TypeInfo(string), TdfsGradientForm, 'Version',
  107.      TDFSVersionProperty);
  108. end;
  109. {$ENDIF}
  110.  
  111.  
  112.  
  113. {$IFDEF DFS_COMPILER_3_UP}
  114.  
  115. type
  116.   {$IFDEF DFS_DELPHI_3}
  117.   TdfsGradientFormModuleCreator = class(TIModuleCreator)
  118.   {$ELSE}
  119.   TdfsGradientFormModuleCreator = class(TIModuleCreatorEx)
  120.   {$ENDIF}
  121.   private
  122.     FAncestorIdent: string;
  123.     FAncestorClass: TClass;
  124.     FFormIdent: string;
  125.     FUnitIdent: string;
  126.     FFileName: string;
  127.   public
  128.     function Existing: boolean; override;
  129.     function GetFileName: string; override;
  130.     function GetFileSystem: string; override;
  131.     function GetFormName: string; override;
  132.     function GetAncestorName: string; override;
  133.     function NewModuleSource({$IFNDEF DFS_DELPHI_3} const {$ENDIF} UnitIdent,
  134.        FormIdent, AncestorIdent: string): string; override;
  135.     {$IFNDEF DFS_DELPHI_3}
  136.     function GetIntfName: string; override;
  137.     function NewIntfSource(const UnitIdent, FormIdent,
  138.        AncestorIdent: string): string; override;
  139.     {$ENDIF}
  140.     procedure FormCreated(Form: TIFormInterface); override;
  141.   end;
  142.  
  143.  
  144. { TdfsGradientFormModuleCreator }
  145.  
  146. function TdfsGradientFormModuleCreator.Existing: boolean;
  147. begin
  148.   Result := FALSE;
  149. end;
  150.  
  151. function TdfsGradientFormModuleCreator.GetFileName: string;
  152. begin
  153.   Result := '';
  154. end;
  155.  
  156. function TdfsGradientFormModuleCreator.GetFileSystem: string;
  157. begin
  158.   Result := '';
  159. end;
  160.  
  161. function TdfsGradientFormModuleCreator.GetFormName: string;
  162. begin
  163.   Result := FFormIdent;
  164. end;
  165.  
  166. function TdfsGradientFormModuleCreator.GetAncestorName: string;
  167. begin
  168.   Result := FAncestorIdent;
  169. end;
  170.  
  171. {$IFDEF DFS_CPPB}
  172.  
  173. function UnitName2NameSpace(const Value: string): string;
  174. var
  175.   s1, s2: string;
  176. begin
  177.   Result := '';
  178.   if Value <> '' then
  179.   begin
  180.     s1 := Value[1];
  181.     s2 := LowerCase(Value);
  182.     System.Delete(s2, 1, 1);
  183.     Result := UpperCase(s1)+s2;
  184.   end;
  185. end;
  186.  
  187. {$ENDIF}
  188.  
  189. function GetCustomFormUnit(const AClass: TClass): string;
  190. begin
  191.   Result := GetTypeData(PTypeInfo(AClass.ClassInfo))^.UnitName;
  192. end;
  193.  
  194. {$IFNDEF DFS_DELPHI_3}
  195.  
  196. function TdfsGradientFormModuleCreator.GetIntfName: string;
  197. begin
  198.   Result := '';
  199. end;
  200.  
  201. const
  202.   COMMENT_LINE = '//---------------------------------------------------------------------------' + CRLF;
  203.  
  204. function TdfsGradientFormModuleCreator.NewIntfSource(const UnitIdent, FormIdent,
  205.    AncestorIdent: string): string;
  206. begin
  207.   {$IFDEF DFS_CPPB}
  208.   Result := COMMENT_LINE +
  209.      '#ifndef ' + UnitIdent + 'H' + CRLF +
  210.      '#define ' + UnitIdent + 'H' + CRLF +
  211.      COMMENT_LINE +
  212.      '#include <Classes.hpp>' + CRLF +
  213.      '#include <Controls.hpp>' + CRLF +
  214.      '#include <StdCtrls.hpp>' + CRLF +
  215.      '#include <Forms.hpp>' + CRLF ;
  216.  
  217.   if (AncestorIdent <> 'Form') and (FAncestorIdent <> 'DataModule') then
  218.     Result := Result + '#include "' +
  219.        GetCustomFormUnit(FAncestorClass) + '.hpp"' + CRLF;
  220.  
  221.   Result := Result + COMMENT_LINE +
  222.      'class T' + FormIdent + ' : public ' + FAncestorClass.ClassName + CRLF +
  223.      '{' + CRLF +
  224.       '__published: // IDE-managed Components' + CRLF +
  225.       'private: // User declarations' + CRLF +
  226.       'protected: // User declarations' + CRLF +
  227.       'public: // User declarations' + CRLF +
  228.       '  __fastcall T' + FormIdent + '(TComponent* Owner);' + CRLF +
  229.       '__published: // User declarations' + CRLF +
  230.       '};' + CRLF + COMMENT_LINE +
  231.       'extern PACKAGE T'+FormIdent+' *'+FormIdent+';' + CRLF + COMMENT_LINE +
  232.       '#endif';
  233.   {$ELSE}
  234.   Result := ''; // Delphi doesn't use this
  235.   {$ENDIF}
  236. end;
  237.  
  238. {$ENDIF}
  239.  
  240. function TdfsGradientFormModuleCreator.NewModuleSource(
  241.    {$IFNDEF DFS_DELPHI_3} const {$ENDIF} UnitIdent, FormIdent,
  242.    AncestorIdent: string): string;
  243. begin
  244.   {$IFDEF DFS_CPPB}
  245.   Result := COMMENT_LINE + '#include <vcl.h>' + CRLF +
  246.      '#pragma hdrstop' + CRLF + CRLF +
  247.      '#include "' + UnitIdent + '.h"' + CRLF + COMMENT_LINE +
  248.      '#pragma package(smart_init)' + CRLF;
  249.  
  250.   if (FAncestorIdent <> 'Form') and (FAncestorIdent <> 'DataModule') then
  251.     Result := Result + '#pragma link "' +
  252.        GetCustomFormUnit(FAncestorClass) + '"' + CRLF;
  253.  
  254.   Result := Result + '#pragma resource "*.dfm"' + CRLF +
  255.      'T' + FormIdent + ' *' + FormIdent+';' + CRLF + COMMENT_LINE +
  256.      '__fastcall T' + FormIdent + '::T' + FormIdent + '(TComponent* Owner)' + CRLF +
  257.      '        : ' + FAncestorClass.ClassName + '(Owner)' + CRLF +
  258.      '{' + CRLF +
  259.      '}' + CRLF + COMMENT_LINE;
  260.   {$ELSE}
  261.   Result := 'unit ' + FUnitIdent + ';' + CRLF + CRLF +
  262.      'interface' + CRLF + CRLF +
  263.      'uses' + CRLF +
  264.      '  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs';
  265.  
  266.   if (FAncestorIdent <> 'Form') and (FAncestorIdent <> 'DataModule') then
  267.     Result := Result + ',' + CRLF +
  268.        '  ' + GetCustomFormUnit(FAncestorClass);
  269.  
  270.   Result := Result + ';' + CRLF + CRLF +
  271.      'type' + CRLF +
  272.      '  T' + FFormIdent + ' = class(' + FAncestorClass.ClassName + ')' + CRLF +
  273.      '  private' + CRLF +
  274.      '    { Private declarations }' + CRLF +
  275.      '  protected' + CRLF +
  276.      '    { Protected declarations }' + CRLF +
  277.      '  public' + CRLF +
  278.      '    { Public declarations }' + CRLF + 
  279.      '  published' + CRLF + 
  280.      '    { Published declarations }' + CRLF +
  281.      '  end;' + CRLF + CRLF +
  282.      'var' + CRLF +
  283.      '  ' + FFormIdent + ' : T' + FFormIdent + ';' + CRLF + CRLF +
  284.      'implementation' + CRLF + CRLF +
  285.      '{$R *.DFM}' + CRLF + CRLF +
  286.      'end.' + CRLF;
  287.   {$ENDIF}
  288. end;
  289.  
  290. procedure TdfsGradientFormModuleCreator.FormCreated(Form: TIFormInterface);
  291. begin
  292.   // do nothing
  293. end;
  294.  
  295. { TdfsGradientFormExpert }
  296.  
  297. function TdfsGradientFormExpert.GetStyle: TExpertStyle;
  298. begin
  299.   // Make it show up in the object repository (File | New)
  300.   Result := esForm;
  301. end;
  302.  
  303. function TdfsGradientFormExpert.GetName: String;
  304. begin
  305.   // official name
  306.   Result := 'Gradient Form'
  307. end;
  308.  
  309. function TdfsGradientFormExpert.GetAuthor: string;
  310. begin
  311.   Result := 'Bradley D. Stowers';
  312. end;
  313.  
  314. function TdfsGradientFormExpert.GetComment: String;
  315. begin
  316.   Result := 'Create a new gradient form in current project';
  317. end;
  318.  
  319. function TdfsGradientFormExpert.GetPage: string;
  320. begin
  321.   Result := sGradFormObjRepositoryPage;
  322. end;
  323.  
  324. function TdfsGradientFormExpert.GetGlyph: HICON;
  325. begin
  326.   Result := LoadIcon(hInstance, 'TdfsGradientForm');
  327. end;
  328.  
  329. function TdfsGradientFormExpert.GetState: TExpertState;
  330. begin
  331.   // not used in a esForm expert
  332.   Result := [esEnabled];
  333. end;
  334.  
  335. function TdfsGradientFormExpert.GetIDString: String;
  336. begin
  337.   // must be unique
  338.   Result := 'DelphiFreeStuff.TdfsGradientFormWizard';
  339. end;
  340.  
  341. function TdfsGradientFormExpert.GetMenuText: string;
  342. begin
  343.   Result := ''; // not used for esForm, just here to shut up the compiler warning.
  344. end;
  345.  
  346. procedure TdfsGradientFormExpert.Execute;
  347. var
  348.   IModuleCreator : TdfsGradientFormModuleCreator;
  349.   IModule : TIModuleInterface;
  350. begin
  351.   IModuleCreator := TdfsGradientFormModuleCreator.Create;
  352.   try
  353.     IModuleCreator.FAncestorIdent := 'dfsGradientForm'; // Don't include the 'T'!!!!
  354.     IModuleCreator.FAncestorClass := TdfsGradientForm;
  355.     ToolServices.GetNewModuleAndClassName(IModuleCreator.FAncestorIdent,
  356.     IModuleCreator.FUnitIdent,IModuleCreator.FFormIdent,IModuleCreator.FFileName);
  357.     {$IFDEF DFS_DELPHI_3}
  358.     IModule := ToolServices.ModuleCreate(IModuleCreator, [cmShowSource,
  359.        cmShowForm, cmMarkModified, cmAddToProject, cmUnNamed]);
  360.     {$ELSE}
  361.     IModule:=ToolServices.ModuleCreateEx(IModuleCreator, [cmShowSource,
  362.        cmShowForm, cmMarkModified, cmAddToProject, cmUnNamed]);
  363.     {$ENDIF}
  364.     IModule.Free;
  365.   finally
  366.     IModuleCreator.Free;
  367.   end;
  368. end;
  369.  
  370.  
  371. {$IFDEF DFS_DELPHI_3_UP}
  372.  
  373. { TdfsGradientFormProjectExpert }
  374.  
  375. function TdfsGradientFormProjectExpert.GetStyle: TExpertStyle;
  376. begin
  377.   // Make it show up in the object repository (File | New)
  378.   Result := esProject;
  379. end;
  380.  
  381. function TdfsGradientFormProjectExpert.GetName: String;
  382. begin
  383.   // official name
  384.   Result := 'Gradient Form Application'
  385. end;
  386.  
  387. function TdfsGradientFormProjectExpert.GetAuthor: string;
  388. begin
  389.   Result := 'Bradley D. Stowers';
  390. end;
  391.  
  392. function TdfsGradientFormProjectExpert.GetComment: String;
  393. begin
  394.   Result := 'New project with gradient form as main form';
  395. end;
  396.  
  397. function TdfsGradientFormProjectExpert.GetPage: string;
  398. begin
  399.   Result := sGradFormProjObjRepositoryPage;
  400. end;
  401.  
  402. function TdfsGradientFormProjectExpert.GetGlyph: HICON;
  403. begin
  404.   Result := LoadIcon(hInstance, 'TdfsGradientForm');
  405. end;
  406.  
  407. function TdfsGradientFormProjectExpert.GetState: TExpertState;
  408. begin
  409.   // not used in a esForm expert
  410.   Result := [esEnabled];
  411. end;
  412.  
  413. function TdfsGradientFormProjectExpert.GetIDString: String;
  414. begin
  415.   // must be unique
  416.   Result := 'DelphiFreeStuff.TdfsGradientFormProjectWizard';
  417. end;
  418.  
  419. function TdfsGradientFormProjectExpert.GetMenuText: string;
  420. begin
  421.   Result := ''; // not used for esForm, just here to shut up the compiler warning.
  422. end;
  423.  
  424. procedure TdfsGradientFormProjectExpert.Execute;
  425. var
  426.   ModIntf: TIModuleInterface;
  427.   ProjCreator: TdfsGradientFormProjectCreator;
  428. begin
  429.   ProjCreator := TdfsGradientFormProjectCreator.Create;
  430.   ModIntf := ToolServices.ProjectCreate(ProjCreator, [cpApplication, cpCanShowSource]);
  431.   ModIntf.Free;
  432.   ProjCreator.Free;
  433. end;
  434.  
  435. { TdfsGradientFormProjectCreator }
  436.  
  437. function TdfsGradientFormProjectCreator.Existing: boolean;
  438. begin
  439.   Result := FALSE;
  440. end;
  441.  
  442. function TdfsGradientFormProjectCreator.GetFileName: string;
  443. begin
  444.   Result := '';
  445. end;
  446.  
  447. function TdfsGradientFormProjectCreator.GetFileSystem: string;
  448. begin
  449.   Result := '';
  450. end;
  451.  
  452. procedure TdfsGradientFormProjectCreator.NewDefaultModule;
  453. var
  454.   IModuleCreator : TdfsGradientFormModuleCreator;
  455.   IModule : TIModuleInterface;
  456. begin
  457.   IModuleCreator := TdfsGradientFormModuleCreator.Create;
  458.   try
  459.     IModuleCreator.FAncestorIdent := 'dfsGradientForm'; // Don't include the 'T'!!!!
  460.     IModuleCreator.FAncestorClass := TdfsGradientForm;
  461.     ToolServices.GetNewModuleAndClassName(IModuleCreator.FAncestorIdent,
  462.     IModuleCreator.FUnitIdent,IModuleCreator.FFormIdent,IModuleCreator.FFileName);
  463.     {$IFDEF DFS_DELPHI_3}
  464.     IModule := ToolServices.ModuleCreate(IModuleCreator, [cmShowSource,
  465.        cmShowForm, cmMainForm, cmMarkModified, cmAddToProject, cmUnNamed]);
  466.     {$ELSE}
  467.     IModule:=ToolServices.ModuleCreateEx(IModuleCreator, [cmShowSource,
  468.        cmShowForm, cmMainForm, cmMarkModified, cmAddToProject, cmUnNamed]);
  469.     {$ENDIF}
  470.     IModule.Free;
  471.   finally
  472.     IModuleCreator.Free;
  473.   end;
  474. end;
  475.  
  476. procedure TdfsGradientFormProjectCreator.NewProjectResource(
  477.   Module: TIModuleInterface);
  478. begin
  479.   Module.Free;
  480. end;
  481.  
  482. function TdfsGradientFormProjectCreator.NewProjectSource(
  483.    const ProjectName: string): string;
  484. begin
  485.   Result := Format('program %s;' + CRLF + CRLF, [ProjectName]) +
  486.      'uses' + CRLF +
  487.      '  Forms;' + CRLF + CRLF +
  488.      '{$R *.RES}' + CRLF + CRLF +
  489.      'begin' + CRLF +
  490.      '  Application.Initialize;' + CRLF +
  491.      '  Application.Run;' + CRLF +
  492.      'end.' + CRLF;
  493. end;
  494.  
  495. {$ENDIF}
  496.  
  497. {$ENDIF}
  498.  
  499.  
  500. end.
  501.  
  502.