Changeset 3


Ignore:
Timestamp:
Jan 18, 2015, 5:25:37 PM (9 years ago)
Author:
chronos
Message:
  • Added: Support for editing String and DateTime value types in record edit form.
Location:
trunk
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        33MyData.lps
        44data.xml
         5Config.xml

  • trunk/Forms/UFormField.lfm

    r2 r3  
    2626  end
    2727  object ButtonOk: TButton
    28     Left = 624
     28    Left = 880
    2929    Height = 25
    30     Top = 312
     30    Top = 400
    3131    Width = 75
     32    Anchors = [akRight, akBottom]
    3233    Caption = 'Ok'
    3334    ModalResult = 1
    … …  
    5960    Left = 16
    6061    Height = 25
    61     Top = 146
     62    Top = 144
    6263    Width = 93
    6364    Caption = 'Text after:'
    … …  
    7475  object ComboBoxType: TComboBox
    7576    Left = 167
    76     Height = 35
     77    Height = 37
    7778    Top = 48
    7879    Width = 265
    7980    ItemHeight = 0
     81    OnChange = ComboBoxTypeChange
    8082    Style = csDropDownList
    8183    TabOrder = 4
    8284  end
    8385  object ButtonCancel: TButton
    84     Left = 528
     86    Left = 784
    8587    Height = 25
    86     Top = 312
     88    Top = 400
    8789    Width = 75
     90    Anchors = [akRight, akBottom]
    8891    Caption = 'Cancel'
    8992    ModalResult = 2
    9093    TabOrder = 5
    9194  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
    92181end

  • trunk/Forms/UFormField.pas

    r2 r3  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   UDatabase;
     9  ComCtrls, EditBtn, UDatabase;
    1010
    1111type
    … …  
    1717    ButtonCancel: TButton;
    1818    ComboBoxType: TComboBox;
     19    DateEditMin: TDateEdit;
     20    DateEditMax: TDateEdit;
    1921    EditName: TEdit;
     22    EditStringDefault: TEdit;
    2023    EditTextBefore: TEdit;
    2124    EditTextAfter: TEdit;
    … …  
    2427    Label3: TLabel;
    2528    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);
    2638    procedure FormCreate(Sender: TObject);
    2739    procedure FormShow(Sender: TObject);
    … …  
    5567end;
    5668
     69procedure TFormField.ComboBoxTypeChange(Sender: TObject);
     70begin
     71  PageControl1.TabIndex := ComboBoxType.ItemIndex;
     72end;
     73
    5774procedure TFormField.Load(Field: TField);
    5875begin
    … …  
    6178  EditTextBefore.Text := Field.TextBefore;
    6279  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;
    6387end;
    6488
    … …  
    6993  Field.TextAfter := EditTextAfter.Text;
    7094  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;
    71101end;
    72102

  • trunk/Forms/UFormFields.pas

    r2 r3  
    66
    77uses
    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;
    1010
    1111type

  • trunk/Forms/UFormRecord.lfm

    r2 r3  
    11object FormRecord: TFormRecord
    2   Left = 837
    3   Height = 240
    4   Top = 298
    5   Width = 320
     2  Left = 639
     3  Height = 694
     4  Top = 174
     5  Width = 859
    66  Caption = 'FormRecord'
     7  ClientHeight = 694
     8  ClientWidth = 859
     9  OnCreate = FormCreate
     10  OnDestroy = FormDestroy
     11  OnShow = FormShow
    712  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
    854end

  • trunk/Forms/UFormRecord.pas

    r2 r3  
    66
    77uses
    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;
    910
    1011type
     12
     13  { TFormRecord }
     14
    1115  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);
    1227  private
    1328    { private declarations }
    … …  
    1530    Table: TTable;
    1631    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);
    1737  end;
    1838
    … …  
    2444{$R *.lfm}
    2545
     46{ TFormRecord }
     47
     48procedure TFormRecord.FormShow(Sender: TObject);
     49begin
     50  ReloadControls;
     51end;
     52
     53procedure TFormRecord.ACancelExecute(Sender: TObject);
     54begin
     55  ModalResult := mrCancel;
     56  Close;
     57end;
     58
     59procedure TFormRecord.ASaveExecute(Sender: TObject);
     60begin
     61  ModalResult := mrOk;
     62  Close;
     63end;
     64
     65procedure TFormRecord.FormCreate(Sender: TObject);
     66begin
     67  Controls := TObjectList.Create;
     68  Labels := TObjectList.Create;
     69end;
     70
     71procedure TFormRecord.FormDestroy(Sender: TObject);
     72begin
     73  Labels.Free;
     74  Controls.Free;
     75end;
     76
     77procedure TFormRecord.ReloadControls;
     78begin
     79end;
     80
     81procedure TFormRecord.Load(DataRecord: TRecord);
     82var
     83  I: Integer;
     84  NewLabel: TLabel;
     85  NewControl: TControl;
     86  CellRect: TRect;
     87begin
     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;
     123end;
     124
     125procedure TFormRecord.Save(DataRecord: TRecord);
     126var
     127  I: Integer;
     128begin
     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;
     135end;
     136
    26137end.
    27138

  • trunk/Forms/UFormRecords.lfm

    r2 r3  
    3131    TabOrder = 0
    3232    ViewStyle = vsReport
     33    OnData = ListView1Data
    3334    OnDblClick = AModifyExecute
    3435    OnSelectItem = ListView1SelectItem

  • trunk/Forms/UFormRecords.pas

    r2 r3  
    3131    procedure ARemoveExecute(Sender: TObject);
    3232    procedure FormShow(Sender: TObject);
     33    procedure ListView1Data(Sender: TObject; Item: TListItem);
    3334    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
    3435      Selected: Boolean);
    … …  
    4647implementation
    4748
     49uses
     50  UFormRecord;
     51
    4852{$R *.lfm}
    4953
    … …  
    5357begin
    5458  Caption := 'Table - ' + Table.Name;
    55   UpdateInterface;
     59  ReloadList;
     60end;
     61
     62procedure TFormRecords.ListView1Data(Sender: TObject; Item: TListItem);
     63var
     64  I: Integer;
     65begin
     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
    5674end;
    5775
    … …  
    6482procedure TFormRecords.AModifyExecute(Sender: TObject);
    6583begin
    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;
    6792end;
    6893
    6994procedure TFormRecords.ARemoveExecute(Sender: TObject);
    7095begin
    71 
     96  if Assigned(ListView1.Selected) then begin
     97    Table.Records.Remove(ListView1.Selected.Data);
     98    ReloadList;
     99  end;
    72100end;
    73101
    74102procedure TFormRecords.AAddExecute(Sender: TObject);
     103var
     104  NewRecord: TRecord;
     105  ValueClass: TValueClass;
     106  I: Integer;
     107  NewValue: TValue;
    75108begin
     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;
    76117
     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;
    77125end;
    78126
    … …  
    84132
    85133procedure TFormRecords.ReloadList;
     134var
     135  I: Integer;
     136  NewColumn: TListColumn;
    86137begin
     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
    87145  ListView1.Items.Count := Table.Records.Count;
    88146  ListView1.Repaint;

  • trunk/Forms/UFormTables.lfm

    r2 r3  
    77  ClientHeight = 660
    88  ClientWidth = 978
     9  OnActivate = FormActivate
     10  OnClose = FormClose
    911  OnShow = FormShow
    1012  LCLVersion = '1.3'

  • trunk/Forms/UFormTables.pas

    r2 r3  
    3838    procedure AShowFieldsExecute(Sender: TObject);
    3939    procedure AShowRecordsExecute(Sender: TObject);
     40    procedure FormActivate(Sender: TObject);
     41    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    4042    procedure FormShow(Sender: TObject);
    4143    procedure ListView1Data(Sender: TObject; Item: TListItem);
    … …  
    116118    Database.Tables.Remove(ListView1.Selected.Data);
    117119    ReloadList;
    118     UpdateInterface;
    119120  end;
    120121end;
    … …  
    138139end;
    139140
     141procedure TFormMain.FormActivate(Sender: TObject);
     142begin
     143  Core.Init;
     144end;
     145
     146procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     147begin
     148  Core.Done;
     149end;
     150
    140151procedure TFormMain.FormShow(Sender: TObject);
    141152begin
    142153  Database := Core.Database;
    143154  ReloadList;
    144   UpdateInterface;
    145155end;
    146156
    … …  
    149159  ListView1.Items.Count := Database.Tables.Count;
    150160  ListView1.Repaint;
     161  FormMain.UpdateInterface;
    151162end;
    152163

  • trunk/MyData.lpi

    r2 r3  
    1717      <StringTable ProductVersion=""/>
    1818    </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>
    2160    </BuildModes>
    2261    <PublishOptions>
    … …  
    2867      </local>
    2968    </RunParams>
    30     <RequiredPackages Count="2">
     69    <RequiredPackages Count="3">
    3170      <Item1>
    32         <PackageName Value="Common"/>
     71        <PackageName Value="FCL"/>
    3372      </Item1>
    3473      <Item2>
     74        <PackageName Value="Common"/>
     75      </Item2>
     76      <Item3>
    3577        <PackageName Value="LCL"/>
    36       </Item2>
     78      </Item3>
    3779    </RequiredPackages>
    3880    <Units Count="10">
    … …  
    71113        <IsPartOfProject Value="True"/>
    72114        <ComponentName Value="FormTable"/>
     115        <HasResources Value="True"/>
    73116        <ResourceBaseClass Value="Form"/>
    74117        <UnitName Value="UFormTable"/>
    … …  
    78121        <IsPartOfProject Value="True"/>
    79122        <ComponentName Value="FormRecords"/>
     123        <HasResources Value="True"/>
    80124        <ResourceBaseClass Value="Form"/>
    81125        <UnitName Value="UFormRecords"/>
    … …  
    85129        <IsPartOfProject Value="True"/>
    86130        <ComponentName Value="FormRecord"/>
     131        <HasResources Value="True"/>
    87132        <ResourceBaseClass Value="Form"/>
    88133        <UnitName Value="UFormRecord"/>
    … …  
    92137        <IsPartOfProject Value="True"/>
    93138        <ComponentName Value="FormFields"/>
     139        <HasResources Value="True"/>
    94140        <ResourceBaseClass Value="Form"/>
    95141        <UnitName Value="UFormFields"/>
    … …  
    99145        <IsPartOfProject Value="True"/>
    100146        <ComponentName Value="FormField"/>
     147        <HasResources Value="True"/>
    101148        <ResourceBaseClass Value="Form"/>
    102149        <UnitName Value="UFormField"/>
    … …  
    117164      <SyntaxOptions>
    118165        <SyntaxMode Value="Delphi"/>
     166        <CStyleOperator Value="False"/>
     167        <IncludeAssertionCode Value="True"/>
     168        <AllowLabel Value="False"/>
     169        <CPPInline Value="False"/>
    119170      </SyntaxOptions>
    120171    </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>
    121181    <Linking>
     182      <Debugging>
     183        <UseHeaptrc Value="True"/>
     184      </Debugging>
    122185      <Options>
    123186        <Win32>
    … …  
    126189      </Options>
    127190    </Linking>
     191    <Other>
     192      <CustomOptions Value="-dDEBUG"/>
     193    </Other>
    128194  </CompilerOptions>
    129195  <Debugging>

  • trunk/UCore.lfm

    r2 r3  
    1111    top = 137
    1212  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
    1329end

  • trunk/UCore.pas

    r2 r3  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Controls, UDatabase;
     8  Classes, SysUtils, XMLConf, FileUtil, Controls, ActnList, UDatabase, Forms;
    99
    1010type
    … …  
    1313
    1414  TCore = class(TDataModule)
     15    AExit: TAction;
     16    ActionList1: TActionList;
    1517    ImageList1: TImageList;
     18    XMLConfig1: TXMLConfig;
     19    procedure AExitExecute(Sender: TObject);
    1620    procedure DataModuleCreate(Sender: TObject);
    1721    procedure DataModuleDestroy(Sender: TObject);
    1822  private
    19     { private declarations }
     23    Initialized: Boolean;
    2024  public
    2125    Database: TDatabase;
     26    procedure LoadConfig;
     27    procedure SaveConfig;
     28    procedure Init;
     29    procedure Done;
    2230  end;
    2331
    … …  
    3745begin
    3846  Database := TDatabaseXML.Create;
    39   Database.ConnectionString := 'file:///home/chronos/Projekty/test/MyData/data.xml';
    40   Database.Load;
     47end;
     48
     49procedure TCore.AExitExecute(Sender: TObject);
     50begin
     51  FormMain.Close;
    4152end;
    4253
    4354procedure TCore.DataModuleDestroy(Sender: TObject);
    4455begin
     56  Database.Free;
     57end;
     58
     59procedure TCore.LoadConfig;
     60begin
     61  Database.ConnectionString := XMLConfig1.GetValue('ConnectionString', 'file://' + ExtractFileDir(Application.ExeName) + '/data.xml');
     62end;
     63
     64procedure TCore.SaveConfig;
     65begin
     66  XMLConfig1.SetValue('ConnectionString', Database.ConnectionString);
     67end;
     68
     69procedure TCore.Init;
     70begin
     71  if not Initialized then begin
     72    Initialized := True;
     73    LoadConfig;
     74    Database.Load;
     75    FormMain.ReloadList;
     76  end;
     77end;
     78
     79procedure TCore.Done;
     80begin
    4581  Database.Save;
    46   Database.Free;
     82  SaveConfig;
    4783end;
    4884

  • trunk/UDatabase.pas

    r2 r3  
    66
    77uses
    8   Classes, SysUtils, Contnrs;
     8  Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn;
    99
    1010type
     11  TTable = class;
     12
    1113  TFieldType = (ftString, ftNumeric, ftDateTime, ftBoolean, ftFloat, ftImage,
    1214    ftDate, tfTime, ftMapPosition);
    1315
     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
    14102  { TField }
    15103
    16104  TField = class
     105  private
     106    FFieldType: TFieldType;
     107    procedure SetFieldType(AValue: TFieldType);
     108  public
    17109    Name: string;
    18     FieldType: TFieldType;
     110    TypeRelated: TFieldTypeSpecific;
    19111    Required: Boolean;
    20112    ReadOnly: Boolean;
    … …  
    25117    Pos: TPoint;
    26118    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;
    45122  end;
    46123
    … …  
    48125  end;
    49126
    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 }
    67128
    68129  TRecord = class
     130    Parent: TTable;
    69131    Values: TValues;
     132    constructor Create;
     133    destructor Destroy; override;
    70134  end;
    71135
    72136  TRecords = class(TObjectList)
    73 
     137    Parent: TTable;
    74138  end;
    75139
    … …  
    105169  FieldTypeString: array[TFieldType] of string = ('String', 'Numeric', 'DateTime',
    106170    'Boolean', 'Float', 'Image', 'Date', 'Time', 'MapPosition');
     171  FieldTypeClass: array[TFieldType] of TFieldTypeSpecificClass = (TFieldString,
     172    TFieldInteger, TFieldDateTime, TFieldBoolean, TFieldFloat, TFieldImage,
     173    TFieldDate, TFieldTime, TFieldMapPosition);
    107174
    108175
    109176implementation
    110177
     178{ TFieldDateTime }
     179
     180function TFieldDateTime.GetValueClass: TValueClass;
     181begin
     182  Result := TValueDateTime;
     183end;
     184
     185{ TValueDateTime }
     186
     187function TValueDateTime.GetString: string;
     188begin
     189  Result := DateTimeToStr(Value);
     190end;
     191
     192{ TRecord }
     193
     194constructor TRecord.Create;
     195begin
     196  Values := TValues.Create;
     197end;
     198
     199destructor TRecord.Destroy;
     200begin
     201  Values.Free;
     202  inherited Destroy;
     203end;
     204
     205{ TValueString }
     206
     207function TValueString.GetString: string;
     208begin
     209  Result := Value;
     210end;
     211
     212{ TValue }
     213
     214function TValue.GetString: string;
     215begin
     216  Result := '';
     217end;
     218
     219{ TFieldString }
     220
     221function TFieldString.GetValueClass: TValueClass;
     222begin
     223  Result := TValueString;
     224end;
     225
     226{ TFieldTypeSpecific }
     227
     228function TFieldTypeSpecific.GetValueClass: TValueClass;
     229begin
     230  Result := TValue;
     231end;
     232
    111233{ TField }
    112234
     235procedure TField.SetFieldType(AValue: TFieldType);
     236begin
     237  if FFieldType = AValue then Exit;
     238  if Assigned(TypeRelated) then TypeRelated.Free;
     239  FFieldType := AValue;
     240  TypeRelated := FieldTypeClass[FFieldType].Create;
     241end;
     242
     243function TField.GetValueClass: TValueClass;
     244begin
     245  if Assigned(TypeRelated) then Result := TypeRelated.GetValueClass
     246    else Result := TValue;
     247end;
     248
     249constructor TField.Create;
     250begin
     251  TypeRelated := TFieldString.Create;
     252end;
     253
     254{ TField }
     255
    113256
    114257{ TTable }
    … …  
    117260begin
    118261  Records := TRecords.Create;
     262  Records.Parent := Self;
    119263  Fields := TFields.Create;
    120264end;

  • trunk/UDatabaseXML.pas

    r2 r3  
    1414  private
    1515    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);
    1620    procedure LoadNodeField(Field: TField; Node: TDOMNode);
    1721    procedure SaveNodeField(Field: TField; Node: TDOMNode);
    … …  
    4549end;
    4650
     51procedure TDatabaseXML.LoadNodeRecord(Row: TRecord; Node: TDOMNode);
     52var
     53  Node2: TDOMNode;
     54  NewValue: TValue;
     55  I: Integer;
     56begin
     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;
     74end;
     75
     76procedure TDatabaseXML.SaveNodeRecord(Row: TRecord; Node: TDOMNode);
     77var
     78  I: Integer;
     79  NewNode: TDOMNode;
     80begin
     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;
     89end;
     90
     91procedure TDatabaseXML.LoadNodeRecords(Records: TRecords; Node: TDOMNode);
     92var
     93  Node2: TDOMNode;
     94  NewRecord: TRecord;
     95begin
     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;
     105end;
     106
     107procedure TDatabaseXML.SaveNodeRecords(Records: TRecords; Node: TDOMNode);
     108var
     109  I: Integer;
     110  NewNode: TDOMNode;
     111begin
     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;
     117end;
     118
    47119procedure TDatabaseXML.LoadNodeField(Field: TField; Node: TDOMNode);
    48120begin
    … …  
    97169  if Assigned(NewNode) then
    98170    LoadNodeFields(Table.Fields, NewNode);
     171
     172  NewNode := Node.FindNode('Records');
     173  if Assigned(NewNode) then
     174    LoadNodeRecords(Table.Records, NewNode);
    99175end;
    100176
    … …  
    108184  Node.AppendChild(NewNode);
    109185  SaveNodeFields(Table.Fields, NewNode);
     186
     187  NewNode := Node.OwnerDocument.CreateElement('Records');
     188  Node.AppendChild(NewNode);
     189  SaveNodeRecords(Table.Records, NewNode);
    110190end;
    111191
    … …  
    164244  RootNode: TDOMNode;
    165245begin
     246  if FileName = '' then exit;
    166247  Doc := TXMLDocument.Create;
    167248  with Doc do try
Note: See TracChangeset for help on using the changeset viewer.