* Patch from Ladislav Karrach (Lacak2) to make LocateOptions work for TBufDataset.Locate + test, bug #15725

git-svn-id: trunk@15005 -

packages/fcl-db/src/base/bufdataset.pas

@@ -532,9 +532,12 @@ begin
 end;
 
 function DBCompareText(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
-
 begin
-  if loCaseInsensitive in options then
+  if [loCaseInsensitive,loPartialKey]=options then
+    Result := AnsiStrLIComp(pchar(subValue),pchar(aValue),length(pchar(subValue)))
+  else if [loPartialKey] = options then
+    Result := AnsiStrLComp(pchar(subValue),pchar(aValue),length(pchar(subValue)))
+  else if [loCaseInsensitive] = options then
     Result := AnsiCompareText(pchar(subValue),pchar(aValue))
   else
     Result := AnsiCompareStr(pchar(subValue),pchar(aValue));
@@ -2759,7 +2762,10 @@ begin
 
     SetLength(DBCompareStruct,FieldsAmount);
     for FieldNr:=0 to FieldsAmount-1 do
+      begin
       ProcessFieldCompareStruct(TField(SearchFields[FieldNr]),DBCompareStruct[FieldNr]);
+      DBCompareStruct[FieldNr].Options:=options;
+      end;
   finally
     SearchFields.Free;
   end;

packages/fcl-db/tests/testdbbasics.pas

@@ -38,6 +38,7 @@ type
     procedure TestBookmarkValid;
 
     procedure TestLocate;
+    procedure TestLocateCaseIns;
 
     procedure TestFirst;
     procedure TestDelete1;
@@ -756,6 +757,24 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.TestLocateCaseIns;
+begin
+  with DBConnector.GetNDataset(true,13) do
+    begin
+    open;
+    assertfalse(Locate('name',vararrayof(['TEstName5']),[]));
+    asserttrue(Locate('name',vararrayof(['TEstName5']),[loCaseInsensitive]));
+    AssertEquals(5,FieldByName('id').AsInteger);
+
+    assertfalse(Locate('name',vararrayof(['TestN']),[]));
+    asserttrue(Locate('name',vararrayof(['TestN']),[loPartialKey]));
+
+    assertfalse(Locate('name',vararrayof(['TestNA']),[loPartialKey]));
+    asserttrue(Locate('name',vararrayof(['TestNA']),[loPartialKey, loCaseInsensitive]));
+    close;
+    end;
+end;
+
 procedure TTestDBBasics.TestSetFieldValues;
 var PassException : boolean;
 begin