Analyze DFM file generation program interface

Its main idea is to analyze the DFM file in a recursive manner, and then generate the class with fluidization technology. The following is the code:

/

Below this unit is the registration component, it can also be increased, and interesters can add themselves.

Unit uclass;

interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Contnrs, ActiveX, ActnList, ADODB, Buttons, Clipbrd, CommCtrl, ComObj, ComServ, DateUtils, DBCtrls, DBGrids, DBTables, ExtCtrls , Grids, IniFiles, Isapi, Isapi2, Mask, Math, Menus, Midas, MMSystem, MPlayer, msxml, OleDB, OpenGL, Printers, Registry, RichEdit, ScktComp, ShellAPI, ShlObj, SvcMgr, SyncObjs, UrlMon, WinInet, WinSock, winSpool ;

Procedure regclass; var classarr: array [0..57] of tpersistentclass;

IMPLEMentation

Procedure Regclass; Begin Classarr [0]: = TANIMATE; Classarr [1]: = Tbutton; Classarr [2]: = Tcheckbox; Classarr [3]: = TColorDialog; Classarr [4]: ​​= Tcombobox; Classarr [5]: = TcomboBoxEx; Classarr [6]: = Tcommoncalendar; Classarr [7]: = Tcommondialog; Classarr [8]: = TCOOLBAND; Classarr [9]: = TCOOLBAR; Classarr [11]: = TcoolBar; Classarr; 4]: = tdatetimePicker; Classarr [12]: = TEDIT; Classarr [13]: = tfinddialog; Classarr [14]: = TFONTDIALOG; Classarr [15]: = TForm; Classarr [16]: = TFRAME; Classarr [17]: = TgroupBox; Classarr [ 18]: = THEADERCONTROL; Classarr [19]: = TIMAGELIST; Classarr [20]: = TLABEL; Classarr [21]: = TListBox; Classarr [22]: = TListItem; Classarr [23]: = TListView; Classarr [24] : = TMEMO; Classarr [25]: = TMONTHCALENDAR; Classarr [26]: = TopEndialog; Classarr [27]: = TPAGECONTROL; Classarr [28]: = tpagescroller; Classarr [29]: = tPrintDialog; Classarr [30]: = TProgressBar; Classarr [31]: = tradiobutton; Classarr [32]: = TreplaceDialog; Classarr [33]: = TRICHED IT; Classarr [34]: = TsaveDialog; Classarr [35]: = Tscrollbar; Classarr [36]: = TscrollBox; Classarr [37]: = TSTATITEXT; Classarr [38]: = TSTATUSBAR; Classarr; 49]: = TSTATUSPANEL; Classarr [40]: = TTABControl; Classarr [41]: = TTABSHEET; Classarr [42]: = ttoolbar; Classarr [43]: = TtoolButton; Classarr [44]: = TTRACKBAR; Classarr [45]: = tTREENODE; Classarr [ 46]: = TtreeView; Classarr [47]: = tupdown; Classarr [48]: = TPANEL; Classarr [49]: = TbitBtn; Classarr [50]: = Tshape; Classarr [51]: = TRAPE; Classarr [51]: = TRAPIOGROUP; Classarr [52] : = TIMAGE;

ClassArr [53]: = TMediaPlayer; ClassArr [54]: = TPaintBox; ClassArr [55]: = TSpeedButton; ClassArr [56]: = TMainMenu; ClassArr [57]: = TMenuItem; RegisterClasses (ClassArr); end; initialization RegClass; Finalization UnregisterClasses (Classarr); End.// This is the unit of the program, not much. Unit unit1;

Interface

Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, Extctrls, Comctrls, Contnts, Uclass;

type TForm1 = class (TForm) OpenDialog1: TOpenDialog; Panel1: TPanel; Panel2: TPanel; Button1: TButton; Button2: TButton; Memo1: TMemo; procedure Button1Click (Sender: TObject); procedure Button2Click (Sender: TObject); procedure FormCreate ( Sender: TOBJECT); Procedure FormDestroy (Sender: Tobject); private {private declarations} Curp: integer; // DFM file current row SS: tstrings; // Save DFM file text format TS: tstrings; // Save DFM file A class of text format of the class L: TList; // Manage all class public {public declassions of the DFM file; // Generate a component class according to the analysis DFM file, where there is recurrent Procedure Correctts (TS : Tstrings); // remove some properties of the component, these attributes are unable to generate Function Strtocom (TS: TSTRINGS): tComponent; // According to component class text generation components Function CheckEvent: boolean; // Check if the event Property Function Iscontrol (COM: TComponent): boolean; // Checks Procedure TestShow (TS: TStrings) inherited from Tcotrol; // Display all class text in Memo1 Procedure Delprop (Ts: Tstrings; Bchar, Echar: char: char ); // remove some specific properties to call the public 20;

