memtableeh.pas

增加了条件求和功能

  StrVal: String;
begin
  FieldValBuf := PFieldValBuf(FieldBuffer);
  DataValueBuf := PChar(FieldValBuf.DataValue);

  if FieldValBuf.IsNull then
    VarValue := Null
  else
    case Field.DataType of
      ftString, ftFixedChar, ftGuid:
        VarValue := String(PChar(DataValueBuf));
      ftWideString:
        VarValue := WideString(DataValueBuf^);
      ftAutoInc, ftInteger:
        VarValue := LongInt(DataValueBuf^);
      ftSmallInt:
        VarValue := SmallInt(DataValueBuf^);
      ftWord:
        VarValue := Word(DataValueBuf^);
      ftBoolean:
        VarValue := WordBool(DataValueBuf^);
      ftFloat, ftCurrency:
        VarValue := Double(DataValueBuf^);
      ftBlob..ftTypedBinary, ftOraBlob, ftOraClob:
        begin
          SetString(StrVal, PChar(FieldValBuf.DataValue), Length(FieldValBuf.DataValue));
          VarValue := StrVal;
        end;  
      ftVariant:
        VarValue := Variant(DataValueBuf^);
      ftInterface:
        VarValue := IUnknown(DataValueBuf^);
      ftIDispatch:
        VarValue := IDispatch(DataValueBuf^);
      ftDate, ftTime, ftDateTime:
        begin
          DataConvert(Field, DataValueBuf, @DateVal, False);
          VarValue := DateVal;
        end;
      ftBCD:
        begin
          DataConvert(Field, DataValueBuf, @CurrencyVal, False);
          VarValue := CurrencyVal;
        end;
      ftBytes, ftVarBytes:
        DataConvert(Field, DataValueBuf, @VarValue, False);
      ftLargeInt:
{$IFDEF EH_LIB_6}
        VarValue := Int64(DataValueBuf^);
{$ENDIF}
      else
        DatabaseErrorFmt('SUnsupportedFieldType', [FieldTypeNames[Field.DataType],
          Field.DisplayName]);
    end;
end;

function TCustomMemTableEh.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
//var
//  Accept: Boolean;
begin
  Result := grOk;
//  Accept := True;
  case GetMode of
    gmPrior:
      if FRecordPos <= 0 then
      begin
        Result := grBOF;
        FRecordPos := -1;
        FInstantReadCurRow := 0;
      end else
        Dec(FRecordPos);
    gmCurrent:
      if (FRecordPos < 0) or (FRecordPos >= RecordsView.Count) then
        Result := grError;
    gmNext:
      begin
        if FRecordPos >= FRecordsView.Count - 1 then
          if FetchAllOnOpen
            then DoFetchRecords(-1)
            else DoFetchRecords(1);
        if FRecordPos >= FRecordsView.Count - 1 then
        begin
          FRecordPos := FRecordsView.Count;
          Result := grEOF
        end else
          Inc(FRecordPos);
      end;
  end;
  if FRecordPos >= 0 then
    FInstantReadCurRow := FRecordPos;
  if Result = grOk then
  begin
    RecordToBuffer(FRecordsView[FRecordPos].Data, Buffer);
    PRecBuf(Buffer)^.RecInfo.Bookmark := FRecordsView[FRecordPos].ID;
    PRecBuf(Buffer)^.RecInfo.RecordNumber := FRecordPos;
  end else if (Result = grError) and DoCheck then
    Error(SMemNoRecords);
end;

function TCustomMemTableEh.GetRecordSize: Word;
begin
  Result := FRecBufSize;
//  Result := FDataRecordSize;
end;

function TCustomMemTableEh.GetActiveRecBuf(var RecBuf: PChar): Boolean;

  function GetOldValuesBuffer: PChar;
  begin
    UpdateCursorPos;
    if FRecordsView.OldRecVals[FRecordPos] <> nil then
    begin
      Result := TempBuffer;
      RecordToBuffer(FRecordsView.OldRecVals[FRecordPos], Result);
    end else
      Result := nil;
  end;

begin
  if FInstantReadMode then
    RecBuf := FInstantBuffer
  else
    case State of
      dsBrowse:
        if IsEmpty
          then RecBuf := nil
          else RecBuf := ActiveBuffer;
      dsOldValue:
        begin
          RecBuf := GetOldValuesBuffer;
          if RecBuf = nil then
            RecBuf := ActiveBuffer;
        end;
      dsEdit, dsInsert, dsNewValue: RecBuf := ActiveBuffer;
      dsCalcFields: RecBuf := CalcBuffer;
      dsFilter: RecBuf := TempBuffer;
      else RecBuf := nil;
    end;
  Result := RecBuf <> nil;
end;

{ Field Data }

function TCustomMemTableEh.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  RecBuf: PRecBuf;
  FieldBufNo: Integer;
