memtableeh.pas

ehlib31控件包

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

  function GetOldValuesBuffer: PChar;
  begin
    UpdateCursorPos;
    if FRecords.OldRecVals[FRecordPos] <> nil then
    begin
      Result := TempBuffer;
      RecordToBuffer(FRecords.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
  FFilterExpr.Free;
  FFilterExpr := nil;
{ttt  if Filter <> '' then
    FFilterExpr := TExprParser.Create
      (Self, Filter, FilterOptions, [poExtSyntax], '', nil, FieldTypeMap);
}
end;

procedure TCustomMemTableEh.DestroyFilterExpr;
begin
  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);

//ttt      if FFilterExpr <> nil then
//        Result := IsCurRecordInFilter(Self, FFilterExpr);

      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 < FRecords.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 (FRecords.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 := FRecords.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 := FRecords.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 := FRecords.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
      Data := FindFieldData(Buffer, Fields[I]);
      if Data <> nil then
      begin
        Boolean(Data[0]) := True;
        Inc(Data);
        Move(FAutoInc, Data^, SizeOf(Longint));
        Inc(Count);
      end;
    end;
  if Count > 0 then
    Inc(FAutoInc);
end;

procedure TCustomMemTableEh.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
  RecPos: Integer;
  Rec: TMemoryRecordEh;
begin

  if Append then
  begin
    Rec := FRecords.NewRecord;
    try
      SetAutoIncFields(Buffer);

      if (ProviderDataSet <> nil) and not CachedUpdates then
        UpdateThroughProvider(Rec, ActiveBuffer, ukInsert, FRecords.Count - 1);
      SetMemoryRecordData(Buffer, Rec.Data);
    except
      Rec.Free;
      raise;
    end;
    FRecords.AddRecord(Rec);
    FRecordPos := FRecords.Count - 1;
  end else
  begin
    Rec := FRecords.NewRecord;
    try
      SetAutoIncFields(Buffer);
      if (ProviderDataSet <> nil) and not CachedUpdates then
        if FRecordPos = -1
          then UpdateThroughProvider(FRecords[FRecordPos], ActiveBuffer, ukInsert, 0)
          else UpdateThroughProvider(FRecords[FRecordPos], ActiveBuffer, ukInsert, FRecordPos);
      SetMemoryRecordData(Buffer, Rec.Data);

      if FRecordPos = -1
        then RecPos := 0
        else RecPos := FRecordPos;
    except
      Rec.Free;
      raise;
    end;

    FRecords.InsertRecord(RecPos, Rec);
    FRecordPos := RecPos;
  end;
end;

procedure TCustomMemTableEh.InternalPost;
begin
  if State = dsEdit then
  begin
    if (ProviderDataSet <> nil) and not CachedUpdates then
      UpdateThroughProvider(FRecords[FRecordPos], ActiveBuffer, ukModify, FRecordPos);
    FRecords[FRecordPos].BeginEdit;
    SetMemoryRecordData(ActiveBuffer, FRecords[FRecordPos].Data);
    FRecords[FRecordPos].EndEdit(True);
  end else
    InternalAddRecord(ActiveBuffer, Eof);
end;

procedure TCustomMemTableEh.UpdateThroughProvider(MemRec: TMemoryRecordEh;
  NewBuffer: PChar; UpdateKind: TUpdateKind; RecPos: Integer);
var
  TmpRecData: TRecDataValues;
begin
  if UpdateKind in [ukModify, ukInsert] then
  begin
    SetLength(TmpRecData, DataFieldsCount);
    SetMemoryRecordData(NewBuffer, @TmpRecData);
    FRecords.ApplyUpdate(MemRec.Data, @TmpRecData,
      UpdateKind, ProviderDataSet, @TmpRecData);
    RecordToBuffer(@TmpRecData, NewBuffer)
  end else
    FRecords.ApplyUpdate(MemRec.Data, MemRec.Data, UpdateKind, ProviderDataSet, nil);
end;

procedure TCustomMemTableEh.InternalDelete;
begin
  if (ProviderDataSet <> nil) and not CachedUpdates then
    UpdateThroughProvider(FRecords[FRecordPos], ActiveBuffer, ukDelete, FRecordPos);