Var Form1: TFORM1;

Implementation Uses Typinfo;

{$ R * .dfm} // string into components function TForm1.StrToCom (TS: Tstrings): TComponent; var StrStream: TStringStream; MemStream: TMemoryStream; begin StrStream: = TStringStream.Create (TS.Text); try MemStream : = TMemoryStream.Create (); try Classes.ObjectTextToBinary (strStream, MemStream); MemStream.Seek (0, soFromBeginning); Result: = MemStream.ReadComponent (nil); finally FreeAndNil (MemStream); end; finally FreeAndNil (strStream) END; END; // Open the DFM file and display in MEMO1, the DFM file may be a binary format, / / ​​may be a text format, so it is necessary to make a judgment, and finally open procedure tForm1.button1click in the text format ( Sender: TOBJECT); VAR M: TMEMORYSTREAM; S: TSTRINGSTREAM; F: Array [1..6] of char; temps: string; begin if openDialog1.execute thrrete (''); M: M: = TMemoryStream.create (); Try M.LoadFromFile (OpenDialog1.FileName); M.Position: = 0; M.READ (f, 6); Temps: = f; if Temps = 'Object' Ten // If it is text Format Begin M.Position: = 0; s.Position: = 0; S.copyFrom (m, 0); ELSE Begin // If it is a binary format M.Position: = 16; classes.objectBinaryTotext (m, s); end; s.position: = 0; ss.text: = s.datastring; memo1.line: = ss; finLy S .Free; m.free; end; end; end; // Analyze DFM files, and generate component class procedure tform1.button2click (sender: Tobject); recomgin if l.count> 0 Than Tcomponent (L.Items [0]) .free; l.clear; curp: = 0; getControl (nil); // This uses recursive END;

Procedure TForm1.FormCreate (Sender: Tobject); Begin SS: = TSTRINGLIST.CREATE; TS: = TSTRINGLIST.CREATE; L: = TList.Create;

Procedure TForm1.FormDestroy (Sender: Tobject); Begin FreeAndnil (SS); if L.Count> 0 THEN TComponent (L.Items [0]). Free; Freeandnil (L); FreeAndnil (TS); end; // Generate Component Procedure TFORM1.GETCONTROL (P: TwinControl); Var Con: Tcomponent; Begin While Curp 0) THEN BEGIN INC (CURP); Break; end; ts.clear; ts.add (ss [curp]); inc (curp); while (curp 0 ) OR (POS ('Object', SS [CURP])> 0) THEN BREAK; if Not Checkeevent Then Ts.Add (SS [CURP]); INC (CURP); End; Ts.Add ('end'); Correctts (TS); Con: = StrtOcom (TS); TestShow (TS); if ISControl (con) .Parent: = p; l.add (con); ifcon.classname = 'tform' Then TFORM (Con) .show; IF (POS ('Object', SS [CURP])> 0) THEN getControl (TWINCONTROL (CON)); // Recursive IF (CURP 0) THEN INC; END; End; Procedure TFORM1.CORRECTTTTTTS (TS: TSTRINGS); VAR COUT, I: Integer; Temps: s TRING; Begin Cout: = POS ('Object', TS [0]); // If it is a subclass of TFORM, convert it to TFORM class if cout = 1 Then Begin i: = POS (':', TS [ 0]); TEMPS: = COPY (TS [0], 1, I); Temps: = Temps 'TFORM'; TS [0]: = Temps; EXIT; End; Delprop (TS, '(', ')' ); // Remove the TStrings attribute Delprop (TS, '<', '>'); // Remove the items attribute END;

Function tform1.checkevent: boolean; var tstr: string; begin result: = false; tstr: = trim (ss [curp]); if (TSTR [1] = 'o') and (TSTR [2] = 'n' .

Function TFORM1.ISCONTROL (COM: TCOMPONENT): Boolean; Begin Result: = false; if com.inheritsfrom (tcontrol) THEN RES: = true; end; procedure tform1.testshow (ts: tstrings); var i: integer; begin for I: = 0 to Ts.count-1 do memo1.lines.add (ts.strings [i]);

Procedure TForm1.delprop (TS: TStrings; Bchar, Echar: Char); Var i: integer; temps: string; begin i: = 0; While (i echar) and (i

END.// The program function is not powerful, but there are many places that can be enhanced, because I have dropped some of the properties, these attributes cannot be read in fluidization, if you are interested, you can restore these properties according to RTTI Value.