* Improvements to tiopf code generator, and build project for use with lazarus

git-svn-id: trunk@11354 -

.gitattributes

@@ -1161,6 +1161,8 @@ packages/fcl-db/src/base/fpmake.inc svneol=native#text/plain
 packages/fcl-db/src/base/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/Makefile svneol=native#text/plain
 packages/fcl-db/src/codegen/Makefile.fpc svneol=native#text/plain
+packages/fcl-db/src/codegen/buildddcg.lpi svneol=native#text/plain
+packages/fcl-db/src/codegen/buildddcg.lpr svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgcreatedbf.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgdbcoll.pp svneol=native#text/plain
 packages/fcl-db/src/codegen/fpcgsqlconst.pp svneol=native#text/plain

packages/fcl-db/src/codegen/buildddcg.lpi

@@ -0,0 +1,224 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="7">
+      <Unit0>
+        <Filename Value="buildddcg.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="buildddcg"/>
+        <CursorPos X="18" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="52"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="fpddpopcode.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpddpopcode"/>
+        <UsageCount Value="52"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="fpcgcreatedbf.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpcgcreatedbf"/>
+        <UsageCount Value="52"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="fpcgdbcoll.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpcgdbcoll"/>
+        <UsageCount Value="52"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="fpcgsqlconst.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpcgsqlconst"/>
+        <UsageCount Value="52"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="fpcgtiopf.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpcgtiopf"/>
+        <CursorPos X="37" Y="474"/>
+        <TopLine Value="457"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="52"/>
+        <Loaded Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="fpddcodegen.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpddcodegen"/>
+        <CursorPos X="3" Y="638"/>
+        <TopLine Value="635"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="52"/>
+        <Loaded Value="True"/>
+      </Unit6>
+    </Units>
+    <JumpHistory Count="30" HistoryIndex="29">
+      <Position1>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="791" Column="1" TopLine="779"/>
+      </Position1>
+      <Position2>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position2>
+      <Position3>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="241" Column="38" TopLine="216"/>
+      </Position3>
+      <Position4>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="739" Column="56" TopLine="714"/>
+      </Position4>
+      <Position5>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="769" Column="36" TopLine="744"/>
+      </Position5>
+      <Position6>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="791" Column="34" TopLine="766"/>
+      </Position6>
+      <Position7>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="820" Column="32" TopLine="795"/>
+      </Position7>
+      <Position8>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="835" Column="32" TopLine="810"/>
+      </Position8>
+      <Position9>
+        <Filename Value="fpddcodegen.pp"/>
+        <Caret Line="235" Column="15" TopLine="210"/>
+      </Position9>
+      <Position10>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="124" Column="26" TopLine="124"/>
+      </Position10>
+      <Position11>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="888" Column="1" TopLine="839"/>
+      </Position11>
+      <Position12>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="715" Column="18" TopLine="693"/>
+      </Position12>
+      <Position13>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="59" Column="30" TopLine="34"/>
+      </Position13>
+      <Position14>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="417" Column="46" TopLine="392"/>
+      </Position14>
+      <Position15>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="205" Column="9" TopLine="192"/>
+      </Position15>
+      <Position16>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="820" Column="1" TopLine="796"/>
+      </Position16>
+      <Position17>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="821" Column="49" TopLine="795"/>
+      </Position17>
+      <Position18>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position18>
+      <Position19>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="79" Column="33" TopLine="54"/>
+      </Position19>
+      <Position20>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="819" Column="31" TopLine="795"/>
+      </Position20>
+      <Position21>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="376" Column="31" TopLine="362"/>
+      </Position21>
+      <Position22>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="882" Column="28" TopLine="839"/>
+      </Position22>
+      <Position23>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="881" Column="21" TopLine="842"/>
+      </Position23>
+      <Position24>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="16" Column="1" TopLine="1"/>
+      </Position24>
+      <Position25>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="881" Column="28" TopLine="842"/>
+      </Position25>
+      <Position26>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="882" Column="23" TopLine="842"/>
+      </Position26>
+      <Position27>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position27>
+      <Position28>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="79" Column="33" TopLine="54"/>
+      </Position28>
+      <Position29>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="883" Column="5" TopLine="842"/>
+      </Position29>
+      <Position30>
+        <Filename Value="fpcgtiopf.pp"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position30>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <UnitOutputDirectory Value="../../units/$(TARGETCPU)-$(TARGETOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

