tntjvdbutils.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

unit TntJvDBUtils;

interface

uses
  DB, SysUtils, JvDBUtils, TntSysUtils, TntDB;

type
  TTntJvLocateObject = class(TJvLocateObject)
  private
    FLookupField: TField;
    FLookupValue: WideString;
    FLookupExact: Boolean;
    FCaseSensitive: Boolean;
    FBookmark: TBookmark;
  protected
    property LookupField: TField read FLookupField write FLookupField;
    property LookupValue: WideString read FLookupValue write FLookupValue;
    property LookupExact: Boolean read FLookupExact write FLookupExact;
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
    property Bookmark: TBookmark read FBookmark write FBookmark;

    function LocateFull: Boolean; override;
    function MatchesLookup(Field: TField): Boolean;
  public
    function Locate(const KeyField, KeyValue: WideString; Exact,
      CaseSensitive: Boolean): Boolean;
  end;

function CreateTntLocate(DataSet: TDataSet): TTntJvLocateObject;

implementation

uses
  Math;

function CreateTntLocate(DataSet: TDataSet): TTntJvLocateObject;
begin
  Result := TTntJvLocateObject.Create;
  if (Result <> nil) and (DataSet <> nil) then
    Result.DataSet := DataSet;
end;

function SetToBookmark(ADataSet: TDataSet; ABookmark: TBookmark): Boolean;
begin
  Result := False;
  with ADataSet do
    if Active and (ABookmark <> nil) and not (Bof and Eof) and
      BookmarkValid(ABookmark) then
    try
      ADataSet.GotoBookmark(ABookmark);
      Result := True;
    except
    end;
end;

function TTntJvLocateObject.Locate(const KeyField, KeyValue: WideString;
  Exact, CaseSensitive: Boolean): Boolean;
var
  LookupKey: TField;
begin
  if DataSet = nil then
  begin
    Result := False;
    Exit;
  end;
  DataSet.CheckBrowseMode;
  LookupKey := DataSet.FieldByName(KeyField);
  DataSet.CursorPosChanged;
  FLookupField := LookupKey;
  FLookupValue := KeyValue;
  FLookupExact := Exact;
  FCaseSensitive := CaseSensitive;
  if not (FLookupField.DataType in [ftString, ftWideString]) then
  begin
    FCaseSensitive := True;
    try
      CheckFieldType(FLookupField);
    except
      Result := False;
      Exit;
    end;
  end;
  FBookmark := DataSet.GetBookmark;
  try
    DataSet.DisableControls;
    try
      Result := MatchesLookup(FLookupField);
      if not Result then
      begin
        if UseKey then
          Result := LocateKey
        else
        begin
          Result := LocateFull;
        end;
        if not Result then
          SetToBookmark(DataSet, FBookmark);
      end;
    finally
      DataSet.EnableControls;
    end;
  finally
    FLookupValue := EmptyStr;
    FLookupField := nil;
    DataSet.FreeBookmark(FBookmark);
    FBookmark := nil;
  end;
end;

function TTntJvLocateObject.LocateFull: Boolean;
begin
  Result := False;
  with DataSet do
  begin
    First;
    while not EOF do
    begin
      if MatchesLookup(LookupField) then
      begin
        Result := True;
        Break;
      end;
      Next;
    end;
  end;
end;

function TTntJvLocateObject.MatchesLookup(Field: TField): Boolean;
var
  Temp: WideString;
begin
  Temp := GetAsWideString(Field);
  if not FLookupExact then
    SetLength(Temp, Min(Length(FLookupValue), Length(Temp)));
  if FCaseSensitive then
    Result := WideCompareStr(Temp, FLookupValue) = 0
  else
    Result := WideCompareText(Temp, FLookupValue) = 0;
end;

end.