Locate()

[a2z]

Hi

First, I'd like to thank you for this nifty component set. Very useful, indeed.

I have coded the Locate() function. It looks correct to me. But someone should check and confirm. Here is it. BTW, I removed the InternalLocate as it was not used by anything.

Cheers,
Adem

Function TSLDataSet.Locate(Const KeyFields: String; Const KeyValues: Variant; Options: TLocateOptions): Boolean;

  Function CheckFieldValue(AField: TField; AValue: Variant; AOptions: TLocateOptions): Boolean;
  Var
    Double1: Double;
    Integer1: Integer;
    Currency1: Currency;
    Currency2: Currency;
    String1: String;
    String2: String;
    WideString1: WideString;
    WideString2: WideString;
    LargeInt1: Int64;
    LargeInt2: Int64;
    GUID1: TGUID;
    GUID2: TGUID;
  Begin
    (*
      TLocateOption = (loCaseInsensitive, loPartialKey);

      TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
        ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
        ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
        ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
        ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
        ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd);
    *)

    Result := False;
    Case AField.DataType Of {Other field types need to be coded for; when needed}
      ftGuid: Begin
          GUID1 := StringToGUID(AValue);
          GUID2 := TGUIDField(AField).AsGuid;
          Result := (GUID1.D1 = GUID2.D1)
            And (GUID1.D2 = GUID2.D2)
            And (GUID1.D3 = GUID2.D3)
            And (GUID1.D4[0] = GUID2.D4[0])
            And (GUID1.D4[1] = GUID2.D4[1])
            And (GUID1.D4[2] = GUID2.D4[2])
            And (GUID1.D4[3] = GUID2.D4[3])
            And (GUID1.D4[4] = GUID2.D4[4])
            And (GUID1.D4[5] = GUID2.D4[5])
            And (GUID1.D4[6] = GUID2.D4[6])
            And (GUID1.D4[7] = GUID2.D4[7]);
        End;
      ftVariant: Begin
          Result := (AField.AsVariant = AValue);
        End;
      ftAutoInc, ftInteger: Begin
          Integer1 := AValue;
          Result := (AField.AsInteger = Integer1);
        End;
      ftCurrency: Begin
          Currency1 := AValue;
          Currency2 := TCurrencyField(AField).AsCurrency;
          Result := (Currency1 = Currency2);
        End;
      ftLargeint: Begin
          LargeInt1 := AValue;
          LargeInt2 := TLargeIntField(AField).AsLargeInt;
          Result := (LargeInt1 = LargeInt2);
        End;
      ftString: Begin
          If loCaseInsensitive In AOptions Then Begin
            String1 := AnsiUpperCase(AValue);
            String2 := AnsiUpperCase(AField.AsString);
            If loPartialKey In AOptions Then Result := (Pos(String1, String2) > 0)
            Else Result := String2 = String1;
          End Else Begin
            String1 := AValue;
            String2 := AField.AsString;
            If loPartialKey In AOptions Then Result := (Pos(String1, String2) > 0)
            Else Result := String2 = String1;
          End;
        End;
      ftWideString: Begin
          If loCaseInsensitive In AOptions Then Begin
            WideString1 := WideUpperCase(AValue);
            WideString2 := TWideStringField(AField).Value;
            WideString2 := WideUpperCase(WideString2);
            If loPartialKey In AOptions Then Result := (Pos(WideString1, WideString2) > 0) {There must be WidePos function somewhere.}
            Else Result := WideString1 = WideString2;
          End Else Begin
            WideString1 := AValue;
            String2 := TWideStringField(AField).Value;
            If loPartialKey In AOptions Then Result := (Pos(WideString1, WideString2) > 0)
            Else Result := WideString1 = WideString2;
          End;
        End;
      ftDate, ftTime, ftDateTime, ftFloat, ftBCD: Begin
          Double1 := AValue;
          Result := (AField.AsFloat = Double1);
        End;
    End;
  End;

Var
  KeyFields1: TStringList;
  Index1: Integer;
  Count1: Integer;
  Value1: Variant;
  Field1: TField;
  Bookmark1: TBookmark;
  Fields1: Array Of TField;
  Found1: Boolean;
Begin
  Result := False;
  If VarArrayDimCount(KeyValues) <> 1 Then Exit; {KeyValues must be an array. With just one dimension}
  KeyFields1 := TStringList.Create; // mapping
  Found1 := True;
  Bookmark1 := Nil;
  DisableControls;
  Try
    Try
      KeyFields1.CommaText := KeyFields;
      Count1 := KeyFields1.Count;
      If Count1 = 0 Then exit;
      If (VarArrayHighBound(KeyValues, 1) - VarArrayLowBound(KeyValues, 1)) <> Pred(Count1) Then exit; // KeyValues does not have correct number of values.
      SetLength(Fields1, Count1);
      Index1 := 0;
      While Index1 < Count1 Do Begin
        Field1 := FindField(KeyFields1[Index1]);
        If Field1 = Nil Then exit;
        Fields1[Index1] := Field1;
        Inc(Index1);
      End;
    Except
      Found1 := False;
      exit;
    End;

    DoBeforeScroll;
    Bookmark1 := GetBookMark;
    First;
    While Not EOF Do Begin
      Index1 := 0;
      While Found1 And (Index1 < Count1) Do Begin
        Value1 := KeyValues[Index1];
        Found1 := CheckFieldValue(Fields1[Index1], Value1, Options);
        Inc(Index1);
      End;
      If Not Found1 Then Next
      Else Begin
        Result := True;
        Exit;
      End;
    End;
  Finally
    If BookmarkValid(Bookmark1) Then Begin
      If Not Found1 Then GotoBookMark(Bookmark1)
      Else DoAfterScroll; {Is this necessary}
      FreeBookmark(Bookmark1);
    End;
    KeyFields1.Free;
    EnableControls;
  End;
End;