Merged revisions 12218,12222-12223,12236,12246-12252,12259,12263-12265,12267,12270-12271,12273,12275,12281-12282,12286 via svnmerge from

svn+ssh://joost@svn.freepascal.org/FPC/svn/fpc/trunk

........
  r12218 | joost | 2008-11-23 17:03:29 +0100 (Sun, 23 Nov 2008) | 3 lines
  
  Patch from Luiz Americo, mantis 12677
   - Added Options property
   - Implemented Wildcard keys in Locate/Lookup 
........
  r12222 | joost | 2008-11-23 21:33:53 +0100 (Sun, 23 Nov 2008) | 2 lines
  
  Patch from Luiz Americo, mantis 12698
   - Add OnGetHandle event
........
  r12223 | joost | 2008-11-24 10:57:19 +0100 (Mon, 24 Nov 2008) | 2 lines
  
  Patch from Luiz Americo, mantis 12700
   - Fix setting negative double values
........
  r12286 | joost | 2008-12-01 21:55:47 +0100 (Mon, 01 Dec 2008) | 2 lines
  
  Patch from Luiz Americo
  * Publish FieldDefs property
........


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fixes_2_2@12298 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 84 insertions, 31 deletions

diff --git a/packages/fcl-db/src/sqlite/customsqliteds.pas b/packages/fcl-db/src/sqlite/customsqliteds.pas
index 0aa854ce39..d77c9343f9 100644
--- a/packages/fcl-db/src/sqlite/customsqliteds.pas
+++ b/packages/fcl-db/src/sqlite/customsqliteds.pas
@@ -80,6 +80,9 @@ type
 
   TGetSqlStrFunction = function (APChar: PChar): String;
 
+  TSqliteOption = (soWildcardKey);
+  TSqliteOptions = set of TSqliteOption;
+
   { TCustomSqliteDataset }
 
   TCustomSqliteDataset = class(TDataSet)
@@ -95,12 +98,15 @@ type
     FMasterLink: TMasterDataLink;
     FIndexFieldNames: String;
     FIndexFieldList: TList;
+    FOnGetHandle: TDataSetNotifyEvent;
+    FOptions: TSqliteOptions;
     FSqlList:TStrings;
     procedure CopyCacheToItem(AItem: PDataRecord);
     function GetIndexFields(Value: Integer): TField;
     procedure SetMasterIndexValue;
+    procedure SetOptions(const AValue: TSqliteOptions);
     procedure UpdateIndexFields;
-    function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
+    function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync:Boolean):PDataRecord;
   protected
     FPrimaryKey: String;
     FPrimaryKeyNo: Integer;