packages/fcl-db/src/codegen/buildddcg.lpr

@@ -0,0 +1,15 @@
+program buildddcg;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes
+  { you can add units after this }, fpddpopcode, fpcgcreatedbf, fpcgdbcoll,
+  fpcgsqlconst, fpcgtiopf, fpddcodegen;
+
+begin
+end.
+

packages/fcl-db/src/codegen/fpcgtiopf.pp

@@ -23,7 +23,7 @@ uses
   Classes, SysUtils, db, fpddcodegen;
   
 TYpe
-  TClassOption = (caConstructor,caDestructor,caCreateList,caListAddMethod,caListItemsProperty);
+  TClassOption = (caCreateClass,caConstructor,caDestructor,caCreateList,caListAddMethod,caListItemsProperty);
   TClassOptions = Set of TClassOption;
   TVisitorOption = (voRead,voReadList,voCreate,voDelete,voUpdate);
   TVisitorOptions = set of TVisitorOption;
@@ -61,6 +61,7 @@ TYpe
     procedure DeclareObjectvariable(Strings: TStrings;
       const ObjectClassName: String);
   private
+    Function CreateSQLStatement(V: TVisitorOption) : String;
     function GetOpt: TTiOPFCodeOptions;
     procedure WriteCreateVisitor(Strings: TStrings; const ObjectClassName: String);
     procedure WriteDeleteVisitor(Strings: TStrings; const ObjectClassName: String);
@@ -68,6 +69,8 @@ TYpe
     procedure WriteParamAssign(Strings: TStrings; F: TFieldPropDef);
     procedure WriteReadListVisitor(Strings: TStrings; const ObjectClassName: String);
     procedure WriteReadVisitor(Strings: TStrings; const ObjectClassName: String );
+    procedure WriteSetSQL(Strings: TStrings; const ASQL: String);
+    procedure WriteSQLConstants(Strings: TStrings);
     procedure WriteUpdateVisitor(Strings: TStrings; const ObjectClassName: String);
     procedure WriteVisitorDeclaration(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String);
     procedure WriteVisitorImplementation(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String);
@@ -75,6 +78,7 @@ TYpe
     // Not to be overridden.
     procedure WriteListAddObject(Strings: TStrings; const ListClassName, ObjectClassName: String);
     // Overrides of parent objects
+    function AllowPropertyDeclaration(F: TFieldPropDef; AVisibility: TVisibilities): Boolean; override;
     Function GetInterfaceUsesClause : string; override;
     Procedure DoGenerateInterface(Strings: TStrings); override;
     Procedure DoGenerateImplementation(Strings: TStrings); override;
@@ -92,6 +96,9 @@ TYpe
     Property TiOPFOptions : TTiOPFCodeOptions Read GetOpt;
   end;
 
+Const
+  SOID = 'OID'; // OID property.
+  
 implementation
 
 { TTiOPFCodeOptions }
@@ -118,7 +125,7 @@ end;
 constructor TTiOPFCodeOptions.Create;
 begin
   inherited Create;
-  FListAncestorName:='TObjectList';
+  FListAncestorName:='TTiObjectList';
   AncestorClass:='TTiObject';
   ObjectClassName:='MyObject';
   FVisitorOptions:=[voRead,voCreate,voDelete,voUpdate];
@@ -179,7 +186,7 @@ begin
   Result:=inherited GetInterfaceUsesClause;
   If (Result<>'') then
     Result:=Result+',';
-  Result:=Result+'tiVisitor, tiObject';
+  Result:=Result+'tiVisitor, tiVisitorDB, tiObject';
 end;
 
 procedure TTiOPFCodeGenerator.DoGenerateInterface(Strings: TStrings);
@@ -188,7 +195,8 @@ Var
   V : TVisitorOption;
 
 begin
-  inherited DoGenerateInterface(Strings);
+  If (caCreateClass in TiOPFOptions.ClassOptions) then
+    inherited DoGenerateInterface(Strings);
   With TiOPFOptions do
     begin
     IncIndent;
