+ Added Checks for all simple field types.

+ Initial implementation of Insert/Append

fcl/db/createds.pp

@@ -16,6 +16,8 @@
  **********************************************************************}
 program createds;
 
+{$mode delphi}
+
 uses ddg_rec,sysutils;
 
 Type IndexFile = File Of Longint;
@@ -41,9 +43,18 @@ begin
   For I:=1 to 100 do
     begin
     S:=Format('This is person %d.',[i]);
-    ARec.Name:=S; 
-    ARec.ShoeSize:=I;
-    ARec.height:=I*0.001;
+    With Arec Do 
+      begin
+      Name:=S; 
+      height:=I*0.001;
+      LongField:=i*4;
+      ShoeSize:=I;
+      WordField:=i*2;
+      DateTimeField:=Now;
+      TimeField:=Time;
+      DateField:=Date;
+      Even:=(I mod 2) = 0
+      end;
     Write(F,ARec);
     end;
   Close(F);
@@ -55,7 +66,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
+  Revision 1.3  1999-11-11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
   + Added copyright header
 
 }

fcl/db/dataset.inc

@@ -272,10 +272,22 @@ begin
   FDefaultFields:=FieldCount=0;
   DoBeforeOpen;
   Try
+    {$ifdef dsdebug}
+    Writeln ('Calling internal open');
+    {$endif}
     InternalOpen;
     FBOF:=True;
+    {$ifdef dsdebug}
+    Writeln ('Setting state to browse');
+    {$endif}
     SetState(dsBrowse);
+    {$ifdef dsdebug}
+    Writeln ('Setting buffer size');
+    {$endif}
     SetBufListSize(DefaultBufferCount);
+    {$ifdef dsdebug}
+    Writeln ('Getting next records');
+    {$endif}
     GetNextRecords;
     DoAfterOpen;
     DoAfterScroll;
@@ -366,7 +378,7 @@ end;
 function TDataset.GetCanModify: Boolean;
 
 begin
-  //!! To be implemented
+  Result:=True;
 end;
 
 procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent);
@@ -416,9 +428,9 @@ begin
   Case FieldType of
      ftUnknown : Result:=Tfield;
      ftString: Result := TStringField;
-     ftSmallint: Result := TLongIntField;
+     ftSmallint: Result := TSmallIntField;
      ftInteger: Result := TLongintField;
-     ftWord: Result := TLongintField;
+     ftWord: Result := TWordField;
      ftBoolean: Result := TBooleanField;
      ftFloat: Result := TFloatField;
      ftDate: Result := TDateField;
@@ -455,7 +467,7 @@ begin
   Shifted:=FRecordCount=FBufferCount;
   If Shifted then
     begin
-    ShiftBuffers(1);
+    ShiftBuffers(0,1);
     Dec(FRecordCount);
     end;
 {$ifdef dsdebug}
@@ -475,7 +487,7 @@ begin
     begin
     if shifted then
       begin
-      ShiftBuffers(-1);
+      ShiftBuffers(0,-1);
       inc(FRecordCount);
       end;
     CursorPosChanged;
@@ -511,7 +523,7 @@ begin
   If Shifted Then
     begin
     SetCurrentRecord(0);
-    ShiftBuffers(-1);
+    ShiftBuffers(0,-1);
     end;
   Result:=GetRecord(FBuffers[0],gmPrior,True)=grOK;
   If Result then
@@ -529,7 +541,7 @@ begin
     begin
     If Shifted then
       begin
-      ShiftBuffers(1);
+      ShiftBuffers(0,1);
       end;
     CursorPosChanged;
     end;
@@ -641,11 +653,26 @@ begin
     Value:=I;
   If Value>FBufferCount then
     begin
+   {$ifdef dsdebug}
+    Writeln ('Reallocating memory :',(Value+1)*SizeOf(PChar));
+   {$endif}
     ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
-    FillChar(FBuffers[FBufferCount+1],(Value-FBufferCount)*SizeOF(Pchar),#0);
+   {$ifdef dsdebug}
+    Writeln ('Filling memory :',(Value-FBufferCount)*SizeOf(PChar));
+   {$endif}
+    FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOF(Pchar),#0);
+   {$ifdef dsdebug}
+    Writeln ('Filled memory :');
+   {$endif}
     Try
+     {$ifdef dsdebug}
+      Writeln ('Assigning buffers :',(Value+1)*SizeOf(PChar));
+     {$endif}
       For I:=FBufferCount to Value do
         FBuffers[i]:=AllocRecordBuffer;
+     {$ifdef dsdebug}
+      Writeln ('Assigned buffers :',(Value+1)*SizeOf(PChar));
+     {$endif}
     except
       I:=FBufferCount;
       While (I<=Value) and (FBuffers[i]<>Nil) do
@@ -676,7 +703,9 @@ procedure TDataset.SetCurrentRecord(Index: Longint);
 begin
   If FCurrentRecord<>Index then
     begin
+    {$ifdef DSdebug}
     Writeln ('Setting current record to',index);
+    {$endif}
     Case GetBookMarkFlag(FBuffers[Index]) of
       bfCurrent : InternalSetToRecord(FBuffers[Index]);
       bfBOF : InternalFirst;
@@ -788,14 +817,12 @@ end;
 
 procedure TDataset.Append;
 
-
 begin
-  //!! To be implemented
+  DoInsertAppend(True);
 end;
 
 procedure TDataset.AppendRecord(const Values: array of const);
 
-
 begin
   //!! To be implemented
 end;
@@ -838,14 +865,12 @@ end;
 
 procedure TDataset.Close;
 
-
 begin
   Active:=False;
 end;
 
 function TDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
 
-
 begin
   Result:=0;
 end;
@@ -878,11 +903,76 @@ begin
   //!! To be implemented
 end;
 
-procedure TDataset.Edit;
+procedure TDataset.DoInsertAppend(DoAppend : Boolean);
 
+Var Buffer : PChar;
+    BookBeforeInsert : TBookmarkStr;
+begin
+  If Not CanModify then
+    DatabaseError(SDatasetReadOnly,Self);
+  CheckBrowseMode;
+  DoBeforeInsert;
+  DoBeforeScroll;
+  If Not DoAppend then 
+    begin
+    // need to scroll up al buffers after current one,
+    // but copy current bookmark to insert buffer.
+    BookBeforeInsert:=Bookmark;
+    ShiftBuffers(FActiveRecord,1);
+    // Active buffer is now edit buffer. Initialize.
+    InitRecord(ActiveBuffer);
+    // Put bookmark in edit buffer.
+    if FRecordCount=0 then
+      SetBookmarkFlag(ActiveBuffer,bfBOF)
+    else
+      SetBookMarkData(ActiveBuffer,Pointer(BookBeforeInsert));
+    // update buffer count.
+    If FRecordCount<FBufferCount then 
+      Inc(FRecordCount);
+    end
+  else
+    // Tricky, need to get last record and scroll down.
+    begin
+    Buffer:=FBuffers[0];
+    InitRecord(Buffer);
+    // just mark buffer as last. GetPreviousrecords will do an internallast
+    // Because of this...
+    SetBookMarkFlag(Buffer,bfEOF);
+    FRecordCount:=1;
+    GetPriorRecords;
+    end;
+  SetState(dsInsert);
+  try 
+    DoOnNewRecord;
+  except
+    UpdateCursorPos;
+    resync([]);
+    raise;
+  end;
+  // mark as not modified.
+  FModified:=False;
+  // Final events.
+  DoAfterInsert;
+  DoAfterScroll;
+end;
+
+procedure TDataset.Edit;
 
 begin
-  //!! To be implemented
+  If Not CanModify then
+    DatabaseError(SDatasetReadOnly,Self);
+  If State in [dsedit,dsinsert] then exit;
+  If FRecordCount = 0 then
+    begin
+    Insert;
+    Exit;
+    end;
+  CheckBrowseMode;
+  DoBeforeEdit;
+  If Not TryDoing(@InternalEdit,OnEditError) then 
+    exit;
+  SetState(dsedit);
+  DoAfterEdit;
 end;
 
 procedure TDataset.EnableControls;
@@ -1009,9 +1099,8 @@ end;
 
 procedure TDataset.Insert;
 
-
 begin
-  //!! To be implemented
+  DoInsertAppend(False);
 end;
 
 procedure TDataset.InsertRecord(const Values: array of const);
@@ -1185,7 +1274,7 @@ begin
     // keep current position.
     ShiftCount:=FActiveRecord;
   // Reposition on 0
-  ShiftBuffers(FRecordCount-1);
+  ShiftBuffers(0,FRecordCount-1);
   ActivateBuffers;
   Count:=0;
   Writeln ('Getting previous',ShiftCount,' records');
@@ -1215,6 +1304,32 @@ begin
   //!! To be implemented
 end;
 
+Function  Tdataset.TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
+
+Var Retry : TDataAction;
+
+begin
+  Result:=True;
+  Retry:=daRetry;
+  while Retry=daRetry do
+    Try 
+      P;
+    except
+      On E : EDatabaseError do 
+        begin
+        retry:=daFail;
+        If Assigned(Ev) then
+          Ev(Self,E,Retry);
+        Case Retry of
+          daFail : Raise;
+          daAbort : Result:=False;
+        end;
+        end;
+    else
+      Raise;  
+    end;
+end;
+
 procedure TDataset.UpdateCursorPos;
 
 begin
@@ -1239,7 +1354,7 @@ begin
   Result:=FFieldList.Count;
 end;
 
-Procedure TDataset.ShiftBuffers (Distance : longint);
+Procedure TDataset.ShiftBuffers (Offset, Distance : longint);
 
 Var Temp : Pointer;
     MoveSize : Longint;
@@ -1247,12 +1362,12 @@ Var Temp : Pointer;
   Procedure ShiftBuffersUp;
   begin
     {$ifdef DSDEBUG}
-    writeln ('Shifting buffers up with distance :',Distance);
+    writeln ('Shifting buffers up from ',OffSet,' with distance :',Distance);
     writeln ('Moving ',(FBufferCount-Distance), ' Buffers at ',Distance);
     {$endif}
-    Move(FBuffers[0],Temp^,MoveSize);
-    Move(FBuffers[Distance],FBuffers[0],(FBufferCount-Distance)*SizeOf(Pchar));
-    Move(Temp^,FBuffers[FBufferCount-Distance],MoveSize);
+    Move(FBuffers[Offset],Temp^,MoveSize);
+    Move(FBuffers[Offset+Distance],FBuffers[Offset],(FBufferCount-Distance-Offset)*SizeOf(Pchar));
+    Move(Temp^,FBuffers[FBufferCount-Distance-Offset],MoveSize);
   end;
 
   Procedure ShiftBuffersDown;
@@ -1284,7 +1399,11 @@ end;
 
 {
   $Log$
-  Revision 1.3  1999-11-09 13:33:47  peter
+  Revision 1.4  1999-11-11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.3  1999/11/09 13:33:47  peter
     * reallocmem fixes
 
   Revision 1.2  1999/10/24 17:07:54  michael

fcl/db/db.pp

@@ -769,6 +769,7 @@ type
     FRecordCount: Longint;
     FRecordSize: Word;
     FState: TDataSetState;
+    Procedure DoInsertAppend(DoAppend : Boolean);
     Procedure DoInternalOpen;
     Procedure DoInternalClose;
     Function  GetBuffer (Index : longint) : Pchar;
@@ -776,7 +777,8 @@ type
     Procedure RemoveField (Field : TField);
     Procedure SetActive (Value : Boolean);
     Procedure SetField (Index : Longint;Value : TField);
-    Procedure ShiftBuffers (Distance : Longint);
+    Procedure ShiftBuffers (Offset,Distance : Longint);
+    Function  TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
     Procedure UpdateFieldDefs;
   protected
     procedure ActivateBuffers; virtual;
@@ -1256,7 +1258,11 @@ end.
 
 {
   $Log$
-  Revision 1.3  1999-11-09 13:33:47  peter
+  Revision 1.4  1999-11-11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.3  1999/11/09 13:33:47  peter
     * reallocmem fixes
 
   Revision 1.2  1999/10/24 17:07:54  michael

fcl/db/dbs.inc

@@ -40,10 +40,15 @@ Const
   SNotConnected = 'Operation cannot be performed on an disconnected database';
   SConnected = 'Operation cannot be performed on an connected database';
   SNoSuchRecord = 'Could not find the requested record.';  
+  SDatasetReadOnly = 'Dataset is read-only.';
 
 {
   $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
+  Revision 1.3  1999-11-11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
   + Added copyright header
 
 }  

fcl/db/ddg_ds.pp

@@ -1,5 +1,7 @@
 unit DDG_DS;
 
+{$define dsdebug}
+
 interface
 
 uses Db, Classes, DDG_Rec;
@@ -251,7 +253,13 @@ begin
         Result := PChar(Buffer)^ <> #0;
       end;
     1: Move(PDDGData(ActiveBuffer)^.Height, Buffer^, Field.DataSize);
-    2: Move(PDDGData(ActiveBuffer)^.ShoeSize, Buffer^, Field.DataSize);
+    2: Move(PDDGData(ActiveBuffer)^.LongField, Buffer^, Field.DataSize);
+    3: Move(PDDGData(ActiveBuffer)^.ShoeSize, Buffer^, Field.DataSize);
+    4: Move(PDDGData(ActiveBuffer)^.WordField, Buffer^, Field.DataSize);
+    5: Move(PDDGData(ActiveBuffer)^.DateTimeField, Buffer^, Field.DataSize);
+    6: Move(PDDGData(ActiveBuffer)^.TimeField, Buffer^, Field.DataSize);
+    7: Move(PDDGData(ActiveBuffer)^.DateField, Buffer^, Field.DataSize);
+    8: Move(PDDGData(ActiveBuffer)^.Even, Buffer^, Field.DataSize);
   end;
 end;
 
@@ -308,7 +316,13 @@ begin
   FieldDefs.Clear;
   TFieldDef.Create(FieldDefs, 'Name', ftString, SizeOf(TNameStr), False, 1);
   TFieldDef.Create(FieldDefs, 'Height', ftFloat, 0, False, 2);
-  TFieldDef.Create(FieldDefs, 'ShoeSize', ftInteger, 0, False, 3);
+  TFieldDef.Create(FieldDefs, 'LongField',ftInteger, 0, False, 3);
+  TFieldDef.Create(FieldDefs, 'ShoeSize', ftSmallint, 0, False, 4);
+  TFieldDef.Create(FieldDefs, 'WordField', ftword, 0, false, 5);
+  TFieldDef.Create(FieldDefs, 'DateTimeField', ftDateTime, 0, false, 6);
+  TFieldDef.Create(FieldDefs, 'TimeField',ftTime, 0, false, 7);
+  TFieldDef.Create(FieldDefs, 'DateField',ftDate, 0, false, 8);
+  TFieldDef.Create(FieldDefs, 'Booleanfield',ftboolean, 0, False, 9); 
 end;
 
 procedure TDDGDataSet.InternalLast;
@@ -396,13 +410,25 @@ begin
     BookmarkSize := SizeOf(Integer);   // initialize bookmark size for VCL
     InternalInitFieldDefs;             // initialize FieldDef objects
     // Create TField components when no persistent fields have been created
+    {$ifdef dsdebug}
+    writeln ('Creating Fields');
+    {$endif}
     if DefaultFields then CreateFields;
+    {$ifdef dsdebug}
+    writeln ('Binding Fields');
+    {$endif}
     BindFields(True);                  // bind FieldDefs to actual data
   except
+    {$ifdef dsdebug}
+    Writeln ('Caught Exception !!');
+    {$endif}
     CloseFile(FDataFile);
     FillChar(FDataFile, SizeOf(FDataFile), 0);
     raise;
   end;
+ {$ifdef dsdebug}
+  Writeln ('End of internalopen');
+ {$endif}
 end;
 
 procedure TDDGDataSet.InternalPost;

fcl/db/ddg_rec.pp

@@ -2,6 +2,8 @@ unit DDG_Rec;
 
 interface
 
+uses sysutils;
+
 type
 
   // arbitary-length array of char used for name field
@@ -12,7 +14,13 @@ type
   TDDGData = record
     Name: TNameStr;
     Height: Extended;
-    ShoeSize: Integer;
+    LongField : Longint;
+    ShoeSize: SmallInt;
+    WordField : Word;
+    DatetimeField : TDateTime;
+    TimeField : TDateTime;
+    DateField : TDateTime;
+    Even : Boolean;
   end;
 
   // Pascal file of record which holds "table" data:

fcl/db/fields.inc

@@ -1030,6 +1030,7 @@ constructor TBooleanField.Create(AOwner: TComponent);
 
 begin
   Inherited Create(AOwner);
+  SetDataType(ftBoolean);
   DisplayValues:='True;False';
 end;
 
@@ -1734,7 +1735,11 @@ end;
 
 {
   $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
+  Revision 1.3  1999-11-11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
   + Added copyright header
 
 }

fcl/db/testds.pp

@@ -44,6 +44,7 @@ Procedure DumpField(F : Tfield);
 begin
   With F do
     begin
+    writeln ('-------------------------------------');
     Writeln ('FieldName : ',FieldName); 
     Writeln ('FieldNo   : ',FieldNo);
     Writeln ('Index     : ',Index);
@@ -87,6 +88,7 @@ begin
   With Data do
     While NOT EOF do
       begin
+      Writeln ('================================================');
       For I:=0 to FieldCount-1 do
         DumpFieldData(Fields[I]);
       Next;  
@@ -176,7 +178,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
+  Revision 1.3  1999-11-11 17:31:09  michael
+  + Added Checks for all simple field types.
+  + Initial implementation of Insert/Append
+
+  Revision 1.2  1999/10/24 17:07:54  michael
   + Added copyright header
 
 }