Browse Source

--- Merging r13867 into '.':
U packages/fcl-db/src/paradox/paradox.pp
--- Merging r13868 into '.':
G packages/fcl-db/src/paradox/paradox.pp
--- Merging r13931 into '.':
G packages/fcl-db/src/paradox/paradox.pp
--- Merging r13932 into '.':
U packages/fcl-db/src/export/fpdbexport.pp
--- Merging r14450 into '.':
G packages/fcl-db/src/paradox/paradox.pp

# revisions: 13867,13868,13931,13932,14450
------------------------------------------------------------------------
r13867 | michael | 2009-10-16 13:27:38 +0200 (Fri, 16 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/paradox/paradox.pp

* Patch from Luiz Americo to fix access violation when transforming date field
------------------------------------------------------------------------
------------------------------------------------------------------------
r13868 | michael | 2009-10-16 14:05:26 +0200 (Fri, 16 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/paradox/paradox.pp

* Patch from Luiz Americo to clear fielddefs when filling fielddefs
------------------------------------------------------------------------
------------------------------------------------------------------------
r13931 | michael | 2009-10-23 17:16:26 +0200 (Fri, 23 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/paradox/paradox.pp

* Fixed 13762 and compilation on windows
------------------------------------------------------------------------
------------------------------------------------------------------------
r13932 | michael | 2009-10-23 17:30:09 +0200 (Fri, 23 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/export/fpdbexport.pp

* Added UseDisplayFormat property to format fields
------------------------------------------------------------------------
------------------------------------------------------------------------
r14450 | michael | 2009-12-18 09:03:02 +0100 (Fri, 18 Dec 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/paradox/paradox.pp

* Some installation instructions for pxlib
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14655 -

marco 15 years ago
parent
commit
18ed24f2aa
2 changed files with 49 additions and 14 deletions
  1. 25 7
      packages/fcl-db/src/export/fpdbexport.pp
  2. 24 7
      packages/fcl-db/src/paradox/paradox.pp

+ 25 - 7
packages/fcl-db/src/export/fpdbexport.pp

@@ -72,8 +72,10 @@ Type
     FTimeFormat : String;
     FDateTimeFormat : String;
     FDecimalSeparator: Char;
+    FUseDisplayText : Boolean;
   Protected
     Procedure InitSettings; virtual;
+    Property UseDisplayText : Boolean Read FUseDisplayText Write FUseDisplayText;
     Property IntegerFormat : String Read FIntegerFormat Write FIntegerFormat;
     Property DecimalSeparator : Char Read FDecimalSeparator Write FDecimalSeparator;
     Property CurrencySymbol : String Read FCurrencySymbol Write FCurrencySymbol;
@@ -587,8 +589,10 @@ begin
     begin
     If (FormatSettings.IntegerFormat)<>'' then
       Result:=Format(FormatSettings.IntegerFormat,[F.AsInteger])
+    else if FormatSettings.UseDisplayText then
+      Result:=F.DisplayText
     else
-      Result:=F.AsString;
+      Result:=F.AsString;  
     end
   else if (F.DataType=ftBoolean) then
     begin
@@ -597,12 +601,17 @@ begin
     else
       Result:=FormatSettings.BooleanFalse;
     If (Result='') then
-      Result:=F.AsString;
+      if FormatSettings.UseDisplayText then
+        Result:=F.DisplayText
+      else
+        Result:=F.AsString;  
     end
   else if (F.DataType=ftDate) then
     begin
     If (FormatSettings.DateFormat<>'') then
       Result:=FormatDateTime(FormatSettings.DateFormat,F.AsDateTime)
+    else if FormatSettings.UseDisplayText then
+      Result:=F.DisplayText
     else
       Result:=F.AsString;
     end
@@ -610,16 +619,20 @@ begin
     begin
     If (FormatSettings.TimeFormat<>'') then
       Result:=FormatDateTime(FormatSettings.TimeFormat,F.AsDateTime)
+    else if FormatSettings.UseDisplayText then
+      Result:=F.DisplayText
     else
-      Result:=F.AsString;
+      Result:=F.AsString;  
     end
   else if (F.DataType in [ftDateTime,ftTimeStamp]) then
     begin
     If (FormatSettings.DateTimeFormat<>'') then
       Result:=FormatDateTime(FormatSettings.DateTimeFormat,F.AsDateTime)
+    else if FormatSettings.UseDisplayText then
+      Result:=F.DisplayText
     else
       Result:=F.AsString;
-    end
+    end 
   else if (F.DataType=ftCurrency) then
     begin
     If (FormatSettings.CurrencySymbol<>'') then
@@ -628,11 +641,15 @@ begin
       FS.CurrencyString:=FormatSettings.CurrencySymbol;
       Result:=CurrToStrF(F.AsCurrency,ffCurrency,FormatSettings.CurrencyDigits,FS);
       end
-    else
-      Result:=F.AsString
+    else  if FormatSettings.UseDisplayText then
+      Result:=F.DisplayText
+    else 
+      Result:=F.AsString;
     end
+  else if FormatSettings.UseDisplayText then
+    Result:=F.DisplayText
   else
-    Result:=F.AsString;
+    Result:=F.AsString;  
 end;
 
 procedure TCustomDatasetExporter.ExportError(Msg: String);
@@ -852,6 +869,7 @@ begin
     FTimeFormat:=FS.FTimeFormat;
     FDateTimeFormat:=FS.FDateTimeFormat;
     FDecimalSeparator:=FS.FDecimalSeparator;
+    FUseDisplayText:=FS.FUseDisplayText;
     end
   else
     inherited Assign(Source);

+ 24 - 7
packages/fcl-db/src/paradox/paradox.pp

@@ -14,6 +14,14 @@
 {$H+}
 {
   TParadox : Dataset wich can handle paradox files, based on PXLib.
+  pxlib is an open source C library for handling paradox files. It
+  is available from sourceforge:
+  http://pxlib.sourceforge.net/
+  it must be downloaded and installed separately. The header translations
+  for version 0.6.2 of pxlib are available in the pxlib unit in the Free 
+  Pascal Packages.
+  
+  The TParadox component was implemented by Michael Van Canneyt
 }
 
 unit paradox;
@@ -417,6 +425,7 @@ Var
   pxf : Ppxfield_t;
 
 begin
+  FieldDefs.Clear;
   pxf:=PX_get_fields(FDoc);
   ACount:= PX_get_num_fields(FDoc);
   ReallocMem(FOffsets,ACount*SizeOf(Integer));
@@ -549,6 +558,9 @@ end;
 procedure TParadox.InternalClose;
 
 begin
+  BindFields(False);
+  if DefaultFields then
+    DestroyFields;
   FreeAndNil(FParser);
   FreeMem(FOffsets);
   FOffSets:=Nil;
@@ -629,7 +641,7 @@ var
   No,pft,flen : integer;
   pxf          : PPx_field;
   Value        : Pchar;
-  Y,M,D        : cint;
+  D            : clong;
   longv        : Clong;
   R            : Double;
   c            : Char;
@@ -652,7 +664,9 @@ begin
         If result then
           begin
           Move(Value^,Buffer^,flen);
-          doc^.free(doc,value);
+          If (Flen<=Field.DataSize) then
+            Pchar(Buffer)[flen]:=#0;
+          FDoc^.free(FDoc,value);
           end;
         end;
       pxfDate:
@@ -660,8 +674,11 @@ begin
         Result:=PX_get_data_long(FDoc,Buf,flen,@longv)>0;
         If Result then
           begin
-          PX_SdnToGregorian(longv+1721425,@Y,@M,@D);
-          PDateTime(Buffer)^:=EncodeDate(Y,M,D);
+          // 1721425 is the number of the days between the start of the
+          // julian calendar (4714 BC) and jan-00-0000 (Paradox base date)
+          // 2415019 is the number of the days between the start of the
+          // julian calendar (4714 BC) and dec-30-1899 (TDateTime base date)
+          PDateTime(Buffer)^:=Longv+1721425-2415019;
           end;
         end;
       pxfShort:
@@ -688,7 +705,7 @@ begin
         begin
         Result:=(PX_get_data_byte(FDoc,Buf,flen,@C)>0);
         If result then
-          PBoolean(Buffer)^:=(C<>#0);
+          PWordBool(Buffer)^:=(C<>#0);
         end;
       pxfBytes:
         begin
@@ -721,9 +738,9 @@ begin
           begin
           R:=R/1000.0;
           longv:=trunc(R /86400);
-          PX_SdnToGregorian(longv+1721425,@Y,@M,@D);
+          D:=Longv+1721425-2415019;
           longv:=(Trunc(r) mod 86400);
-          PDateTime(Buffer)^:=EncodeDate(Y,M,d)+(Longv/MSecsPerday);
+          PDateTime(Buffer)^:=D+(Longv/MSecsPerday);
           end;
         end;
       pxfBCD: