Changeset 3
- Timestamp:
- Jan 18, 2015, 5:25:37 PM (10 years ago)
- Location:
- trunk
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 3 3 MyData.lps 4 4 data.xml 5 Config.xml
-
- Property svn:ignore
-
trunk/Forms/UFormField.lfm
r2 r3 26 26 end 27 27 object ButtonOk: TButton 28 Left = 62428 Left = 880 29 29 Height = 25 30 Top = 31230 Top = 400 31 31 Width = 75 32 Anchors = [akRight, akBottom] 32 33 Caption = 'Ok' 33 34 ModalResult = 1 … … 59 60 Left = 16 60 61 Height = 25 61 Top = 14 662 Top = 144 62 63 Width = 93 63 64 Caption = 'Text after:' … … 74 75 object ComboBoxType: TComboBox 75 76 Left = 167 76 Height = 3 577 Height = 37 77 78 Top = 48 78 79 Width = 265 79 80 ItemHeight = 0 81 OnChange = ComboBoxTypeChange 80 82 Style = csDropDownList 81 83 TabOrder = 4 82 84 end 83 85 object ButtonCancel: TButton 84 Left = 52886 Left = 784 85 87 Height = 25 86 Top = 31288 Top = 400 87 89 Width = 75 90 Anchors = [akRight, akBottom] 88 91 Caption = 'Cancel' 89 92 ModalResult = 2 90 93 TabOrder = 5 91 94 end 95 object PageControl1: TPageControl 96 Left = 16 97 Height = 200 98 Top = 184 99 Width = 936 100 ActivePage = TabSheetDateTime 101 Anchors = [akTop, akLeft, akRight, akBottom] 102 ShowTabs = False 103 TabIndex = 2 104 TabOrder = 6 105 object TabSheetString: TTabSheet 106 Caption = 'TabSheetString' 107 ClientHeight = 194 108 ClientWidth = 930 109 object EditStringDefault: TEdit 110 Left = 160 111 Height = 35 112 Top = 8 113 Width = 265 114 TabOrder = 0 115 end 116 object Label5: TLabel 117 Left = 16 118 Height = 25 119 Top = 8 120 Width = 127 121 Caption = 'Default value:' 122 ParentColor = False 123 end 124 end 125 object TabSheetInteger: TTabSheet 126 Caption = 'TabSheetInteger' 127 end 128 object TabSheetDateTime: TTabSheet 129 Caption = 'TabSheetDateTime' 130 ClientHeight = 194 131 ClientWidth = 930 132 object DateEditMin: TDateEdit 133 Left = 136 134 Height = 35 135 Top = 24 136 Width = 216 137 CalendarDisplaySettings = [dsShowHeadings, dsShowDayNames] 138 OKCaption = 'OK' 139 CancelCaption = 'Cancel' 140 DateOrder = doNone 141 ButtonWidth = 23 142 NumGlyphs = 1 143 MaxLength = 0 144 TabOrder = 0 145 end 146 object Label6: TLabel 147 Left = 16 148 Height = 25 149 Top = 32 150 Width = 96 151 Caption = 'Minimum:' 152 ParentColor = False 153 end 154 object DateEditMax: TDateEdit 155 Left = 136 156 Height = 35 157 Top = 72 158 Width = 216 159 CalendarDisplaySettings = [dsShowHeadings, dsShowDayNames] 160 OKCaption = 'OK' 161 CancelCaption = 'Cancel' 162 DateOrder = doNone 163 ButtonWidth = 23 164 NumGlyphs = 1 165 MaxLength = 0 166 TabOrder = 1 167 end 168 object Label7: TLabel 169 Left = 16 170 Height = 25 171 Top = 80 172 Width = 100 173 Caption = 'Maximum:' 174 ParentColor = False 175 end 176 end 177 object TabSheetBoolean: TTabSheet 178 Caption = 'TabSheetBoolean' 179 end 180 end 92 181 end -
trunk/Forms/UFormField.pas
r2 r3 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 UDatabase;9 ComCtrls, EditBtn, UDatabase; 10 10 11 11 type … … 17 17 ButtonCancel: TButton; 18 18 ComboBoxType: TComboBox; 19 DateEditMin: TDateEdit; 20 DateEditMax: TDateEdit; 19 21 EditName: TEdit; 22 EditStringDefault: TEdit; 20 23 EditTextBefore: TEdit; 21 24 EditTextAfter: TEdit; … … 24 27 Label3: TLabel; 25 28 Label4: TLabel; 29 Label5: TLabel; 30 Label6: TLabel; 31 Label7: TLabel; 32 PageControl1: TPageControl; 33 TabSheetDateTime: TTabSheet; 34 TabSheetInteger: TTabSheet; 35 TabSheetString: TTabSheet; 36 TabSheetBoolean: TTabSheet; 37 procedure ComboBoxTypeChange(Sender: TObject); 26 38 procedure FormCreate(Sender: TObject); 27 39 procedure FormShow(Sender: TObject); … … 55 67 end; 56 68 69 procedure TFormField.ComboBoxTypeChange(Sender: TObject); 70 begin 71 PageControl1.TabIndex := ComboBoxType.ItemIndex; 72 end; 73 57 74 procedure TFormField.Load(Field: TField); 58 75 begin … … 61 78 EditTextBefore.Text := Field.TextBefore; 62 79 ComboBoxType.ItemIndex := Integer(Field.FieldType); 80 ComboBoxTypeChange(Self); 81 if Field.FieldType = ftString then 82 EditStringDefault.Text := TFieldString(Field.TypeRelated).DefaultValue; 83 if Field.FieldType = ftDateTime then begin 84 DateEditMin.Date := TFieldDateTime(Field.TypeRelated).Min; 85 DateEditMax.Date := TFieldDateTime(Field.TypeRelated).Max; 86 end; 63 87 end; 64 88 … … 69 93 Field.TextAfter := EditTextAfter.Text; 70 94 Field.FieldType := TFieldType(ComboBoxType.ItemIndex); 95 if Field.FieldType = ftString then 96 TFieldString(Field.TypeRelated).DefaultValue := EditStringDefault.Text; 97 if Field.FieldType = ftDateTime then begin 98 TFieldDateTime(Field.TypeRelated).Min := DateEditMin.Date; 99 TFieldDateTime(Field.TypeRelated).Max := DateEditMax.Date; 100 end; 71 101 end; 72 102 -
trunk/Forms/UFormFields.pas
r2 r3 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ActnList,9 ComCtrls, Menus, UDatabase;8 Classes, SysUtils, XMLConf, FileUtil, Forms, Controls, Graphics, Dialogs, 9 ActnList, ComCtrls, Menus, UDatabase; 10 10 11 11 type -
trunk/Forms/UFormRecord.lfm
r2 r3 1 1 object FormRecord: TFormRecord 2 Left = 8373 Height = 2404 Top = 2985 Width = 3202 Left = 639 3 Height = 694 4 Top = 174 5 Width = 859 6 6 Caption = 'FormRecord' 7 ClientHeight = 694 8 ClientWidth = 859 9 OnCreate = FormCreate 10 OnDestroy = FormDestroy 11 OnShow = FormShow 7 12 LCLVersion = '1.3' 13 object Panel1: TPanel 14 Left = 4 15 Height = 632 16 Top = 4 17 Width = 851 18 Align = alTop 19 BorderSpacing.Around = 4 20 TabOrder = 0 21 end 22 object ButtonOk: TButton 23 Left = 760 24 Height = 25 25 Top = 648 26 Width = 75 27 Anchors = [akRight, akBottom] 28 Caption = 'Ok' 29 ModalResult = 1 30 TabOrder = 1 31 end 32 object ButtonCancel: TButton 33 Left = 649 34 Height = 27 35 Top = 646 36 Width = 72 37 Anchors = [akRight, akBottom] 38 Caption = 'Cancel' 39 ModalResult = 2 40 TabOrder = 2 41 end 42 object ActionList1: TActionList 43 left = 423 44 top = 379 45 object ASave: TAction 46 Caption = 'Save' 47 OnExecute = ASaveExecute 48 end 49 object ACancel: TAction 50 Caption = 'Cancel' 51 OnExecute = ACancelExecute 52 end 53 end 8 54 end -
trunk/Forms/UFormRecord.pas
r2 r3 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, UDatabase; 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 ComCtrls, ActnList, StdCtrls, EditBtn, UDatabase, Contnrs; 9 10 10 11 type 12 13 { TFormRecord } 14 11 15 TFormRecord = class(TForm) 16 ASave: TAction; 17 ACancel: TAction; 18 ActionList1: TActionList; 19 ButtonOk: TButton; 20 ButtonCancel: TButton; 21 Panel1: TPanel; 22 procedure ACancelExecute(Sender: TObject); 23 procedure ASaveExecute(Sender: TObject); 24 procedure FormCreate(Sender: TObject); 25 procedure FormDestroy(Sender: TObject); 26 procedure FormShow(Sender: TObject); 12 27 private 13 28 { private declarations } … … 15 30 Table: TTable; 16 31 Row: TRecord; 32 Controls: TObjectList; // TListObject<TControl> 33 Labels: TObjectList; // TListObject<TControl> 34 procedure ReloadControls; 35 procedure Load(DataRecord: TRecord); 36 procedure Save(DataRecord: TRecord); 17 37 end; 18 38 … … 24 44 {$R *.lfm} 25 45 46 { TFormRecord } 47 48 procedure TFormRecord.FormShow(Sender: TObject); 49 begin 50 ReloadControls; 51 end; 52 53 procedure TFormRecord.ACancelExecute(Sender: TObject); 54 begin 55 ModalResult := mrCancel; 56 Close; 57 end; 58 59 procedure TFormRecord.ASaveExecute(Sender: TObject); 60 begin 61 ModalResult := mrOk; 62 Close; 63 end; 64 65 procedure TFormRecord.FormCreate(Sender: TObject); 66 begin 67 Controls := TObjectList.Create; 68 Labels := TObjectList.Create; 69 end; 70 71 procedure TFormRecord.FormDestroy(Sender: TObject); 72 begin 73 Labels.Free; 74 Controls.Free; 75 end; 76 77 procedure TFormRecord.ReloadControls; 78 begin 79 end; 80 81 procedure TFormRecord.Load(DataRecord: TRecord); 82 var 83 I: Integer; 84 NewLabel: TLabel; 85 NewControl: TControl; 86 CellRect: TRect; 87 begin 88 Row := DataRecord; 89 Controls.Clear; 90 Labels.Clear; 91 for I := 0 to Table.Fields.Count - 1 do begin 92 CellRect := Rect(10, 10 + I * 70, Panel1.Width - 20, (I + 1) * 70); 93 NewLabel := TLabel.Create(Panel1); 94 NewLabel.Caption := TField(Table.Fields[I]).TextBefore; 95 NewLabel.Parent := Panel1; 96 NewLabel.Left := CellRect.Left; 97 NewLabel.Top := CellRect.Top; 98 NewLabel.Visible := True; 99 Labels.Add(NewLabel); 100 case TField(Table.Fields[I]).FieldType of 101 ftString: begin 102 NewControl := TEdit.Create(Panel1); 103 NewControl.Parent := Panel1; 104 NewControl.Left := CellRect.Left; 105 NewControl.Top := CellRect.Top + NewLabel.Height + 6; 106 NewControl.Width := CellRect.Right - CellRect.Left; 107 NewControl.Visible := True; 108 TEdit(NewControl).Text := TValueString(Row.Values[I]).Value; 109 Controls.Add(NewControl); 110 end; 111 ftDateTime: begin 112 NewControl := TDateEdit.Create(Panel1); 113 NewControl.Parent := Panel1; 114 NewControl.Left := CellRect.Left; 115 NewControl.Top := CellRect.Top + NewLabel.Height + 6; 116 NewControl.Width := CellRect.Right - CellRect.Left; 117 NewControl.Visible := True; 118 TDateEdit(NewControl).Date := TValueDateTime(Row.Values[I]).Value; 119 Controls.Add(NewControl); 120 end; 121 end; 122 end; 123 end; 124 125 procedure TFormRecord.Save(DataRecord: TRecord); 126 var 127 I: Integer; 128 begin 129 for I := 0 to Table.Fields.Count - 1 do begin 130 case TField(Table.Fields[I]).FieldType of 131 ftString: TValueString(Row.Values[I]).Value := TEdit(Controls[I]).Text; 132 ftDateTime: TValueDateTime(Row.Values[I]).Value := TDateEdit(Controls[I]).Date; 133 end; 134 end; 135 end; 136 26 137 end. 27 138 -
trunk/Forms/UFormRecords.lfm
r2 r3 31 31 TabOrder = 0 32 32 ViewStyle = vsReport 33 OnData = ListView1Data 33 34 OnDblClick = AModifyExecute 34 35 OnSelectItem = ListView1SelectItem -
trunk/Forms/UFormRecords.pas
r2 r3 31 31 procedure ARemoveExecute(Sender: TObject); 32 32 procedure FormShow(Sender: TObject); 33 procedure ListView1Data(Sender: TObject; Item: TListItem); 33 34 procedure ListView1SelectItem(Sender: TObject; Item: TListItem; 34 35 Selected: Boolean); … … 46 47 implementation 47 48 49 uses 50 UFormRecord; 51 48 52 {$R *.lfm} 49 53 … … 53 57 begin 54 58 Caption := 'Table - ' + Table.Name; 55 UpdateInterface; 59 ReloadList; 60 end; 61 62 procedure TFormRecords.ListView1Data(Sender: TObject; Item: TListItem); 63 var 64 I: Integer; 65 begin 66 if (Item.Index >= 0) and (Item.Index < Table.Records.Count) then 67 with TRecord(Table.Records[Item.Index]) do begin 68 for I := 0 to Table.Fields.Count - 1 do begin 69 if I = 0 then Item.Caption := TValue(Values[0]).GetString 70 else Item.SubItems.Add(TValue(Values[I]).GetString); 71 end; 72 Item.Data := Table.Records[Item.Index]; 73 end 56 74 end; 57 75 … … 64 82 procedure TFormRecords.AModifyExecute(Sender: TObject); 65 83 begin 66 84 if Assigned(ListView1.Selected) then begin 85 FormRecord.Table := Table; 86 FormRecord.Load(TRecord(ListView1.Selected.Data)); 87 if FormRecord.ShowModal = mrOk then begin 88 FormRecord.Save(TRecord(ListView1.Selected.Data)); 89 ReloadList; 90 end; 91 end; 67 92 end; 68 93 69 94 procedure TFormRecords.ARemoveExecute(Sender: TObject); 70 95 begin 71 96 if Assigned(ListView1.Selected) then begin 97 Table.Records.Remove(ListView1.Selected.Data); 98 ReloadList; 99 end; 72 100 end; 73 101 74 102 procedure TFormRecords.AAddExecute(Sender: TObject); 103 var 104 NewRecord: TRecord; 105 ValueClass: TValueClass; 106 I: Integer; 107 NewValue: TValue; 75 108 begin 109 NewRecord := TRecord.Create; 110 NewRecord.Parent := Table; 111 NewRecord.Values.Count := Table.Fields.Count; 112 for I := 0 to Table.Fields.Count - 1 do begin 113 ValueClass := TField(Table.Fields[I]).GetValueClass; 114 NewValue := ValueClass.Create; 115 NewRecord.Values[I] := NewValue; 116 end; 76 117 118 FormRecord.Table := Table; 119 FormRecord.Load(NewRecord); 120 if FormRecord.ShowModal = mrOk then begin 121 FormRecord.Save(NewRecord); 122 Table.Records.Add(NewRecord); 123 ReloadList; 124 end else NewRecord.Free; 77 125 end; 78 126 … … 84 132 85 133 procedure TFormRecords.ReloadList; 134 var 135 I: Integer; 136 NewColumn: TListColumn; 86 137 begin 138 ListView1.Columns.Clear; 139 for I := 0 to Table.Fields.Count - 1 do begin 140 NewColumn := ListView1.Columns.Add; 141 NewColumn.Caption := TField(Table.Fields[I]).TextBefore; 142 NewColumn.Width := 200; 143 end; 144 87 145 ListView1.Items.Count := Table.Records.Count; 88 146 ListView1.Repaint; -
trunk/Forms/UFormTables.lfm
r2 r3 7 7 ClientHeight = 660 8 8 ClientWidth = 978 9 OnActivate = FormActivate 10 OnClose = FormClose 9 11 OnShow = FormShow 10 12 LCLVersion = '1.3' -
trunk/Forms/UFormTables.pas
r2 r3 38 38 procedure AShowFieldsExecute(Sender: TObject); 39 39 procedure AShowRecordsExecute(Sender: TObject); 40 procedure FormActivate(Sender: TObject); 41 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 40 42 procedure FormShow(Sender: TObject); 41 43 procedure ListView1Data(Sender: TObject; Item: TListItem); … … 116 118 Database.Tables.Remove(ListView1.Selected.Data); 117 119 ReloadList; 118 UpdateInterface;119 120 end; 120 121 end; … … 138 139 end; 139 140 141 procedure TFormMain.FormActivate(Sender: TObject); 142 begin 143 Core.Init; 144 end; 145 146 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); 147 begin 148 Core.Done; 149 end; 150 140 151 procedure TFormMain.FormShow(Sender: TObject); 141 152 begin 142 153 Database := Core.Database; 143 154 ReloadList; 144 UpdateInterface;145 155 end; 146 156 … … 149 159 ListView1.Items.Count := Database.Tables.Count; 150 160 ListView1.Repaint; 161 FormMain.UpdateInterface; 151 162 end; 152 163 -
trunk/MyData.lpi
r2 r3 17 17 <StringTable ProductVersion=""/> 18 18 </VersionInfo> 19 <BuildModes Count="1"> 20 <Item1 Name="Default" Default="True"/> 19 <BuildModes Count="2"> 20 <Item1 Name="Debug" Default="True"/> 21 <Item2 Name="Release"> 22 <CompilerOptions> 23 <Version Value="11"/> 24 <Target> 25 <Filename Value="MyData"/> 26 </Target> 27 <SearchPaths> 28 <IncludeFiles Value="$(ProjOutDir)"/> 29 <OtherUnitFiles Value="Forms"/> 30 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 31 </SearchPaths> 32 <Parsing> 33 <SyntaxOptions> 34 <SyntaxMode Value="Delphi"/> 35 <CStyleOperator Value="False"/> 36 <AllowLabel Value="False"/> 37 <CPPInline Value="False"/> 38 </SyntaxOptions> 39 </Parsing> 40 <CodeGeneration> 41 <SmartLinkUnit Value="True"/> 42 <Optimizations> 43 <OptimizationLevel Value="3"/> 44 </Optimizations> 45 <SmallerCode Value="True"/> 46 </CodeGeneration> 47 <Linking> 48 <Debugging> 49 <GenerateDebugInfo Value="False"/> 50 </Debugging> 51 <LinkSmart Value="True"/> 52 <Options> 53 <Win32> 54 <GraphicApplication Value="True"/> 55 </Win32> 56 </Options> 57 </Linking> 58 </CompilerOptions> 59 </Item2> 21 60 </BuildModes> 22 61 <PublishOptions> … … 28 67 </local> 29 68 </RunParams> 30 <RequiredPackages Count=" 2">69 <RequiredPackages Count="3"> 31 70 <Item1> 32 <PackageName Value=" Common"/>71 <PackageName Value="FCL"/> 33 72 </Item1> 34 73 <Item2> 74 <PackageName Value="Common"/> 75 </Item2> 76 <Item3> 35 77 <PackageName Value="LCL"/> 36 </Item 2>78 </Item3> 37 79 </RequiredPackages> 38 80 <Units Count="10"> … … 71 113 <IsPartOfProject Value="True"/> 72 114 <ComponentName Value="FormTable"/> 115 <HasResources Value="True"/> 73 116 <ResourceBaseClass Value="Form"/> 74 117 <UnitName Value="UFormTable"/> … … 78 121 <IsPartOfProject Value="True"/> 79 122 <ComponentName Value="FormRecords"/> 123 <HasResources Value="True"/> 80 124 <ResourceBaseClass Value="Form"/> 81 125 <UnitName Value="UFormRecords"/> … … 85 129 <IsPartOfProject Value="True"/> 86 130 <ComponentName Value="FormRecord"/> 131 <HasResources Value="True"/> 87 132 <ResourceBaseClass Value="Form"/> 88 133 <UnitName Value="UFormRecord"/> … … 92 137 <IsPartOfProject Value="True"/> 93 138 <ComponentName Value="FormFields"/> 139 <HasResources Value="True"/> 94 140 <ResourceBaseClass Value="Form"/> 95 141 <UnitName Value="UFormFields"/> … … 99 145 <IsPartOfProject Value="True"/> 100 146 <ComponentName Value="FormField"/> 147 <HasResources Value="True"/> 101 148 <ResourceBaseClass Value="Form"/> 102 149 <UnitName Value="UFormField"/> … … 117 164 <SyntaxOptions> 118 165 <SyntaxMode Value="Delphi"/> 166 <CStyleOperator Value="False"/> 167 <IncludeAssertionCode Value="True"/> 168 <AllowLabel Value="False"/> 169 <CPPInline Value="False"/> 119 170 </SyntaxOptions> 120 171 </Parsing> 172 <CodeGeneration> 173 <Checks> 174 <IOChecks Value="True"/> 175 <RangeChecks Value="True"/> 176 <OverflowChecks Value="True"/> 177 <StackChecks Value="True"/> 178 </Checks> 179 <VerifyObjMethodCallValidity Value="True"/> 180 </CodeGeneration> 121 181 <Linking> 182 <Debugging> 183 <UseHeaptrc Value="True"/> 184 </Debugging> 122 185 <Options> 123 186 <Win32> … … 126 189 </Options> 127 190 </Linking> 191 <Other> 192 <CustomOptions Value="-dDEBUG"/> 193 </Other> 128 194 </CompilerOptions> 129 195 <Debugging> -
trunk/UCore.lfm
r2 r3 11 11 top = 137 12 12 end 13 object XMLConfig1: TXMLConfig 14 Filename = 'Config.xml' 15 StartEmpty = False 16 RootName = 'CONFIG' 17 left = 294 18 top = 216 19 end 20 object ActionList1: TActionList 21 Images = ImageList1 22 left = 297 23 top = 77 24 object AExit: TAction 25 Caption = 'Exit' 26 OnExecute = AExitExecute 27 end 28 end 13 29 end -
trunk/UCore.pas
r2 r3 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Controls, UDatabase;8 Classes, SysUtils, XMLConf, FileUtil, Controls, ActnList, UDatabase, Forms; 9 9 10 10 type … … 13 13 14 14 TCore = class(TDataModule) 15 AExit: TAction; 16 ActionList1: TActionList; 15 17 ImageList1: TImageList; 18 XMLConfig1: TXMLConfig; 19 procedure AExitExecute(Sender: TObject); 16 20 procedure DataModuleCreate(Sender: TObject); 17 21 procedure DataModuleDestroy(Sender: TObject); 18 22 private 19 { private declarations }23 Initialized: Boolean; 20 24 public 21 25 Database: TDatabase; 26 procedure LoadConfig; 27 procedure SaveConfig; 28 procedure Init; 29 procedure Done; 22 30 end; 23 31 … … 37 45 begin 38 46 Database := TDatabaseXML.Create; 39 Database.ConnectionString := 'file:///home/chronos/Projekty/test/MyData/data.xml'; 40 Database.Load; 47 end; 48 49 procedure TCore.AExitExecute(Sender: TObject); 50 begin 51 FormMain.Close; 41 52 end; 42 53 43 54 procedure TCore.DataModuleDestroy(Sender: TObject); 44 55 begin 56 Database.Free; 57 end; 58 59 procedure TCore.LoadConfig; 60 begin 61 Database.ConnectionString := XMLConfig1.GetValue('ConnectionString', 'file://' + ExtractFileDir(Application.ExeName) + '/data.xml'); 62 end; 63 64 procedure TCore.SaveConfig; 65 begin 66 XMLConfig1.SetValue('ConnectionString', Database.ConnectionString); 67 end; 68 69 procedure TCore.Init; 70 begin 71 if not Initialized then begin 72 Initialized := True; 73 LoadConfig; 74 Database.Load; 75 FormMain.ReloadList; 76 end; 77 end; 78 79 procedure TCore.Done; 80 begin 45 81 Database.Save; 46 Database.Free;82 SaveConfig; 47 83 end; 48 84 -
trunk/UDatabase.pas
r2 r3 6 6 7 7 uses 8 Classes, SysUtils, Contnrs ;8 Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn; 9 9 10 10 type 11 TTable = class; 12 11 13 TFieldType = (ftString, ftNumeric, ftDateTime, ftBoolean, ftFloat, ftImage, 12 14 ftDate, tfTime, ftMapPosition); 13 15 16 { TValue } 17 18 TValue = class 19 function GetString: string; virtual; 20 end; 21 22 TValueClass = class of TValue; 23 24 { TValueString } 25 26 TValueString = class(TValue) 27 Value: string; 28 function GetString: string; override; 29 end; 30 31 TValueInteger = class(TValue) 32 Value: Integer; 33 end; 34 35 { TValueDateTime } 36 37 TValueDateTime = class(TValue) 38 Value: TDateTime; 39 function GetString: string; override; 40 end; 41 42 TValues = class(TObjectList) 43 end; 44 45 { TFieldTypeSpecific } 46 47 TFieldTypeSpecific = class 48 function GetValueClass: TValueClass; virtual; 49 end; 50 51 TFieldTypeSpecificClass = class of TFieldTypeSpecific; 52 53 { TFieldString } 54 55 TFieldString = class(TFieldTypeSpecific) 56 DefaultValue: string; 57 function GetValueClass: TValueClass; override; 58 end; 59 60 TFieldInteger = class(TFieldTypeSpecific) 61 Min: Integer; 62 Max: Integer; 63 DefaultValue: Integer; 64 end; 65 66 TFieldFloat = class(TFieldTypeSpecific) 67 Min: Double; 68 Max: Double; 69 DefaultValue: Double; 70 end; 71 72 { TFieldDateTime } 73 74 TFieldDateTime = class(TFieldTypeSpecific) 75 Min: TDateTime; 76 Max: TDateTime; 77 function GetValueClass: TValueClass; override; 78 end; 79 80 TFieldDate = class(TFieldTypeSpecific) 81 Min: TDate; 82 Max: TDate; 83 end; 84 85 TFieldTime = class(TFieldTypeSpecific) 86 Min: TTime; 87 Max: TTime; 88 end; 89 90 TFieldImage = class(TFieldTypeSpecific) 91 MinSize: TPoint; 92 MaxSize: TPoint; 93 end; 94 95 TFieldBoolean = class(TFieldTypeSpecific) 96 DefaultValue: Boolean; 97 end; 98 99 TFieldMapPosition = class(TFieldTypeSpecific) 100 end; 101 14 102 { TField } 15 103 16 104 TField = class 105 private 106 FFieldType: TFieldType; 107 procedure SetFieldType(AValue: TFieldType); 108 public 17 109 Name: string; 18 FieldType: TFieldType;110 TypeRelated: TFieldTypeSpecific; 19 111 Required: Boolean; 20 112 ReadOnly: Boolean; … … 25 117 Pos: TPoint; 26 118 Size: TPoint; 27 end; 28 29 TFieldString = class(TField) 30 DefaultValue: string; 31 end; 32 33 TFieldInteger = class(TField) 34 Min: Integer; 35 Max: Integer; 36 DefaultValue: Integer; 37 end; 38 39 TFieldDateTime = class(TField) 40 Min: TDateTime; 41 Max: TDateTime; 42 end; 43 44 TFieldImage = class(TField) 119 function GetValueClass: TValueClass; 120 property FieldType: TFieldType read FFieldType write SetFieldType; 121 constructor Create; 45 122 end; 46 123 … … 48 125 end; 49 126 50 TValue = class 51 end; 52 53 TValueString = class 54 Value: string; 55 end; 56 57 TValueInteger = class 58 Value: Integer; 59 end; 60 61 TValueDateTime = class 62 Value: TDateTime; 63 end; 64 65 TValues = class(TObjectList) 66 end; 127 { TRecord } 67 128 68 129 TRecord = class 130 Parent: TTable; 69 131 Values: TValues; 132 constructor Create; 133 destructor Destroy; override; 70 134 end; 71 135 72 136 TRecords = class(TObjectList) 73 137 Parent: TTable; 74 138 end; 75 139 … … 105 169 FieldTypeString: array[TFieldType] of string = ('String', 'Numeric', 'DateTime', 106 170 'Boolean', 'Float', 'Image', 'Date', 'Time', 'MapPosition'); 171 FieldTypeClass: array[TFieldType] of TFieldTypeSpecificClass = (TFieldString, 172 TFieldInteger, TFieldDateTime, TFieldBoolean, TFieldFloat, TFieldImage, 173 TFieldDate, TFieldTime, TFieldMapPosition); 107 174 108 175 109 176 implementation 110 177 178 { TFieldDateTime } 179 180 function TFieldDateTime.GetValueClass: TValueClass; 181 begin 182 Result := TValueDateTime; 183 end; 184 185 { TValueDateTime } 186 187 function TValueDateTime.GetString: string; 188 begin 189 Result := DateTimeToStr(Value); 190 end; 191 192 { TRecord } 193 194 constructor TRecord.Create; 195 begin 196 Values := TValues.Create; 197 end; 198 199 destructor TRecord.Destroy; 200 begin 201 Values.Free; 202 inherited Destroy; 203 end; 204 205 { TValueString } 206 207 function TValueString.GetString: string; 208 begin 209 Result := Value; 210 end; 211 212 { TValue } 213 214 function TValue.GetString: string; 215 begin 216 Result := ''; 217 end; 218 219 { TFieldString } 220 221 function TFieldString.GetValueClass: TValueClass; 222 begin 223 Result := TValueString; 224 end; 225 226 { TFieldTypeSpecific } 227 228 function TFieldTypeSpecific.GetValueClass: TValueClass; 229 begin 230 Result := TValue; 231 end; 232 111 233 { TField } 112 234 235 procedure TField.SetFieldType(AValue: TFieldType); 236 begin 237 if FFieldType = AValue then Exit; 238 if Assigned(TypeRelated) then TypeRelated.Free; 239 FFieldType := AValue; 240 TypeRelated := FieldTypeClass[FFieldType].Create; 241 end; 242 243 function TField.GetValueClass: TValueClass; 244 begin 245 if Assigned(TypeRelated) then Result := TypeRelated.GetValueClass 246 else Result := TValue; 247 end; 248 249 constructor TField.Create; 250 begin 251 TypeRelated := TFieldString.Create; 252 end; 253 254 { TField } 255 113 256 114 257 { TTable } … … 117 260 begin 118 261 Records := TRecords.Create; 262 Records.Parent := Self; 119 263 Fields := TFields.Create; 120 264 end; -
trunk/UDatabaseXML.pas
r2 r3 14 14 private 15 15 function GetFileName: string; 16 procedure LoadNodeRecord(Row: TRecord; Node: TDOMNode); 17 procedure SaveNodeRecord(Row: TRecord; Node: TDOMNode); 18 procedure LoadNodeRecords(Records: TRecords; Node: TDOMNode); 19 procedure SaveNodeRecords(Records: TRecords; Node: TDOMNode); 16 20 procedure LoadNodeField(Field: TField; Node: TDOMNode); 17 21 procedure SaveNodeField(Field: TField; Node: TDOMNode); … … 45 49 end; 46 50 51 procedure TDatabaseXML.LoadNodeRecord(Row: TRecord; Node: TDOMNode); 52 var 53 Node2: TDOMNode; 54 NewValue: TValue; 55 I: Integer; 56 begin 57 Row.Values.Count := 0; 58 Node2 := Node.FirstChild; 59 I := 0; 60 while Assigned(Node2) and (Node2.NodeName = 'Value') do begin 61 if TField(Row.Parent.Fields[I]).FieldType = ftString then begin 62 NewValue := TValueString.Create; 63 TValueString(NewValue).Value := Node2.TextContent; 64 end else 65 if TField(Row.Parent.Fields[I]).FieldType = ftDateTime then begin 66 NewValue := TValueDateTime.Create; 67 if Node2.TextContent <> '' then 68 TValueDateTime(NewValue).Value := XMLTimeToDateTime(Node2.TextContent); 69 end else NewValue := TValue.Create; 70 Row.Values.Add(NewValue); 71 Node2 := Node2.NextSibling; 72 Inc(I); 73 end; 74 end; 75 76 procedure TDatabaseXML.SaveNodeRecord(Row: TRecord; Node: TDOMNode); 77 var 78 I: Integer; 79 NewNode: TDOMNode; 80 begin 81 for I := 0 to Row.Values.Count - 1 do begin; 82 NewNode := Node.OwnerDocument.CreateElement('Value'); 83 Node.AppendChild(NewNode); 84 if TField(Row.Parent.Fields[I]).FieldType = ftString then 85 NewNode.TextContent := TValueString(Row.Values[I]).Value; 86 if TField(Row.Parent.Fields[I]).FieldType = ftDateTime then 87 NewNode.TextContent := DateTimeToXMLTime(TValueDateTime(Row.Values[I]).Value); 88 end; 89 end; 90 91 procedure TDatabaseXML.LoadNodeRecords(Records: TRecords; Node: TDOMNode); 92 var 93 Node2: TDOMNode; 94 NewRecord: TRecord; 95 begin 96 Records.Count := 0; 97 Node2 := Node.FirstChild; 98 while Assigned(Node2) and (Node2.NodeName = 'Record') do begin 99 NewRecord := TRecord.Create; 100 NewRecord.Parent := Records.Parent; 101 LoadNodeRecord(NewRecord, Node2); 102 Records.Add(NewRecord); 103 Node2 := Node2.NextSibling; 104 end; 105 end; 106 107 procedure TDatabaseXML.SaveNodeRecords(Records: TRecords; Node: TDOMNode); 108 var 109 I: Integer; 110 NewNode: TDOMNode; 111 begin 112 for I := 0 to Records.Count - 1 do begin; 113 NewNode := Node.OwnerDocument.CreateElement('Record'); 114 Node.AppendChild(NewNode); 115 SaveNodeRecord(TRecord(Records.Items[I]), NewNode); 116 end; 117 end; 118 47 119 procedure TDatabaseXML.LoadNodeField(Field: TField; Node: TDOMNode); 48 120 begin … … 97 169 if Assigned(NewNode) then 98 170 LoadNodeFields(Table.Fields, NewNode); 171 172 NewNode := Node.FindNode('Records'); 173 if Assigned(NewNode) then 174 LoadNodeRecords(Table.Records, NewNode); 99 175 end; 100 176 … … 108 184 Node.AppendChild(NewNode); 109 185 SaveNodeFields(Table.Fields, NewNode); 186 187 NewNode := Node.OwnerDocument.CreateElement('Records'); 188 Node.AppendChild(NewNode); 189 SaveNodeRecords(Table.Records, NewNode); 110 190 end; 111 191 … … 164 244 RootNode: TDOMNode; 165 245 begin 246 if FileName = '' then exit; 166 247 Doc := TXMLDocument.Create; 167 248 with Doc do try
Note:
See TracChangeset
for help on using the changeset viewer.