@@ -184,8 +190,8 @@ type
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
-    function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : Boolean; override;
-    function LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : Boolean;
+    function Locate(const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean; override;
+    function LocateNext(const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
     function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;override;
     // Additional procedures
     function ApplyUpdates: Boolean;
@@ -223,6 +229,8 @@ type
     property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
     property FileName: String read FFileName write SetFileName;
     property OnCallback: TSqliteCallback read FOnCallback write FOnCallback;
+    property OnGetHandle: TDataSetNotifyEvent read FOnGetHandle write FOnGetHandle;
+    property Options: TSqliteOptions read FOptions write SetOptions;
     property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
     property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose; 
     property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch;
@@ -232,7 +240,7 @@ type
     property MasterFields: string read GetMasterFields write SetMasterFields;
     
     property Active;
-       
+    property FieldDefs;   
     //Events
     property BeforeOpen;
     property AfterOpen;
@@ -535,6 +543,11 @@ begin
     TField(FIndexFieldList[i]).AsString := TField(FMasterLink.Fields[i]).AsString;
 end;
 
+procedure TCustomSqliteDataset.SetOptions(const AValue: TSqliteOptions);
+begin
+  FOptions := AValue;
+end;
+
 procedure TCustomSqliteDataset.DisposeLinkedList;
 var
   TempItem:PDataRecord;
@@ -901,7 +914,7 @@ begin
 end;
 
 type
-  TLocateCompareFunction = function (Value, Key: PChar): Boolean;
+  TLocateCompareFunction = function (Value: PChar; const Key: String): Boolean;
   
   TLocateFieldInfo = record
     Index: Integer;
@@ -909,39 +922,56 @@ type
     CompFunction: TLocateCompareFunction;
   end;
 
-function CompInsensitivePartial(Value, Key: PChar): Boolean;
+function CompInsensitivePartial(Value: PChar; const Key: String): Boolean;
+begin
+  if Value <> nil then
+    Result := StrLIComp(Value, PChar(Key), Length(Key)) = 0
+  else
+    Result := False;
+end;
+
+function CompSensitivePartial(Value: PChar; const Key: String): Boolean;
+begin
+  if Value <> nil then
+    Result := StrLComp(Value, PChar(Key), Length(Key)) = 0
+  else
+    Result := False;
+end;
+
+function CompInsensitive(Value: PChar; const Key: String): Boolean;
 begin
   if Value <> nil then
-    Result := StrLIComp(Value, Key, StrLen(Key)) = 0
+    Result := StrIComp(Value, PChar(Key)) = 0
   else
     Result := False;
 end;
 
-function CompSensitivePartial(Value, Key: PChar): Boolean;
+function CompSensitive(Value: PChar; const Key: String): Boolean;
 begin
   if Value <> nil then
-    Result := StrLComp(Value, Key, StrLen(Key)) = 0
+    Result := StrComp(Value, PChar(Key)) = 0
   else
     Result := False;
 end;
 
-function CompInsensitive(Value, Key: PChar): Boolean;
+function CompSensitiveWild(Value: PChar; const Key: String): Boolean;
 begin
   if Value <> nil then
-    Result := StrIComp(Value, Key) = 0
+    Result := IsWild(String(Value), Key, False)
   else
     Result := False;
 end;
 
-function CompSensitive(Value, Key: PChar): Boolean;
+function CompInsensitiveWild(Value: PChar; const Key: String): Boolean;
 begin
   if Value <> nil then
-    Result := StrComp(Value, Key) = 0
+    Result := IsWild(String(Value), Key, True)
   else
     Result := False;
 end;
 
-function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
+
+function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync:Boolean):PDataRecord;
 var
   LocateFields: array of TLocateFieldInfo;
   AFieldList: TList;
@@ -960,11 +990,11 @@ begin
     begin
       if VarIsArray(KeyValues) then
       begin
-        if Succ(VarArrayHighBound(KeyValues,1)) <> AFieldCount then
-          DatabaseError('Number of fields does not correspond to number of values',Self);
+        if Succ(VarArrayHighBound(KeyValues, 1)) <> AFieldCount then
+          DatabaseError('Number of fields does not correspond to number of values', Self);
       end
       else
-        DatabaseError('Wrong number of values specified: expected an array of variants got a variant',Self);
+        DatabaseError('Wrong number of values specified: expected an array of variants got a variant', Self);
     end;
     
     //set the array of the fields info
@@ -973,21 +1003,29 @@ begin
     for i := 0 to AFieldCount - 1 do
       with TField(AFieldList[i]) do
       begin
-        if not (DataType in [ftFloat,ftDateTime,ftTime,ftDate]) then
+        if not (DataType in [ftFloat, ftDateTime, ftTime, ftDate]) then
         begin
           //the loPartialKey and loCaseInsensitive is ignored in numeric fields
           if DataType in [ftString, ftMemo] then
           begin
-            if loPartialKey in Options then
+            if loPartialKey in LocateOptions then
             begin
-              if loCaseInsensitive in Options then
+              if loCaseInsensitive in LocateOptions then
                 LocateFields[i].CompFunction := @CompInsensitivePartial
               else
                 LocateFields[i].CompFunction := @CompSensitivePartial;
             end
             else
+            if soWildcardKey in FOptions then
             begin
-              if loCaseInsensitive in Options then
+              if loCaseInsensitive in LocateOptions then
+                LocateFields[i].CompFunction := @CompInsensitiveWild
+              else
+                LocateFields[i].CompFunction := @CompSensitiveWild;
+            end
+            else
+            begin
+              if loCaseInsensitive in LocateOptions then
                 LocateFields[i].CompFunction := @CompInsensitive
               else
                 LocateFields[i].CompFunction := @CompSensitive;
@@ -1034,7 +1072,7 @@ begin
     for i:= 0 to AFieldCount - 1 do
     begin
       with LocateFields[i] do
-      if not CompFunction(TempItem^.Row[Index], PChar(Key)) then
+      if not CompFunction(TempItem^.Row[Index], Key) then
       begin
         MatchRecord := False;
         Break;//for
@@ -1061,6 +1099,8 @@ begin
   if FFileName = '' then
     DatabaseError('Filename not set',Self);
   FSqliteHandle := InternalGetHandle;
+  if Assigned(FOnGetHandle) then
+    FOnGetHandle(Self);
 end;
 
 procedure TCustomSqliteDataset.FreeItem(AItem: PDataRecord);
@@ -1073,16 +1113,16 @@ begin
   Dispose(AItem);
 end;
 
-function TCustomSqliteDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : Boolean;
+function TCustomSqliteDataset.Locate(const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
 begin
   CheckBrowseMode;
-  Result := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, Options, True) <> nil;
+  Result := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
 end;
   
-function TCustomSqliteDataset.LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : Boolean;
+function TCustomSqliteDataset.LocateNext(const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
 begin
   CheckBrowseMode;
-  Result := FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next, KeyFields, KeyValues, Options, True) <> nil;
+  Result := FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
 end;
   
 function TCustomSqliteDataset.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
@@ -1126,6 +1166,8 @@ procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean);
 var
   TempStr:String;
+  FloatStr: PChar;
+  FloatLen: Integer;
 begin
   if not (State in [dsEdit, dsInsert]) then
     DatabaseErrorFmt(SNotEditing,[Name],Self);
@@ -1152,11 +1194,22 @@ begin
       end;  
     ftFloat,ftDateTime,ftDate,ftTime,ftCurrency:
       begin
-        Str(Double(Buffer^),TempStr);  
-        FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr));
-        //Skips the first space that str returns
-        //todo: make a custom Str?
-        Move((PChar(TempStr)+1)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr));
+        Str(Double(Buffer^),TempStr);
+        //Str returns a space as the first character for positive values
+        //and the - sign for negative values. It's necessary to remove the extra
+        //space while keeping the - sign
+        if TempStr[1] = ' ' then
+        begin
+          FloatStr := PChar(TempStr) + 1;
+          FloatLen := Length(TempStr);
+        end
+        else
+        begin
+          FloatStr := PChar(TempStr);
+          FloatLen := Length(TempStr) + 1;
+        end;
+        FCacheItem^.Row[Pred(Field.FieldNo)] := StrAlloc(FloatLen);
+        Move(FloatStr^, (FCacheItem^.Row[Pred(Field.FieldNo)])^, FloatLen);
       end;
     ftLargeInt:
       begin