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.

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);

        <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>

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.