begin
  Result := GetActiveRecBuf(PChar(RecBuf));
  if not Result then Exit;
  if Field.FieldNo > 0
    then FieldBufNo := Field.FieldNo - 1
    else FieldBufNo := Field.Offset + DataFieldsCount;

  if not PRecBuf(RecBuf)^.Values[FieldBufNo].IsNull  then
  begin
    if Buffer <> nil then
    begin
      Move(PChar(PRecBuf(RecBuf)^.Values[FieldBufNo].DataValue)^, Buffer^, Field.DataSize);
    end;
  end else
    Result := False;
end;

procedure TCustomMemTableEh.SetFieldData(Field: TField; Buffer: Pointer);
var
  RecBuf: PRecBuf;
  FieldBufNo: Integer;
begin
  if not GetActiveRecBuf(PChar(RecBuf)) then Exit;

  if Field.FieldNo > 0
    then FieldBufNo := Field.FieldNo - 1
    else FieldBufNo := Field.Offset + DataFieldsCount;

  if Buffer = nil then
    RecBuf^.Values[FieldBufNo].IsNull := True
  else
  begin
    SetLength(RecBuf^.Values[FieldBufNo].DataValue, Field.DataSize);
    Move(Buffer^, PChar(PRecBuf(RecBuf)^.Values[FieldBufNo].DataValue)^, Field.DataSize);
    RecBuf^.Values[FieldBufNo].IsNull := False;
  end;
  if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
    DataEvent(deFieldChange, Longint(Field));
end;

{ Filter }

procedure TCustomMemTableEh.RecreateFilterExpr;
begin
  if Filtered
    then FFilterExpr.ParseExpression(Filter)
    else FFilterExpr.ParseExpression('');
{
  FFilterExpr.Free;
  FFilterExpr := nil;
  if Filter <> '' then
    FFilterExpr := TExprParser.Create
      (Self, Filter, FilterOptions, [poExtSyntax], '', nil, FieldTypeMap);
}
end;

procedure TCustomMemTableEh.DestroyFilterExpr;
begin
  FFilterExpr.ParseExpression('');
//  FFilterExpr.Free;
//  FFilterExpr := nil;
end;

procedure TCustomMemTableEh.SetFilterText(const Value: string);
begin
  if Value <> Filter then
  begin
    inherited SetFilterText(Value);
    RecreateFilterExpr;
    Refresh;
  end;
end;

procedure TCustomMemTableEh.SetFiltered(Value: Boolean);
begin
  if Active then
  begin
    CheckBrowseMode;
    if Filtered <> Value then
    begin
      inherited SetFiltered(Value);
//      First;
      Refresh;
    end;
  end
  else inherited SetFiltered(Value);
end;

procedure TCustomMemTableEh.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
  if Active then
  begin
    CheckBrowseMode;
    inherited SetOnFilterRecord(Value);
    if Filtered then
      Refresh;
  end
  else inherited SetOnFilterRecord(Value);
end;

function TCustomMemTableEh.IsRecordInFilter(RecValues: PRecValues): Boolean;
var
  SaveState: TDataSetState;
  DetV, MasV: Variant;
begin
  Result := True;
  if (Filtered and (Assigned(OnFilterRecord) or (Filter <> '')) ) or FDetailMode then
  begin
    SaveState := SetTempState(dsFilter);
    try
      RecordToBuffer(RecValues, TempBuffer);

      if FFilterExpr.HasData then
        Result := FFilterExpr.IsCurRecordInFilter;

      if Filtered and Assigned(OnFilterRecord) then
        OnFilterRecord(Self, Result);

      if Result and FDetailMode and (MasterDetailSide = mdsOnSelfEh)  then
      begin
        { TODO : Use FDetailFieldList for fast}
        DetV := FieldValues[FDetailFields];
        MasV := MasterSource.DataSet.FieldValues[MasterFields];
        Result := VarEquals(DetV, MasV);
      end;

    except
      Application.HandleException(Self);
    end;
    RestoreState(SaveState);
  end;
end;

{ Blobs }

function TCustomMemTableEh.GetBlobData(Field: TField; Buffer: PChar): TMemBlobData;
begin
  with PRecBuf(Buffer)^.Values[Field.FieldNo-1] do
    if IsNull
      then Result := ''
      else Result := PRecBuf(Buffer)^.Values[Field.FieldNo-1].DataValue;
end;

procedure TCustomMemTableEh.SetBlobData(Field: TField; Buffer: PChar; Value: TMemBlobData);
begin
  if (Buffer = ActiveBuffer) then
  begin
    if State = dsFilter then
      Error(SNotEditing);
    PRecBuf(Buffer)^.Values[Field.FieldNo-1].DataValue := Value;
    PRecBuf(Buffer)^.Values[Field.FieldNo-1].IsNull := False;
  end;
