Analyze DFM file generation interface

A question has been answered, which is about the interface of the program based on the DFM file, spent several days of research, and can be restored to the general program interface. I don't dare to stay, put the code here, there is not much explanation inside, may read it is very convenient, I am sorry here, I don't have much time, so I will have interest to analyze the code. 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: / The following unit is the registration component class, but also increase, some 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.