1unit frmBaseConfigCodeGenerator;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8  Classes, SysUtils, fpddcodegen,
9  Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, EditBtn, ComCtrls,
10  RTTIGrids, CheckLst, Buttons, ActnList, ButtonPanel,
11  LazFileUtils,
12  ldd_consts, SynEdit, SynHighlighterPas;
13
14type
15
16  { TBaseConfigGeneratorForm }
17
18  TBaseConfigGeneratorForm = class(TForm)
19    ADown: TAction;
20    AUP: TAction;
21    ALList: TActionList;
22    PDlgButtons: TButtonPanel;
23    CBShowDialog: TCheckBox;
24    CLBFields: TCheckListBox;
25    FEFile: TFileNameEdit;
26    LSave: TLabel;
27    LFields: TLabel;
28    LProperties: TLabel;
29    PCConf: TPageControl;
30    PGenerator: TPanel;
31    Panel2: TPanel;
32    PFieldList: TPanel;
33    PButtons: TPanel;
34    SBup: TSpeedButton;
35    SBDown: TSpeedButton;
36    Splitter1: TSplitter;
37    GFieldProps: TTIPropertyGrid;
38    GCodeOptions: TTIPropertyGrid;
39    sePreview: TSynEdit;
40    SHPreview: TSynFreePascalSyn;
41    TSPreview: TTabSheet;
42    TSFields: TTabSheet;
43    TSOptions: TTabSheet;
44    procedure CLBFieldsClick(Sender: TObject);
45    procedure CLBFieldsItemClick(Sender: TObject; Index: integer);
46    procedure CLBFieldsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
47    procedure ADownExecute(Sender: TObject);
48    procedure AUpExecute(Sender: TObject);
49    procedure FEFileEditingDone(Sender: TObject);
50    procedure FormCreate(Sender: TObject);
51    procedure FormDestroy(Sender: TObject);
52    procedure PCConfChange(Sender: TObject);
53    procedure Splitter1Moved(Sender: TObject);
54  private
55    { private declarations }
56    FLastName : String; // Last Unit name assigned
57    FFieldmap : TFieldPropDefs;
58    FGen: TDDCustomCodeGenerator;
59    FCodeOptions : TCodeGeneratorOptions;
60    procedure FormToGenerator;
61    Procedure GeneratorToForm;
62    function GetExtra: Boolean;
63    function GetFileName: String;
64    function GetShowResult: Boolean;
65    procedure MoveFieldDown;
66    function MoveFieldUp: Boolean;
67    procedure OnOkClick(Sender: TObject);
68    procedure SelectField(F: TFieldPropDef);
69    procedure SetExtra(const AValue: Boolean);
70    procedure SetFileName(const AValue: String);
71    procedure SetGen(const AValue: TDDCustomCodeGenerator);
72    procedure SetShowResult(const AValue: Boolean);
73    procedure ShowPreview;
74    procedure ShowSelectedField;
75  public
76    { public declarations }
77    Property Generator : TDDCustomCodeGenerator Read FGen Write SetGen;
78    Property ShowExtra : Boolean Read GetExtra Write SetExtra;
79    Property FileName : String Read GetFileName Write SetFileName;
80    Property ShowResult: Boolean Read GetShowResult Write SetShowResult;
81  end;
82
83var
84  BaseConfigGeneratorForm: TBaseConfigGeneratorForm;
85
86implementation
87
88uses strutils, typinfo,lcltype;
89
90{$R *.lfm}
91
92{ TBaseConfigGeneratorForm }
93
94procedure TBaseConfigGeneratorForm.CLBFieldsClick(Sender: TObject);
95begin
96  ShowSelectedField;
97end;
98
99procedure TBaseConfigGeneratorForm.CLBFieldsItemClick(Sender: TObject;
100  Index: integer);
101begin
102  CLBFields.ItemIndex:=Index;
103  ShowSelectedField;
104  With CLBFields do
105    If (ItemIndex<>-1) then
106      begin
107      FFieldMap[ItemIndex].Enabled:=Checked[ItemIndex];
108      GFieldProps.PropertyEditorHook.RefreshPropertyValues;
109      end;
110end;
111
112procedure TBaseConfigGeneratorForm.CLBFieldsKeyUp(Sender: TObject;
113  var Key: Word; Shift: TShiftState);
114begin
115  if Shift=[ssShift] then
116    begin
117    If (Key=VK_UP)  then
118      MoveFieldUp
119    else if (Key=VK_DOWN) then
120      MoveFieldDown
121    end;
122end;
123
124procedure TBaseConfigGeneratorForm.ShowSelectedField;
125
126begin
127  If (CLBFields.ItemIndex=-1) then
128    SelectField(Nil)
129  else
130    SelectField(FFieldMap[CLBFields.ItemIndex]);
131end;
132
133
134procedure TBaseConfigGeneratorForm.GeneratorToForm;
135
136Var
137  I,J : Integer;
138  PD : TFieldPropDef;
139  CC : TCodeGeneratorOptionsClass;
140  S : TStringList;
141
142begin
143  { The following construct means that only explicitly added
144    can be configured, or all fields. }
145  FreeAndNil(FFieldMap);
146  FFieldMap:=TFieldPropDefs.Create(FGen.Fields.ItemClass);
147  If Not FGen.NeedsFieldDefs then
148    begin
149    PCConf.ActivePage:=TSOptions;
150    TSFields.TabVisible:=False;
151    end
152  else
153    begin
154    S:=TStringList.Create;
155    try
156      S.Sorted:=true;
157      For I:=0 to FGen.Fields.Count-1 do
158        S.AddObject(FGen.Fields[i].FieldName,FGen.Fields[i]);
159      For I:=0 to S.Count-1 do
160        FFieldMap.Add.Assign((S.Objects[i] as TFieldPropDef));
161    finally
162      S.Free;
163    end;
164    For I:=0 to FFieldMap.Count-1 do
165      begin
166      PD:=FFieldMap[i];
167      J:=CLBFields.Items.AddObject(PD.FieldName,PD);
168      CLBFields.Checked[J]:=PD.Enabled;
169      end;
170    If (CLBFields.Items.Count>0) then
171      begin
172      CLBFields.ItemIndex:=0;
173      SelectField(FFieldMap[0])
174      end
175    else
176      begin
177      CLBFields.ItemIndex:=-1;
178      SelectField(Nil);
179      end;
180    end;
181  CC:=TCodeGeneratorOptionsClass(FGen.CodeOptions.ClassType);
182  FCodeOptions:=CC.Create;
183  FCodeOptions.Assign(FGen.CodeOptions);
184  GCodeOptions.TIObject:=FCodeOptions;
185end;
186
187Procedure TBaseConfigGeneratorForm.SelectField(F : TFieldPropDef);
188
189begin
190  GFieldProps.TIObject:=F;
191  GFieldProps.Enabled:=(F<>Nil);
192end;
193
194function TBaseConfigGeneratorForm.GetExtra: Boolean;
195begin
196  Result:=PGenerator.Visible;
197end;
198
199function TBaseConfigGeneratorForm.GetFileName: String;
200begin
201  Result:=FEFile.FileName;
202end;
203
204function TBaseConfigGeneratorForm.GetShowResult: Boolean;
205begin
206  Result:=CBShowDialog.Checked
207end;
208
209procedure TBaseConfigGeneratorForm.SetExtra(const AValue: Boolean);
210begin
211  PGenerator.Visible:=AValue;
212end;
213
214procedure TBaseConfigGeneratorForm.SetFileName(const AValue: String);
215begin
216  FEFile.FileName:=AValue;
217end;
218
219procedure TBaseConfigGeneratorForm.SetGen(const AValue: TDDCustomCodeGenerator);
220begin
221  if FGen=AValue then exit;
222  FGen:=AValue;
223  If Assigned(FGen) then
224    GeneratorToForm;
225end;
226
227procedure TBaseConfigGeneratorForm.SetShowResult(const AValue: Boolean);
228begin
229  CBShowDialog.Checked:=AValue;
230end;
231
232procedure TBaseConfigGeneratorForm.AUpExecute(Sender: TObject);
233begin
234  MoveFieldUp;
235end;
236
237procedure TBaseConfigGeneratorForm.FEFileEditingDone(Sender: TObject);
238
239Var
240  OldName,NewName : string;
241
242begin
243  OldName:=FCodeOptions.UnitName;
244  if (OldName='') or
245     SameText(OldName,'Unit1') or
246     SameText(OldName,FLastname) then
247     begin
248     NewName:=ExtractFileName(FEFile.FileName);
249     FLastName:=NewName;
250     // Strip off known extensions
251     if FilenameExtIn(NewName,['.pas','.pp','.inc','.lpr','.dpr']) then
252       FCodeOptions.UnitName:=ChangeFileExt(NewName,'')
253     else
254       FCodeOptions.UnitName:=NewName;
255     end;
256end;
257
258procedure TBaseConfigGeneratorForm.FormCreate(Sender: TObject);
259begin
260  //
261  Caption := ldd_Configuregeneratedcode;
262  LSave.Caption:= ldd_Saveto;
263  CBShowDialog.Caption:= ldd_Showgeneratedcode;
264  TSFields.Caption:= ldd_Fields;
265  LFields.Caption:= ldd_Fieldstogeneratecodefor;
266  LProperties.Caption:= ldd_Propertiesforselected;
267  TSOptions.Caption:= ldd_Options;
268  //
269  PDlgButtons.OKButton.OnClick:=@OnOKClick;
270end;
271
272procedure TBaseConfigGeneratorForm.FormDestroy(Sender: TObject);
273begin
274  FreeAndNil(FFieldMap);
275  FreeAndNil(FCodeOPtions);
276end;
277
278procedure TBaseConfigGeneratorForm.ShowPreview;
279
280Var
281  CG : TDDCustomCodeGenerator;
282
283begin
284  CG:=TDDCustomCodeGeneratorClass(FGen.ClassType).Create(Self);
285  try
286    sePreview.Lines.BeginUpdate;
287    sePreview.Lines.Clear;
288    CG.CodeOptions.Assign(FCodeOptions);
289    CG.Fields.Assign(FGen.Fields);
290    CG.GenerateCode(sePreview.Lines);
291  finally
292    sePreview.Lines.EndUpdate;
293    CG.Free;
294  end;
295end;
296
297
298procedure TBaseConfigGeneratorForm.PCConfChange(Sender: TObject);
299
300begin
301  if (PCConf.ActivePage=tsPreview) then
302    ShowPreview;
303end;
304
305procedure TBaseConfigGeneratorForm.Splitter1Moved(Sender: TObject);
306begin
307  LFields.Width:=Splitter1.Left;
308end;
309
310procedure TBaseConfigGeneratorForm.OnOkClick(Sender: TObject);
311
312begin
313  FormToGenerator;
314end;
315
316
317Function TBaseConfigGeneratorForm.MoveFieldUp : Boolean;
318
319begin
320  Result:=false;
321  With CLBFields do
322    If (ItemIndex>0) then
323      begin
324      Items.Exchange(ItemIndex,ItemIndex-1);
325      FFieldMap.Items[ItemIndex].Index:=ItemIndex-1;
326      ItemIndex:=ItemIndex-1;
327      Result:=true;
328      end;
329end;
330
331procedure TBaseConfigGeneratorForm.ADownExecute(Sender: TObject);
332begin
333  MoveFieldDown;
334end;
335
336procedure TBaseConfigGeneratorForm.MoveFieldDown;
337
338begin
339  With CLBFields do
340    If (ItemIndex<Items.Count-1) then
341      begin
342      Items.Exchange(ItemIndex,ItemIndex+1);
343      FFieldMap.Items[ItemIndex].Index:=ItemIndex+1;
344      ItemIndex:=ItemIndex+1;
345      end;
346end;
347
348procedure TBaseConfigGeneratorForm.FormToGenerator;
349
350Var
351  I : Integer;
352
353begin
354  For I:=0 to FFieldMap.Count-1 do
355    FGen.Fields[I].Assign(FFieldMap[i]);
356  FGen.CodeOptions.Assign(FCodeOptions);
357end;
358
359end.
360
361