end;

procedure TCustomMemTableEh.CloseBlob(Field: TField);
begin
{  if (FRecordPos >= 0) and (FRecordPos < FRecordsView.Count) and (State = dsEdit) then
    PMemBlobArray(ActiveBuffer + FBlobOfs)[Field.FieldNo] :=
      PMemBlobArray(Records[FRecordPos].FBlobs)[Field.Offset]
  else
    PMemBlobArray(ActiveBuffer + FBlobOfs)[Field.Offset] := '';}
end;

function TCustomMemTableEh.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
  Result := TMemBlobStreamEh.Create(Field as TBlobField, Mode);
end;

{ Bookmarks }

function TCustomMemTableEh.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
  Result := FActive and (FRecordsView.FindRecId(TRecIdEh(Bookmark^)) > -1);
end;

function TCustomMemTableEh.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
var
  RecPos1, RecPos2: Integer;
begin
  if (Bookmark1 = nil) and (Bookmark2 = nil) then
    Result := 0
  else if (Bookmark1 <> nil) and (Bookmark2 = nil) then
    Result := 1
  else if (Bookmark1 = nil) and (Bookmark2 <> nil) then
    Result := -1
  else
  begin
    RecPos1 := InstantReadIndexOfBookmark(Bookmark1);
    RecPos2 := InstantReadIndexOfBookmark(Bookmark2);
    if RecPos1 > RecPos2 then
      Result := 1
    else if RecPos1 < RecPos2 then
      Result := -1
    else Result := 0;
  end;
end;

function TCustomMemTableEh.GetBookmarkStr: TBookmarkStr;
begin
  if FInstantReadMode then
  begin
    SetLength(Result, BookmarkSize);
    GetBookmarkData(FInstantBuffer, Pointer(Result));
  end else
    Result := inherited GetBookmarkStr;
end;

procedure TCustomMemTableEh.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(PRecBuf(Buffer)^.RecInfo.Bookmark, Data^, SizeOf(TRecIdEh));
end;

procedure TCustomMemTableEh.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Move(Data^, PRecBuf(Buffer)^.RecInfo.Bookmark, SizeOf(TRecIdEh));
end;

function TCustomMemTableEh.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PRecBuf(Buffer)^.RecInfo.BookmarkFlag;
end;

procedure TCustomMemTableEh.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PRecBuf(Buffer)^.RecInfo.BookmarkFlag := Value;
end;

procedure TCustomMemTableEh.InternalGotoBookmark(Bookmark: TBookmark);
var
  FindedRecPos: Integer;
begin
  FindedRecPos := FRecordsView.FindRecId(TRecIdEh(Bookmark^));
  if FindedRecPos <> -1
    then FRecordPos := FindedRecPos
    else DatabaseError(SRecordNotFound, Self);
  FInstantReadCurRow := FRecordPos;
end;

function TCustomMemTableEh.InstantReadIndexOfBookmark(Bookmark: TBookmark): Integer;
begin
  if Bookmark = nil
    then Result := -1
    else Result := FRecordsView.FindRecId(TRecIdEh(Bookmark^));
end;

{ Navigation }

procedure TCustomMemTableEh.InternalSetToRecord(Buffer: PChar);
begin
  InternalGotoBookmark(@PRecBuf(Buffer)^.RecInfo.Bookmark);
end;

procedure TCustomMemTableEh.InternalFirst;
begin
  FRecordPos := -1;
  FInstantReadCurRow := 0;
end;

procedure TCustomMemTableEh.InternalLast;
begin
  DoFetchRecords(-1);
  FRecordPos := FRecordsView.Count;
  if not (State in dsEditModes) then
    FInstantReadCurRow := FRecordPos - 1;
end;

{ Data Manipulation }

procedure TCustomMemTableEh.SetMemoryRecordData(Buffer: PChar; ARecValues: PRecValues);
var
  i: Integer;
begin
  if State = dsFilter then
    Error(SNotEditing);
  SetLength(ARecValues^, DataFieldsCount);
  for i := 0 to FieldCount-1 do
    if Fields[i].FieldNo > 0 then
//      FieldValueToVarValue(@PRecBuf(Buffer)^.Values[i], ARecValues^[Fields[i].FieldNo-1], Fields[i]);
      FieldValueToVarValue(@PRecBuf(Buffer)^.Values[Fields[i].FieldNo-1], ARecValues^[Fields[i].FieldNo-1], Fields[i]);
end;

procedure TCustomMemTableEh.SetAutoIncFields(Buffer: PChar);
var
  I, Count: Integer;
  Data: PChar;
begin
  Count := 0;
  for I := 0 to FieldCount - 1 do
    if (Fields[I].FieldKind in fkStoredFields) and
      (Fields[I].DataType = ftAutoInc) then
    begin