@@ -247,6 +255,109 @@ begin
   AddlN(Strings);
 end;
 
+Function TTiOPFCodeGenerator.CreateSQLStatement(V : TVisitorOption) : String;
+
+  Function AddToS(Const S,Add : String) : string;
+  
+  begin
+    Result:=S;
+    If (Result<>'') then
+      Result:=Result+', ';
+    Result:=Result+Add;
+  end;
+
+Var
+  I : integer;
+  W,S,VS,TN : String;
+  F : TFieldPropDef;
+
+begin
+  TN:='MyTable';
+  S:='';
+  VS:='';
+  W:='Your condition here';
+  Result:='';
+  Case V of
+   voRead,
+   voReadList : begin
+                Result:='SELECT ';
+                For I:=0 to Fields.Count-1 do
+                  begin
+                  F:=Fields[i];
+                  If F.Enabled then
+                    begin
+                    S:=AddToS(S,F.FieldName);
+                    If (F.PropertyName=SOID) then
+                      W:=Format('%s = :%s',[F.FieldName,F.FieldName]);
+                    end;
+                  end;
+                Result:=Result+S+Format(' FROM %s WHERE (%s);',[TN,W]);
+                end;
+   voCreate : begin
+              Result:=Format('INSERT INTO %s (',[TN]);
+              For I:=0 to Fields.Count-1 do
+                begin
+                F:=Fields[i];
+                If F.Enabled then
+                  begin
+                  S:=AddToS(S,F.FieldName);
+                  VS:=AddToS(VS,':'+F.FieldName);
+                  end;
+                end;
+              Result:=Result+S+') VALUES ('+VS+');';
+              end;
+   voDelete : begin
+              For I:=0 to Fields.Count-1 do
+                begin
+                F:=Fields[i];
+                If (F.PropertyName=SOID) then
+                  W:=Format('%s = :%s',[F.FieldName,F.FieldName]);
+                end;
+              Result:=Format('DELETE FROM %s WHERE (%s);',[TN,W]);
+              end;
+   voUpdate : begin
+              Result:=Format('UPDATE %s SET ',[TN]);
+              For I:=0 to Fields.Count-1 do
+                 begin
+                  F:=Fields[i];
+                  If F.Enabled then
+                    If (F.PropertyName=SOID) then
+                      W:=Format('%s = :%s',[F.FieldName,F.FieldName])
+                    else
+                      S:=AddToS(S,F.FieldName+' = :'+F.FieldName);
+                  end;
+              Result:=Result+S+Format(' WHERE (%s);',[W]);
+              end;
+  end;
+end;
+
+procedure TTiOPFCodeGenerator.WriteSQLConstants(Strings : TStrings);
+
+Const
+  VisSQL : Array [TVisitorOption] of string
+         = ('Read','ReadList','Create','Delete','Update');
+
+Var
+  OCN,S : String;
+  V : TVisitorOption;
+
+begin
+  AddLn(Strings,'Const');
+  IncIndent;
+  try
+    OCN:=StripType(TiOPFOptions.ObjectClassName);
+    For V:=Low(TVisitorOption) to High(TVisitorOption) do
+      If V in TiOPFOptions.VisitorOptions then
+        begin
+        S:=CreateSQLStatement(V);
+        S:=Format('SQL%s%s = ''%s'';',[VisSQL[V],OCN,S]);
+        AddLn(Strings,S);
+        end;
+  finally
+    DecIndent;
+  end;
+end;
+
 
 procedure TTiOPFCodeGenerator.DoGenerateImplementation(Strings: TStrings);
 
@@ -254,9 +365,12 @@ Var
   V : TVisitorOption;
 
 begin
-  inherited DoGenerateImplementation(Strings);
+  If (caCreateClass in TiOPFOptions.ClassOptions) then
+    inherited DoGenerateImplementation(Strings);
   With TiOPFOptions do
     begin
+    If (VisitorOptions<>[])   then
+      WriteSQLConstants(Strings);
     If caCreateList in ClassOptions then
       CreateListImplementation(Strings,ObjectClassName,ListClassName);
     For V:=Low(TVisitorOption) to High(TVisitorOption) do
