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