tntjvmemds.pas

来自「TntExUpdate 是 流行的 TntUnicodeControls控件的扩」· PAS 代码 · 共 213 行

unit TntJvMemDS;

interface

{$I TntCompilers.INC}

uses
  DB, JvMemoryDataset;

type
  TTntJvMemoryData = class(TJvMemoryData)
  protected
    //function FindFieldData(Buffer: Pointer; Field: TField): Pointer;
    //function CompareRecords(Item1, Item2: TJvMemoryRecord): Integer; override;
    function CompareFields(Data1, Data2: Pointer; FieldType: TFieldType;
      CaseInsensitive: Boolean): Integer; override;
  public
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
  end;

implementation

uses
  Classes, SysUtils, TntSysUtils, TntDBUtils;

const
  ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
    ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob];

  ftSupported = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
    ftCurrency, ftDate, ftTime, ftDateTime, ftAutoInc, ftBCD, ftBytes,
    ftVarBytes, ftADT, ftFixedChar, ftWideString,
    ftLargeint, ftVariant, ftGuid] +
    ftBlobTypes;


type
  THackJvMemoryData = class(TDataSet)
  protected
    FSaveLoadState: TSaveLoadState;
    FRecordPos: Integer;
    FRecordSize: Integer;
    FBookmarkOfs: Integer;
    FBlobOfs: Integer;
    FRecBufSize: Integer;
    FOffsets: PWordArray;
    FLastID: Integer;
    FAutoInc: Longint;
    FActive: Boolean;
    FRecords: TList;
    FIndexList: TList;
    FCaseInsensitiveSort: Boolean;
    FDescendingSort: Boolean;
    FAutoIncField: TField;
    FSrcAutoIncField: TField;
  end;

function TTntJvMemoryData.CompareFields(Data1, Data2: Pointer; FieldType: TFieldType;
  CaseInsensitive: Boolean): Integer;
begin
  Result := 0;
  case FieldType of
    ftString:
      if CaseInsensitive then
        Result := AnsiCompareText(PChar(Data1), PChar(Data2))
      else
        Result := AnsiCompareStr(PChar(Data1), PChar(Data2));
    ftSmallint:
      if SmallInt(Data1^) > SmallInt(Data2^) then
        Result := 1
      else
        if SmallInt(Data1^) < SmallInt(Data2^) then
          Result := -1;
    ftInteger, ftDate, ftTime, ftAutoInc:
      if Longint(Data1^) > Longint(Data2^) then
        Result := 1
      else
        if Longint(Data1^) < Longint(Data2^) then
          Result := -1;
    ftWord:
      if Word(Data1^) > Word(Data2^) then
        Result := 1
      else
        if Word(Data1^) < Word(Data2^) then
          Result := -1;
    ftBoolean:
      if WordBool(Data1^) and not WordBool(Data2^) then
        Result := 1
      else
        if not WordBool(Data1^) and WordBool(Data2^) then
          Result := -1;
    ftFloat, ftCurrency:
      if Double(Data1^) > Double(Data2^) then
        Result := 1
      else
        if Double(Data1^) < Double(Data2^) then
          Result := -1;
    ftDateTime:
      if TDateTime(Data1^) > TDateTime(Data2^) then
        Result := 1
      else
        if TDateTime(Data1^) < TDateTime(Data2^) then
          Result := -1;
    ftFixedChar:
      if CaseInsensitive then
        Result := AnsiCompareText(PChar(Data1), PChar(Data2))
      else
        Result := AnsiCompareStr(PChar(Data1), PChar(Data2));
    ftWideString:
      if CaseInsensitive then
        Result := WideCompareText(PWideChar(Data1), PWideChar(Data2))
      else
        Result := WideCompareStr(PWideChar(Data1), PWideChar(Data2));
    ftLargeint:
      if Int64(Data1^) > Int64(Data2^) then
        Result := 1
      else
        if Int64(Data1^) < Int64(Data2^) then
          Result := -1;
    ftVariant:
      Result := 0;
    ftGuid:
      Result := AnsiCompareText(PChar(Data1), PChar(Data2));
  end;
end;

(***
function TTntJvMemoryData.CompareRecords(Item1, Item2: TJvMemoryRecord): Integer;
var
  Data1, Data2: PChar;
  F: TField;
  I: Integer;
begin
  Result := 0;
  with THackJvMemoryData(Self) do
  begin
    if FIndexList <> nil then
    begin
      for I := 0 to FIndexList.Count - 1 do
      begin
        F := TField(FIndexList[I]);
        Data1 := FindFieldData(Item1.Data, F);
        if Data1 <> nil then
        begin
          Data2 := FindFieldData(Item2.Data, F);
          if Data2 <> nil then
          begin
            if Boolean(Data1[0]) and Boolean(Data2[0]) then
            begin
              Inc(Data1);
              Inc(Data2);
              Result := CompareFields(Data1, Data2, F.DataType,
                FCaseInsensitiveSort);
            end
            else
              if Boolean(Data1[0]) then
                Result := 1
              else
                if Boolean(Data2[0]) then
                  Result := -1;
            if FDescendingSort then
              Result := -Result;
          end;
        end;
        if Result <> 0 then
          Exit;
      end;
    end;
    if Result = 0 then
    begin
      if Item1.ID > Item2.ID then
        Result := 1
      else
        if Item1.ID < Item2.ID then
          Result := -1;
      if FDescendingSort then
        Result := -Result;
    end;
  end;
end;

function TTntJvMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var
  Index: Integer;
begin
  with THackJvMemoryData(Self) do
  begin
    Index := FieldDefList.IndexOf(Field.FullName);
    if (Index >= 0) and (Buffer <> nil) and
      (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
      Result := (PChar(Buffer) + FOffsets[Index])
    else
      Result := nil;
  end;
end;
***)

function TTntJvMemoryData.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := WideDataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  if Result then
  begin
    DataEvent(deDataSetChange, 0);
    DoAfterScroll;
  end;
end;


end.