Check-in [ca9a02c2ab]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Kept a reference to M_Main in the DPR, to prevent errors in the IDE. Added prototype for database-persistence of a class.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ca9a02c2aba4de8897c436f2daf1a32eb7ba68f2
User & Date: MCO 2014-07-09 17:18:00
Context
2014-07-28
14:24
Added activity form, including attachment handling. Added date range selection to list of activities. Renamed controls to English. Added button on projects list to view activities and reports. Disabled platform warnings. check-in: c6e0ad17ef user: MCO tags: trunk
2014-07-09
17:18
Kept a reference to M_Main in the DPR, to prevent errors in the IDE. Added prototype for database-persistence of a class. check-in: ca9a02c2ab user: MCO tags: trunk
2014-07-07
19:26
Added contact detail form. Added main menu to project detail form. Added prototype code to add/edit/delete buttons for subprojects. Added prototype code to add contact to project. check-in: edb8c1c052 user: MCO tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Olam/src/M_Main.pas. 

45
46
47
48
49
50
51
52
53
54
55
56
57
58

59

60

61
62
63

begin
  TfrmProject.Create(Application).Show;
end {TdmMain.actProjectAddExecute};

{ ---------------------------------------------------------------------------- }
procedure TdmMain.dlgOpenPictureTypeChange(Sender: TObject);
var
  Items: TArray<string>;
  Filter: string;
  CharPos: Integer;
begin
  Items := dlgOpenPicture.Filter.Split(['|']);
  Filter := Items[(dlgOpenPicture.FilterIndex - 1) * 2];
  CharPos := Pos('.', Filter);

  if CharPos > 0 then

    dlgOpenPicture.DefaultExt := Copy(Filter, CharPos + 1);

end {TdmMain.dlgOpenPictureTypeChange};

end.








<



|
<

>
|
>
|
>




45
46
47
48
49
50
51

52
53
54
55

56
57
58
59
60
61
62
63
64

begin
  TfrmProject.Create(Application).Show;
end {TdmMain.actProjectAddExecute};

{ ---------------------------------------------------------------------------- }
procedure TdmMain.dlgOpenPictureTypeChange(Sender: TObject);
var

  Filter: string;
  CharPos: Integer;
begin
  Filter := dlgOpenPicture.Filter.Split(['|'])[(dlgOpenPicture.FilterIndex - 1) * 2 + 1];

  CharPos := Pos('.', Filter);
  if (Pos(TFormatSettings.Create.ListSeparator, Filter) > 0) or (CharPos = 0) then begin
    dlgOpenPicture.DefaultExt := '';
  end else begin
    dlgOpenPicture.DefaultExt := Copy(Filter, CharPos);
  end;
end {TdmMain.dlgOpenPictureTypeChange};

end.

Changes to Olam/src/Olam.dpr. 

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18

program Olam;

uses
  Vcl.Forms,
  M_Main {dmMain: TDataModule},
  F_Projects {frmProjects},
  F_Activities {frmActivities};


{$R *.res}

begin
  Application.Initialize;
//  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmProjects, frmProjects);
  Application.CreateForm(TdmMain, dmMain);
  Application.CreateForm(TfrmActivities, frmActivities);
  Application.Run;
end.





|

|
>












1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

program Olam;

uses
  Vcl.Forms,
  M_Main in 'M_Main.pas' {dmMain: TDataModule},
  F_Projects {frmProjects},
  F_Activities {frmActivities}{,
  U_AutoDB in 'U_AutoDB.pas'};

{$R *.res}

begin
  Application.Initialize;
//  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmProjects, frmProjects);
  Application.CreateForm(TdmMain, dmMain);
  Application.CreateForm(TfrmActivities, frmActivities);
  Application.Run;
end.

Changes to Olam/src/Olam.dproj. 

84
85
86
87
88
89
90