@@ -308,9 +422,9 @@ begin
   If DeclareObject Then
     DeclareObjectVariable(Strings,ObjectClassName);
   AddLn(Strings,'begin');
+  IncIndent;
   If DeclareObject Then
     Addln(Strings,'O:=%s(Visited);',[ObjectClassName]);
-  IncIndent;
 end;
 
 Procedure TTiOPFCodeGenerator.DeclareObjectvariable(Strings : TStrings; Const ObjectClassName : String);
@@ -343,16 +457,19 @@ end;
 procedure TTiOPFCodeGenerator.WriteReadVisitor(Strings : TStrings; Const ObjectClassName : String);
 
 Var
-  C,S : String;
+  OCN,CS,C,S : String;
   I : Integer;
+  F : TFieldPropDef;
 
 begin
-  C:=Format('TRead%sVisitor',[StripType(ObjectClassName)]);
+  OCN:=StripType(ObjectClassName);
+  CS:=Format('SQLRead%s',[OCN]);
+  C:=Format('TRead%sVisitor',[OCN]);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
   S:=BeginInit(Strings,C);
-  Addln(Strings,'Query.SQL.Text:=SQLReadList;');
+  WriteSetSQL(Strings,CS);
   DecIndent;
   EndMethod(Strings,S);
   // AcceptVisitor
@@ -360,8 +477,12 @@ begin
   DecIndent;
   EndMethod(Strings,S);
   // AcceptSetupParams
-  S:=BeginSetupParams(Strings,C,'',False);
-  AddLn(Strings,'// Set up as needed');
+  F:=Fields.FindPropName('OID');
+  S:=BeginSetupParams(Strings,C,ObjectClassName,F<>Nil);
+  If (F<>Nil) then
+    WriteParamAssign(Strings,F)
+  else
+    AddLn(Strings,'// Set up as needed');
   DecIndent;
   EndMethod(Strings,S);
   // MapRowToObject
@@ -390,37 +511,40 @@ begin
   PN:=F.PropertyName;
   FN:=F.FieldName;
   SFN:=CreateString(FN);
