home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / DSAMsgReg.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-27  |  10KB  |  332 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. unit DSAMsgReg;
  4.  
  5. {$IFNDEF DFS_WIN32}
  6.   Error!  This unit is only available for Win32.
  7. {$ENDIF}
  8.  
  9. {$IFNDEF DFS_COMPILER_3_UP}
  10.   Error! This unit is not used by Delphi 2 or C++Builder 1.  Do not install it!
  11. {$ENDIF}
  12.  
  13. interface
  14.  
  15. uses
  16.   ExptIntf, EditIntf, Windows, SysUtils, StdCtrls, DSAMsg, DFSAbout, Consts;
  17.  
  18. const
  19.   { This is the name of the page in the Object Repository (File | New) that the
  20.     form expert will be created on.  I chose DFS (for Delphi Free Stuff) so
  21.     that it remained seperate from the standard items in the repository.
  22.     However, you may find it more convenient to change this string to 'Forms'
  23.     so that it shows up with all the other new types of forms you have in the
  24.     repository. }
  25.   // The page name for the DSA Form Wizard
  26.   sDSAFormObjRepositoryPage = 'DFS';
  27.  
  28. type
  29.   {: Registers the class for use in the IDE of Delphi 3, 4, and C++Builder.
  30.      Previous versions of Delphi and C++Builder 1.0 do <B>NOT</>
  31.      support design-time access of TForm descendants.  Sorry.  Unlike a normal
  32.      component, TForm descendant classes must have an expert that creates the
  33.      custom form instance for the process to work. }
  34.   { The IDE expert that allows the class to work at design-time in the IDE }
  35.   TdfsDSAFormExpert = class(TIExpert)
  36.   public
  37.     function GetStyle: TExpertStyle; override;
  38.     function GetName: string; override;
  39.     function GetAuthor: string; override;
  40.     function GetComment: string; override;
  41.     function GetPage: string; override;
  42.     function GetGlyph: HICON; override;
  43.     function GetState: TExpertState; override;
  44.     function GetIDString: string; override;
  45.     function GetMenuText: string; override;
  46.     procedure Execute; override;
  47.   end;
  48.  
  49.   procedure Register;
  50.  
  51. implementation
  52.  
  53. uses
  54.   {$IFDEF DFS_NO_DSGNINTF}
  55.   DesignIntf,
  56.   DesignEditors,
  57.   {$ELSE}
  58.   DsgnIntf,
  59.   {$ENDIF}
  60.   ToolIntf, TypInfo;
  61.  
  62. const
  63.   CRLF = #13#10;
  64.  
  65. procedure Register;
  66. begin
  67.   RegisterCustomModule(TdfsDSAForm, TCustomModule);
  68.   RegisterLibraryExpert(TdfsDSAFormExpert.Create);
  69.   RegisterPropertyEditor(TypeInfo(string), TdfsDSAForm, 'Version',
  70.      TDFSVersionProperty);
  71. end;
  72.  
  73.  
  74. type
  75.   {$IFDEF DFS_DELPHI_3}
  76.   TdfsDSAFormModuleCreator = class(TIModuleCreator)
  77.   {$ELSE}
  78.   TdfsDSAFormModuleCreator = class(TIModuleCreatorEx)
  79.   {$ENDIF}
  80.   private
  81.     FAncestorIdent: string;
  82.     FAncestorClass: TClass;
  83.     FFormIdent: string;
  84.     FUnitIdent: string;
  85.     FFileName: string;
  86.   public
  87.     function Existing: boolean; override;
  88.     function GetFileName: string; override;
  89.     function GetFileSystem: string; override;
  90.     function GetFormName: string; override;
  91.     function GetAncestorName: string; override;
  92.     function NewModuleSource({$IFNDEF DFS_DELPHI_3} const {$ENDIF} UnitIdent,
  93.        FormIdent, AncestorIdent: string): string; override;
  94.     {$IFNDEF DFS_DELPHI_3}
  95.     function GetIntfName: string; override;
  96.     function NewIntfSource(const UnitIdent, FormIdent,
  97.        AncestorIdent: string): string; override;
  98.     {$ENDIF}
  99.     procedure FormCreated(Form: TIFormInterface); override;
  100.   end;
  101.  
  102.  
  103. { TdfsDSAFormModuleCreator }
  104.  
  105. function TdfsDSAFormModuleCreator.Existing: boolean;
  106. begin
  107.   Result := FALSE;
  108. end;
  109.  
  110. function TdfsDSAFormModuleCreator.GetFileName: string;
  111. begin
  112.   Result := '';
  113. end;
  114.  
  115. function TdfsDSAFormModuleCreator.GetFileSystem: string;
  116. begin
  117.   Result := '';
  118. end;
  119.  
  120. function TdfsDSAFormModuleCreator.GetFormName: string;
  121. begin
  122.   Result := FFormIdent;
  123. end;
  124.  
  125. function TdfsDSAFormModuleCreator.GetAncestorName: string;
  126. begin
  127.   Result := FAncestorIdent;
  128. end;
  129.  
  130. {$IFDEF DFS_CPPB}
  131.  
  132. function UnitName2NameSpace(const Value: string): string;
  133. var
  134.   s1, s2: string;
  135. begin
  136.   Result := '';
  137.   if Value <> '' then
  138.   begin
  139.     s1 := Value[1];
  140.     s2 := LowerCase(Value);
  141.     System.Delete(s2, 1, 1);
  142.     Result := UpperCase(s1)+s2;
  143.   end;
  144. end;
  145.  
  146. {$ENDIF}
  147.  
  148. function GetCustomFormUnit(const AClass: TClass): string;
  149. begin
  150.   Result := GetTypeData(PTypeInfo(AClass.ClassInfo))^.UnitName;
  151. end;
  152.  
  153. {$IFNDEF DFS_DELPHI_3}
  154.  
  155. function TdfsDSAFormModuleCreator.GetIntfName: string;
  156. begin
  157.   Result := '';
  158. end;
  159.  
  160. const
  161.   COMMENT_LINE = '//---------------------------------------------------------------------------' + CRLF;
  162.  
  163. function TdfsDSAFormModuleCreator.NewIntfSource(const UnitIdent, FormIdent,
  164.    AncestorIdent: string): string;
  165. begin
  166.   {$IFDEF DFS_CPPB}
  167.   Result := COMMENT_LINE +
  168.      '#ifndef ' + UnitIdent + 'H' + CRLF +
  169.      '#define ' + UnitIdent + 'H' + CRLF +
  170.      COMMENT_LINE +
  171.      '#include <Classes.hpp>' + CRLF +
  172.      '#include <Controls.hpp>' + CRLF +
  173.      '#include <StdCtrls.hpp>' + CRLF +
  174.      '#include <Forms.hpp>' + CRLF ;
  175.  
  176.   if (AncestorIdent <> 'Form') and (FAncestorIdent <> 'DataModule') then
  177.     Result := Result + '#include "' +
  178.        GetCustomFormUnit(FAncestorClass) + '.hpp"' + CRLF;
  179.  
  180.   Result := Result + COMMENT_LINE +
  181.      'class T' + FormIdent + ' : public ' + FAncestorClass.ClassName + CRLF +
  182.      '{' + CRLF +
  183.       '__published: // IDE-managed Components' + CRLF +
  184.       'private: // User declarations' + CRLF +
  185.       'protected: // User declarations' + CRLF +
  186.       'public: // User declarations' + CRLF +
  187.       '  __fastcall T' + FormIdent + '(TComponent* Owner);' + CRLF +
  188.       '__published: // User declarations' + CRLF +
  189.       '};' + CRLF + COMMENT_LINE +
  190.       'extern PACKAGE T'+FormIdent+' *'+FormIdent+';' + CRLF + COMMENT_LINE +
  191.       '#endif';
  192.   {$ELSE}
  193.   Result := ''; // Delphi doesn't use this
  194.   {$ENDIF}
  195. end;
  196.  
  197. {$ENDIF}
  198.  
  199. function TdfsDSAFormModuleCreator.NewModuleSource(
  200.    {$IFNDEF DFS_DELPHI_3} const {$ENDIF} UnitIdent, FormIdent,
  201.    AncestorIdent: string): string;
  202. begin
  203.   {$IFDEF DFS_CPPB}
  204.   Result := COMMENT_LINE + '#include <vcl.h>' + CRLF +
  205.      '#pragma hdrstop' + CRLF + CRLF +
  206.      '#include "' + UnitIdent + '.h"' + CRLF + COMMENT_LINE +
  207.      '#pragma package(smart_init)' + CRLF;
  208.  
  209.   if (FAncestorIdent <> 'Form') and (FAncestorIdent <> 'DataModule') then
  210.     Result := Result + '#pragma link "' +
  211.        GetCustomFormUnit(FAncestorClass) + '"' + CRLF;
  212.  
  213.   Result := Result + '#pragma resource "*.dfm"' + CRLF +
  214.      'T' + FormIdent + ' *' + FormIdent+';' + CRLF + COMMENT_LINE +
  215.      '__fastcall T' + FormIdent + '::T' + FormIdent + '(TComponent* Owner)' + CRLF +
  216.      '        : ' + FAncestorClass.ClassName + '(Owner)' + CRLF +
  217.      '{' + CRLF +
  218.      '}' + CRLF + COMMENT_LINE;
  219.   {$ELSE}
  220.   Result := 'unit ' + FUnitIdent + ';' + CRLF + CRLF +
  221.      'interface' + CRLF + CRLF +
  222.      'uses' + CRLF +
  223.      '  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs';
  224.  
  225.   if (FAncestorIdent <> 'Form') and (FAncestorIdent <> 'DataModule') then
  226.     Result := Result + ',' + CRLF +
  227.        '  ' + GetCustomFormUnit(FAncestorClass);
  228.  
  229.   Result := Result + ';' + CRLF + CRLF +
  230.      'type' + CRLF +
  231.      '  T' + FFormIdent + ' = class(' + FAncestorClass.ClassName + ')' + CRLF +
  232.      '  private' + CRLF +
  233.      '    { Private declarations }' + CRLF +
  234.      '  protected' + CRLF +
  235.      '    { Protected declarations }' + CRLF +
  236.      '  public' + CRLF +
  237.      '    { Public declarations }' + CRLF +
  238.      '  published' + CRLF +
  239.      '    { Published declarations }' + CRLF +
  240.      '  end;' + CRLF + CRLF +
  241.      'var' + CRLF +
  242.      '  ' + FFormIdent + ' : T' + FFormIdent + ';' + CRLF + CRLF +
  243.      'implementation' + CRLF + CRLF +
  244.      '{$R *.DFM}' + CRLF + CRLF +
  245.      'end.' + CRLF;
  246.   {$ENDIF}
  247. end;
  248.  
  249. procedure TdfsDSAFormModuleCreator.FormCreated(Form: TIFormInterface);
  250. begin
  251.   // do nothing
  252. end;
  253.  
  254. { TdfsDSAFormExpert }
  255.  
  256. function TdfsDSAFormExpert.GetStyle: TExpertStyle;
  257. begin
  258.   // Make it show up in the object repository (File | New)
  259.   Result := esForm;
  260. end;
  261.  
  262. function TdfsDSAFormExpert.GetName: String;
  263. begin
  264.   // official name
  265.   Result := 'DSA Form'
  266. end;
  267.  
  268. function TdfsDSAFormExpert.GetAuthor: string;
  269. begin
  270.   Result := 'Bradley D. Stowers';
  271. end;
  272.  
  273. function TdfsDSAFormExpert.GetComment: String;
  274. begin
  275.   Result := 'Create a new DSA form in current project';
  276. end;
  277.  
  278. function TdfsDSAFormExpert.GetPage: string;
  279. begin
  280.   Result := sDSAFormObjRepositoryPage;
  281. end;
  282.  
  283. function TdfsDSAFormExpert.GetGlyph: HICON;
  284. begin
  285.   Result := LoadIcon(hInstance, 'TdfsDSAForm');
  286. end;
  287.  
  288. function TdfsDSAFormExpert.GetState: TExpertState;
  289. begin
  290.   // not used in a esForm expert
  291.   Result := [esEnabled];
  292. end;
  293.  
  294. function TdfsDSAFormExpert.GetIDString: String;
  295. begin
  296.   // must be unique
  297.   Result := 'DelphiFreeStuff.TdfsDSAFormWizard';
  298. end;
  299.  
  300. function TdfsDSAFormExpert.GetMenuText: string;
  301. begin
  302.   Result := ''; // not used for esForm, just here to shut up the compiler warning.
  303. end;
  304.  
  305. procedure TdfsDSAFormExpert.Execute;
  306. var
  307.   IModuleCreator : TdfsDSAFormModuleCreator;
  308.   IModule : TIModuleInterface;
  309. begin
  310.   IModuleCreator := TdfsDSAFormModuleCreator.Create;
  311.   try
  312.     IModuleCreator.FAncestorIdent := 'dfsDSAForm'; // Don't include the 'T'!!!!
  313.     IModuleCreator.FAncestorClass := TdfsDSAForm;
  314.     ToolServices.GetNewModuleAndClassName(IModuleCreator.FAncestorIdent,
  315.     IModuleCreator.FUnitIdent,IModuleCreator.FFormIdent,IModuleCreator.FFileName);
  316.     {$IFDEF DFS_DELPHI_3}
  317.     IModule := ToolServices.ModuleCreate(IModuleCreator, [cmShowSource,
  318.        cmShowForm, cmMarkModified, cmAddToProject, cmUnNamed]);
  319.     {$ELSE}
  320.     IModule:=ToolServices.ModuleCreateEx(IModuleCreator, [cmShowSource,
  321.        cmShowForm, cmMarkModified, cmAddToProject, cmUnNamed]);
  322.     {$ENDIF}
  323.     IModule.Free;
  324.   finally
  325.     IModuleCreator.Free;
  326.   end;
  327. end;
  328.        
  329.  
  330. end.
  331.  
  332.