91
92
93
94
95
96
97

        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
        <DCC_DebugInformation>0</DCC_DebugInformation>
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>




        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
        </BuildConfiguration>








>
>
>
>








84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
        <DCC_DebugInformation>0</DCC_DebugInformation>
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="M_Main.pas">
            <Form>dmMain</Form>
            <DesignClass>TDataModule</DesignClass>
        </DCCReference>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
        </BuildConfiguration>

Added Olam/src/U_AutoDB.pas. 



















































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

unit U_AutoDB;

interface
uses
  TypInfo, RTTI;

type
  TAutoDBBase = class

  end;

  TAutoDB = class(TAutoDBBase)

  end;

  TAutoRow = class(TAutoDBBase)

  end;

  TAutoRowCollection = class(TAutoDBBase)

  end;

  TAutoRowCollection<T: TAutoRow> = class(TAutoRowCollection)

  end;

implementation
uses
  Classes;

function QuoteDB(const Name: string): string;
begin
  Result := '"' + Name + '"';
end;

function DBNameFromClassName(const DBName: string): string;
begin
  // TODO: remove initial T or I if present?
  // TODO: quote if necessary
  Result := DBName;
end;

function TypeDescendsFrom(const PropType: TRttiType; const ClassName: string): Boolean;
begin
  Result := Assigned(PropType) and
            ((PropType.Name = ClassName) or TypeDescendsFrom(PropType.BaseType, ClassName));
end;

function GenerateCreateTable(const Row: TObject): string;
var
  RC: TRTTIContext;
  RowType: TRttiType;
  Props: TArray<TRttiProperty>;
  Prop: TRttiProperty;
  DataType: string;
begin
  if not Assigned(Row) then
    Exit;

  RC := TRttiContext.Create;
  try
    RowType := RC.GetType(Row.ClassType);
    Props := RowType.GetProperties;
    for Prop in Props do begin
      if Result <> '' then
        Result := Result + #10', ';
      if (Prop.Visibility = mvPublished)
          and Prop.IsReadable
          and (Prop.IsWritable or (Prop.PropertyType.TypeKind = tkClass))
      then begin
        DataType := '';
        case Prop.PropertyType.TypeKind of
          tkInteger, tkInt64: DataType := 'INTEGER';
          tkFloat:            DataType := 'FLOAT';
          tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
                              DataType := 'TEXT';
          tkEnumeration:      DataType := 'TEXT';
          tkSet:              DataType := 'TEXT';
          tkVariant:          DataType := 'ANY';
          tkClass: begin
            // test if property descends from TAutoDBBase
            if TypeDescendsFrom(Prop.PropertyType, TAutoDBBase.ClassName) then begin
              // if property descends from TAutoRowCollection, skip because it should come back in a link table
              if not TypeDescendsFrom(Prop.PropertyType, TAutoRowCollection.ClassName) then
                Continue;

              DataType := 'INTEGER  REFERENCES ' + DBNameFromClassName(Prop.PropertyType.Name);
            end else if TypeDescendsFrom(Prop.PropertyType, 'TStream') then begin
              DataType := 'BLOB';
            end;
          end;
//          tkRecord: ;     // TODO: treat same as class?
//          tkInterface: ;  // TODO: treat same as class?
//          tkArray: ;
//          tkDynArray: ;
//          tkUnknown: ;
//          tkMethod: ;
//          tkClassRef: ;
//          tkPointer: ;
//          tkProcedure: ;
        end;
        // Skip properties with unrecognized datatype
        if DataType <> '' then begin
          if Result <> '' then
            Result := Result + #10', ';
          Result := QuoteDB(Prop.Name) + #9 + DataType;
        end;
      end;
    end;

    Result := 'CREATE TABLE ' + DBNameFromClassName(RowType.Name) +
              #10'( ' + Result +
              #10');';
  finally
    RC.Free;
  end;
end;

end.

Fossil version [20187be723] 2019-11-11 15:22:09