-  Case F.PropertyType of
-    ptBoolean :
-      S:='AsBoolean';
-    ptShortint, ptByte,
-    ptSmallInt, ptWord,
-    ptLongint, ptCardinal :
-      S:='AsInteger';
-    ptInt64, ptQWord:
-      If F.FieldType=ftLargeInt then
-        R:=Format('O.%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
-      else
+  If (PN=SOID) then
+    R:=Format('O.OID.AssignFromTIQuery(''%s'',Query);',[FN])
+  else
+    Case F.PropertyType of
+      ptBoolean :
+        S:='AsBoolean';
+      ptShortint, ptByte,
+      ptSmallInt, ptWord,
+      ptLongint, ptCardinal :
         S:='AsInteger';
-    ptShortString, ptAnsiString, ptWideString :
-      S:='AsString';
-    ptSingle, ptDouble, ptExtended, ptComp :
-      S:='AsFloat';
-    ptCurrency :
-      S:='AsCurrency';
-    ptDateTime :
-      S:='AsDateTime';
-    ptEnumerated :
-      R:=Format('Integer(O.%s):=FieldAsInteger[%s];',[PN,SFN]);
-    ptSet :
-      S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
-    ptStream :
-      R:=Format('FieldByName(%s).SaveToStream(O.%s);',[SFN,PN]);
-    ptTStrings :
-      R:=Format('O.%s.Text:=FieldAsString[%s];',[PN,SFN]);
-    ptCustom :
-      R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
-  end;
+      ptInt64, ptQWord:
+        If F.FieldType=ftLargeInt then
+          R:=Format('O.%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
+        else
+          S:='AsInteger';
+      ptShortString, ptAnsiString, ptWideString :
+        S:='AsString';
+      ptSingle, ptDouble, ptExtended, ptComp :
+        S:='AsFloat';
+      ptCurrency :
+        S:='AsCurrency';
+      ptDateTime :
+        S:='AsDateTime';
+      ptEnumerated :
+        R:=Format('Integer(O.%s):=FieldAsInteger[%s];',[PN,SFN]);
+      ptSet :
+        S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
+      ptStream :
+        R:=Format('FieldByName(%s).SaveToStream(O.%s);',[SFN,PN]);
+      ptTStrings :
+        R:=Format('O.%s.Text:=FieldAsString[%s];',[PN,SFN]);
+      ptCustom :
+        R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
+    end;
   If (S<>'') then
     R:=Format('O.%s:=Field%s[%s];',[PN,S,SFN]);
   AddLn(Strings,R);
@@ -435,37 +559,40 @@ begin
   PN:=F.PropertyName;
   FN:=F.FieldName;
   SFN:=CreateString(FN);
-  Case F.PropertyType of
-    ptBoolean :
-      S:='AsBoolean';
-    ptShortint, ptByte,
-    ptSmallInt, ptWord,
-    ptLongint, ptCardinal :
-      S:='AsInteger';
-    ptInt64, ptQWord:
-      If F.FieldType=ftLargeInt then
-        R:=Format('O.%s:=(Name(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
-      else
+  If (PN=SOID) then
+    R:=Format('O.OID.AssignToTIQuery(''%s'',Query);',[FN])
+  else
+    Case F.PropertyType of
+      ptBoolean :
+        S:='AsBoolean';
+      ptShortint, ptByte,
+      ptSmallInt, ptWord,
+      ptLongint, ptCardinal :
         S:='AsInteger';
-    ptShortString, ptAnsiString, ptWideString :
-      S:='AsString';
-    ptSingle, ptDouble, ptExtended, ptComp :
-      S:='AsFloat';
-    ptCurrency :
-      S:='AsCurrency';
-    ptDateTime :
-      S:='AsDateTime';
-    ptEnumerated :
-      R:=Format('ParamAsInteger[%s]:=Integer(O.%s);',[SFN,PN]);
-    ptSet :
-      S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
-    ptStream :
-      R:=Format('AssignParamFromStream(%s,%s);',[SFN,PN]);
-    ptTStrings :
-      R:=Format('ParamAsString[%s]:=O.%s.Text;',[SFN,PN]);
-    ptCustom :
-      R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
-  end;
+      ptInt64, ptQWord:
+        If F.FieldType=ftLargeInt then
+          R:=Format('O.%s:=(Name(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
+        else
+          S:='AsInteger';
+      ptShortString, ptAnsiString, ptWideString :
+        S:='AsString';
+      ptSingle, ptDouble, ptExtended, ptComp :
+        S:='AsFloat';
+      ptCurrency :
+        S:='AsCurrency';
+      ptDateTime :
+        S:='AsDateTime';
+      ptEnumerated :
+        R:=Format('ParamAsInteger[%s]:=Integer(O.%s);',[SFN,PN]);
+      ptSet :
+        S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
+      ptStream :
+        R:=Format('AssignParamFromStream(%s,%s);',[SFN,PN]);
+      ptTStrings :
+        R:=Format('ParamAsString[%s]:=O.%s.Text;',[SFN,PN]);
+      ptCustom :
+        R:=Format('// Add custom loading code here for %s from %s',[PN,FN]);
+    end;
   If (S<>'') then
     R:=Format('O.%s:=Param%s[%s];',[PN,S,SFN]);
   AddLn(Strings,R);
@@ -478,17 +605,19 @@ end;
 procedure TTiOPFCodeGenerator.WriteReadListVisitor(Strings : TStrings; Const ObjectClassName : String);
 
 Var
-  C,S,LN : String;
+  OCN,CS,C,S,LN : String;
   I : Integer;
 
 begin
   LN:=tiOPFOptions.ListClassName;
+  OCN:=StripType(ObjectClassName);
+  CS:=Format('SQLReadList%s',[OCN]);
   C:=Format('TRead%sVisitor',[StripType(LN)]);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
   S:=BeginInit(Strings,C);
-  Addln(Strings,'Query.SQL.Text:=SQLReadList;');
+  WriteSetSQL(Strings,CS);
   DecIndent;
   EndMethod(Strings,C);
   // AcceptVisitor
@@ -519,16 +648,18 @@ procedure TTiOPFCodeGenerator.WriteCreateVisitor(Strings : TStrings; Const Objec
 
 
 Var
-  C,S : String;
+  OCN,CS,C,S : String;
   I : Integer;
 
 begin
-  C:=Format('TCreate%sVisitor',[StripType(ObjectClassName)]);
+  OCN:=StripType(ObjectClassName);
+  CS:=Format('SQLCreate%s',[OCN]);
+  C:=Format('TCreate%sVisitor',[OCN]);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
   S:=BeginInit(Strings,C);
-  Addln(Strings,'Query.SQL.Text:=SQLCreateObject;');
+  WriteSetSQL(Strings,CS);
   DecIndent;
   EndMethod(Strings,S);
   // AcceptVisitor
@@ -553,17 +684,26 @@ begin
   EndMethod(Strings,S);
 end;
 
+procedure TTiOPFCodeGenerator.WriteSetSQL(Strings : TStrings; Const ASQL : String);
+
+begin
+  Addln(Strings,Format('Query.SQL.Text:=%s;',[ASQL]));
+end;
+
 procedure TTiOPFCodeGenerator.WriteDeleteVisitor(Strings : TStrings; Const ObjectClassName : String);
 
 Var
-  C,S : String;
-
+  OCN,CS, C,S : String;
+  F : TFieldPropDef;
+  
 begin
+  OCN:=StripType(ObjectClassName);
+  CS:=Format('SQLDelete%s',[OCN]);
   C:=Format('TDelete%sVisitor',[StripType(ObjectClassName)]);
   Addln(Strings,'{ %s }',[C]);
   // Init
   S:=BeginInit(Strings,C);
-  Addln(Strings,'Query.SQL.Text:=SQLDeleteObject;');
+  WriteSetSQL(Strings,CS);
   DecIndent;
   EndMethod(Strings,S);
   // AcceptVisitor
@@ -573,7 +713,11 @@ begin
   EndMethod(Strings,S);
   // SetupParams
   S:=BeginSetupParams(Strings,C,ObjectClassName,True);
-  AddLn(Strings,'// Add parameter setup code here ');
+  F:=Fields.FindPropName('OID');
+  If (F<>Nil) then
+    WriteParamAssign(Strings,F)
+  else
+    AddLn(Strings,'// Add parameter setup code here ');
   DecIndent;
   EndMethod(Strings,S);
 end;
@@ -581,16 +725,18 @@ end;
 procedure TTiOPFCodeGenerator.WriteUpdateVisitor(Strings : TStrings; Const ObjectClassName : String);
 
 Var
-  C,S : String;
+  OCN,CS,C,S : String;
   I : Integer;
 
 begin
-  C:=Format('TUpdate%sVisitor',[StripType(ObjectClassName)]);
+  OCN:=StripType(ObjectClassName);
+  CS:=Format('SQLUpdate%s',[OCN]);
+  C:=Format('TUpdate%sVisitor',[OCN]);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
   S:=BeginInit(Strings,C);
-  Addln(Strings,'Query.SQL.Text:=SQLUpdateObject;');
+  WriteSetSQl(Strings,CS);
   DecIndent;
   EndMethod(Strings,S);
   // AcceptVisitor
@@ -630,8 +776,8 @@ begin
     AddLn(Strings,'Private');
     IncIndent;
     Try
-      AddLn(Strings,'Function GetObj(Index : Integer) : %s;',[ObjectClassname]);
-      AddLn(Strings,'Procedure SetObj(Index : Integer; AValue : %s);',[ObjectClassname]);
+      AddLn(Strings,'Function GetObj(AIndex : Integer) : %s;',[ObjectClassname]);
+      AddLn(Strings,'Procedure SetObj(AIndex : Integer; AValue : %s);',[ObjectClassname]);
     Finally
       DecIndent;
     end;
@@ -641,7 +787,7 @@ begin
     AddLn(Strings,'Public');
     IncIndent;
     Try
-      Addln(Strings,'Procedure Add(AnItem : %s); reintroduce;',[ObjectClassName]);
+      Addln(Strings,'Function Add(AnItem : %s) : Integer; reintroduce;',[ObjectClassName]);
     Finally
       DecIndent;
     end;
@@ -668,6 +814,7 @@ begin
   Addln(Strings,'%s = Class(%s)',[ListClassName,ListAncestorName]);
   DoCreateListDeclaration(Strings,ObjectClassName,ListClassName,ListAncestorName);
   AddLn(Strings,'end;');
+  Addln(Strings);
 end;
 
 procedure TTiOPFCodeGenerator.WriteListAddObject(Strings: TStrings;
@@ -677,16 +824,26 @@ Var
   S : String;
   
 begin
-   S:=Format('Procedure %s.Add(AnItem : %s);',[ListClassName,ObjectClassName]);
+   S:=Format('Function %s.Add(AnItem : %s) : Integer;',[ListClassName,ObjectClassName]);
    BeginMethod(Strings,S);
    Addln(Strings,'begin');
    IncIndent;
    try
-     Addln(Strings,'inherited Add(AnItem);');
+     Addln(Strings,'Result:=inherited Add(AnItem);');
    finally
      DecIndent;
    end;
    EndMethod(Strings,S);
+   Addln(Strings);
+end;
+
+function TTiOPFCodeGenerator.AllowPropertyDeclaration(F: TFieldPropDef;
+  AVisibility: TVisibilities): Boolean;
+begin
+  If F.PropertyName=SOID then
+    Result:=False
+  else
+    Result:=inherited AllowPropertyDeclaration(F, AVisibility);
 end;
 
 
@@ -700,27 +857,31 @@ begin
     begin
     AddLn(Strings,'{ %s }',[ListClassName]);
     AddLn(Strings);
-    S:=Format('Function %s.GetObj(Index : Integer) : %s;',[ListClassName,ObjectClassname]);
+    S:=Format('Function %s.GetObj(AIndex : Integer) : %s;',[ListClassName,ObjectClassname]);
     BeginMethod(Strings,S);
     AddLn(Strings,'begin');
     IncIndent;
     try
-      AddLn(Strings,'Result:=%s(Inherited Items[Index]);',[ObjectClassname]);
+      AddLn(Strings,'Result:=%s(Inherited Items[AIndex]);',[ObjectClassname]);
     finally
       DecIndent;
     end;
     EndMethod(Strings,S);
-    S:=Format('Procedure %s.SetObj(Index : Integer; AValue : %s);',[ListClassName,ObjectClassname]);
+    Addln(Strings);
+    S:=Format('Procedure %s.SetObj(AIndex : Integer; AValue : %s);',[ListClassName,ObjectClassname]);
     BeginMethod(Strings,S);
     AddLn(Strings,'begin');
     IncIndent;
     try
-      AddLn(Strings,'Inherited Items[Index]:=AValue;');
+      AddLn(Strings,'Inherited Items[AIndex]:=AValue;');
     finally
       DecIndent;
     end;
     EndMethod(Strings,S);
+    Addln(Strings);
     end;
+  If (caListAddMethod in tiOPFOptions.ClassOptions) then
+    WriteListAddObject(Strings,ListClassName,ObjectClassName);
 end;
 
 Initialization

packages/fcl-db/src/codegen/fpddcodegen.pp

@@ -36,6 +36,7 @@ Type
                ptCustom);
                
   TVisibility = (vPrivate,vProtected,vPublic,vPublished);
+  TVisibilities = Set of TVisibility;
   TPropAccess = (paReadWrite,paReadonly,paWriteonly);
 
 
@@ -108,8 +109,12 @@ Type
 
   TCodeGeneratorOptions = Class(TPersistent)
   private
+    FImplementationUnits: String;
+    FInterfaceUnits: String;
     FOptions: TCodeOptions;
     FUnitName: String;
+    procedure SetImplementationUnits(const AValue: String);
+    procedure SetInterfaceUnits(const AValue: String);
     procedure SetUnitname(const AValue: String);
   Protected
     procedure SetOPtions(const AValue: TCodeOptions); virtual;
@@ -119,6 +124,8 @@ Type
   Published
     Property Options : TCodeOptions Read FOptions Write SetOPtions;
     Property UnitName : String Read FUnitName Write SetUnitname;
+    Property InterfaceUnits : String Read FInterfaceUnits Write SetInterfaceUnits;
+    Property ImplementationUnits : String Read FImplementationUnits Write SetImplementationUnits;
   end;
   TCodeGeneratorOptionsClass = Class of TCodeGeneratorOptions;
 
@@ -230,7 +237,9 @@ Type
     procedure CreateClassEnd(Strings : TStrings); virtual;
     // Called right after section start is written.
     procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); virtual;
-    // Writes a property declaration.
+    // Should a property declaration be written ?
+    function AllowPropertyDeclaration(F: TFieldPropDef; AVisibility: TVisibilities): Boolean; virtual;
+    // Creates a property declaration.
     Function PropertyDeclaration(Strings: TStrings; Def: TFieldPropDef) : String; virtual;
     // Writes private fields for class.
     procedure WritePrivateFields(Strings: TStrings); virtual;
@@ -727,6 +736,12 @@ begin
   end;
 end;
 
+Function TDDClassCodeGenerator.AllowPropertyDeclaration(F : TFieldPropDef; AVisibility : TVisibilities) : Boolean;
+
+begin
+  Result:=Assigned(f) and F.Enabled and ((AVisibility=[]) or (F.PropertyVisibility in AVisibility));
+end;
+
 Procedure TDDClassCodeGenerator.CreateDeclaration(Strings : TStrings);
 
 Const
@@ -751,7 +766,7 @@ begin
       For I:=0 to Fields.Count-1 do
         begin
         F:=Fields[i];
-        if F.Enabled and (F.PropertyVisibility=v) then
+        if AllowPropertyDeclaration(F,[V]) then
           AddLn(Strings,PropertyDeclaration(Strings,F)+';');
         end;
     Finally
@@ -773,7 +788,7 @@ begin
     For I:=0 to Fields.Count-1 do
       begin
       F:=Fields[i];
-      if F.Enabled then
+      if AllowPropertyDeclaration(F,[]) then
         AddLn(Strings,'F%s : %s;',[F.PropertyName,F.ObjPasTypeDef]);
       end;
   Finally
@@ -802,7 +817,7 @@ begin
   For I:=0 to Fields.Count-1 do
     begin
     F:=Fields[i];
-    if F.Enabled and F.HasGetter then
+    if AllowPropertyDeclaration(F,[]) and F.HasGetter then
       begin
       If not B then
         begin
@@ -817,7 +832,7 @@ begin
   For I:=0 to Fields.Count-1 do
     begin
     F:=Fields[i];
-    if F.Enabled and F.HasGetter then
+    if AllowPropertyDeclaration(F,[]) and F.HasGetter then
       begin
       If not B then
         begin
@@ -1028,11 +1043,11 @@ begin
     For I:=0 to Fields.Count-1 do
       begin
       F:=Fields[i];
-      If F.Enabled then
+      If AllowPropertyDeclaration(F,[]) then
         begin
         if (F.Hasgetter) then
           AddLn(Strings,PropertyGetterDeclaration(F,False));
-        if (Fields[i].HasSetter) then
+        if (F.HasSetter) then
           AddLn(Strings,PropertySetterDeclaration(F,False));
         end;
       end;
@@ -1217,11 +1232,13 @@ end;
 function TDDCustomCodeGenerator.GetInterfaceUsesClause: String;
 begin
   Result:='Classes, SysUtils';
+  If (CodeOptions.InterfaceUnits<>'') then
+    Result:=Result+','+CodeOptions.InterfaceUnits;
 end;
 
 function TDDCustomCodeGenerator.GetImplementationUsesClause: String;
 begin
-  Result:='';
+  Result:=CodeOptions.ImplementationUnits;
 end;
 
 procedure TDDCustomCodeGenerator.GenerateCode(Stream: TStream);
@@ -1473,6 +1490,19 @@ begin
   FUnitName:=AValue;
 end;
 
+procedure TCodeGeneratorOptions.SetInterfaceUnits(const AValue: String);
+begin
+  if FInterfaceUnits=AValue then exit;
+  FInterfaceUnits:=AValue;
+  // Do some checks here
+end;
+
+procedure TCodeGeneratorOptions.SetImplementationUnits(const AValue: String);
+begin
+  if FImplementationUnits=AValue then exit;
+  FImplementationUnits:=AValue;
+end;
+
 { TClassCodeGeneratorOptions }
 
 procedure TClassCodeGeneratorOptions.SetClassName(const AValue: String);