memtableeh.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

          else Data := VarFMTBcdCreate(TBcd(Buffer^));
{$ENDIF}
      else
        DatabaseErrorFmt('SUsupportedFieldType', [FieldTypeNames[Field.DataType],
          Field.DisplayName]);
    end;
  end;
{$ENDIF}

begin
  if not GetActiveRecBuf(RecBuf) then Exit;

//  if Field.FieldNo > 0
//    then FieldBufNo := Field.FieldNo - 1
//    else FieldBufNo := FCalcFieldIndexes[Field.Index] + DataFieldsCount;
  FieldBufNo := Field.Index;

  if Buffer = nil
    then RecBuf.Values[FieldBufNo] := Null
    else BufferToVar(RecBuf.Values[FieldBufNo]);

  if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
{$IFDEF CIL}
    DataEvent(deFieldChange, Field);
{$ELSE}
    DataEvent(deFieldChange, Longint(Field));
{$ENDIF}
end;

procedure TCustomMemTableEh.SetFieldData(Field: TField;
  Buffer: {$IFDEF CIL}TValueBuffer{$ELSE}Pointer{$ENDIF});
begin
  SetFieldData(Field, Buffer, True);
end;

{ Filter }

procedure TCustomMemTableEh.RecreateFilterExpr;
begin
  if Filtered
    then FFilterExpr.ParseExpression(Filter)
    else FFilterExpr.ParseExpression('');
end;

procedure TCustomMemTableEh.DestroyFilterExpr;
begin
  FFilterExpr.ParseExpression('');
end;

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

procedure TCustomMemTableEh.SetFiltered(Value: Boolean);
begin
  if Active then
  begin
    CheckBrowseMode;
    if Filtered <> Value then
    begin
      inherited SetFiltered(Value);
      RecreateFilterExpr;
//      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(Rec: TMemoryRecordEh): 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(Rec, dvvValueEh, 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: TRecBuf): TMemBlobData;
begin
//  with PRecBuf(Buffer)^.Values[Field.FieldNo-1] do
    if VarIsNull(Buffer.Values[Field.FieldNo-1])
      then Result := ''
      else Result := Buffer.Values[Field.FieldNo-1];
end;

procedure TCustomMemTableEh.SetBlobData(Field: TField; Buffer: TRecBuf; Value: TMemBlobData);
begin
  if (Buffer = BufferToRecBuf(ActiveBuffer)) then
  begin
    if State = dsFilter then
      Error(SNotEditing);
    Buffer.Values[Field.FieldNo-1] := Value;
  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({$IFDEF CIL}const{$ENDIF} Bookmark: TBookmark): Boolean;
var
  RecId: TRecIdEh;
begin
{$IFDEF CIL}
  RecId := TRecIdEh(Bookmark);
{$ELSE}
  RecId := TRecIdEh(Bookmark^);
{$ENDIF}
  Result := FActive and (FRecordsView.FindRecId(RecId) > -1);
end;

function TCustomMemTableEh.CompareBookmarks({$IFDEF CIL}const{$ENDIF} 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 := IndexOfBookmark(Bookmark1);
    RecPos2 := IndexOfBookmark(Bookmark2);
    if RecPos1 > RecPos2 then
      Result := 1
    else if RecPos1 < RecPos2 then
      Result := -1
    else Result := 0;
  end;
end;

function TCustomMemTableEh.GetBookmarkStr: TBookmarkStr;
{$IFDEF CIL}
var
  TempPtr: intPtr;
{$ENDIF}
begin
  if FInstantReadMode then
  begin
{$IFDEF CIL}
    TempPtr := Marshal.AllocHGlobal(BookmarkSize);
    try
      InitializeBuffer(TempPtr, BookmarkSize, 0);
      GetBookmarkData(FInstantBuffer, TempPtr);
      Result := Marshal.PtrToStringAnsi(TempPtr, BookmarkSize);
    finally
      Marshal.FreeHGlobal(TempPtr);
    end;
{$ELSE}
    SetLength(Result, BookmarkSize);
    GetBookmarkData(FInstantBuffer, Pointer(Result));
{$ENDIF}
  end else
    Result := inherited GetBookmarkStr;
end;

procedure TCustomMemTableEh.GetBookmarkData(
{$IFDEF CIL}
  Buffer: TRecordBuffer; var Bookmark: TBookmark
{$ELSE}
  Buffer: PChar; Data: Pointer
{$ENDIF}
  );
begin
{$IFDEF CIL}
  Marshal.WriteIntPtr(BookMark, IntPtr(BufferToRecBuf(Buffer).Bookmark));
{$ELSE}
  Move(BufferToRecBuf(Buffer).Bookmark, Data^, SizeOf(TRecIdEh));
{$ENDIF}
end;

procedure TCustomMemTableEh.SetBookmarkData(
{$IFDEF CIL}
  Buffer: TRecordBuffer; const Bookmark: TBookmark
{$ELSE}
  Buffer: PChar; Data: Pointer
{$ENDIF}
  );
begin
{$IFDEF CIL}
  BufferToRecBuf(Buffer).Bookmark := Marshal.ReadInt32(BookMark);
{$ELSE}
  Move(Data^, BufferToRecBuf(Buffer).Bookmark, SizeOf(TRecIdEh));
{$ENDIF}
end;

function TCustomMemTableEh.GetBookmarkFlag(
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): TBookmarkFlag;
begin
  Result := BufferToRecBuf(Buffer).BookmarkFlag;
end;

procedure TCustomMemTableEh.SetBookmarkFlag(
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}; Value: TBookmarkFlag);
begin
  BufferToRecBuf(Buffer).BookmarkFlag := Value;
end;

procedure TCustomMemTableEh.InternalGotoBookmark({$IFDEF CIL}const{$ENDIF} Bookmark: TBookmark);
var
  FindedRecPos: Integer;
  RecId: TRecIdEh;
begin
{$IFDEF CIL}
  RecId := TRecIdEh(Bookmark);
{$ELSE}
  RecId := TRecIdEh(Bookmark^);
{$ENDIF}
  { TODO : Add support of MemoryTreeList }
  FindedRecPos := FRecordsView.FindRecId(RecId);
  if FindedRecPos <> -1
    then FRecordPos := FindedRecPos
    else DatabaseError(SRecordNotFound, Self);
  FInstantReadCurRow := FRecordPos;
end;

function TCustomMemTableEh.InstantReadIndexOfBookmark(Bookmark: TBookmarkStr): Integer;
{$IFDEF CIL}
var
  TempPtr: IntPtr;
{$ENDIF}
begin
{$IFDEF CIL}
  try
    TempPtr := Marshal.StringToHGlobalAnsi(Bookmark);
    Result := IndexOfBookmark(TempPtr);
  finally
    Marshal.FreeHGlobal(TempPtr);
  end;
{$ELSE}
  Result := IndexOfBookmark(TBookmark(Bookmark));
{$ENDIF}
end;

function TCustomMemTableEh.IndexOfBookmark(Bookmark: TBookmark): Integer;
var
  RecId: TRecIdEh;
begin
  if Bookmark = nil then
    Result := -1
    { TODO : Add support of MemoryTreeList }
  else
  begin
{$IFDEF CIL}
    RecId := TRecIdEh(Bookmark);
{$ELSE}
    RecId := TRecIdEh(Bookmark^);
{$ENDIF}
    Result := FRecordsView.FindRecId(RecId);
  end;
end;

{ Navigation }

procedure TCustomMemTableEh.InternalSetToRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  if BufferToRecBuf(Buffer).RecordNumber >= 0 then
  begin
    FRecordPos := BufferToRecBuf(Buffer).RecordNumber;
    FInstantReadCurRow := FRecordPos;
  end else
    DatabaseError(SRecordNotFound, Self);
//  InternalGotoBookmark(@PRecBuf(Buffer)^.RecInfo.Bookmark);
end;

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

procedure TCustomMemTableEh.InternalLast;
begin
  DoFetchRecords(-1);
  FRecordPos := FRecordsView.ViewItemsCount;
  if State in dsEditModes
    then FInstantReadCurRow := FRecordsView.ViewItemsCount // From AppendRecord
    else FInstantReadCurRow := FRecordPos - 1;
end;

{ Data Manipulation }

procedure TCustomMemTableEh.InternalAddRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}Pointer{$ENDIF}; Append: Boolean);
var
  RecPos: Integer;
  Rec: TMemoryRecordEh;
begin

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

      SetMemoryRecordData(Buffer, Rec);
    except
      Rec.Free;
      raise;
    end;
    FRecordsView.AddRecord(Rec);
    if not CachedUpdates then
      try
        InternalApplyUpdates(-1);
      except
        FRecordsView.CancelUpdates;
        raise;
      end;
    FRecordPos := FRecordsView.ViewItemsCount - 1;
  end else
  begin
    Rec := FRecordsView.NewRecord;
    try
//      SetAutoIncFields(Buffer);
      SetMemoryRecordData(Buffer, Rec);

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

    FRecordsView.InsertRecord(RecPos, Rec);
    if not CachedUpdates then
      try
        InternalApplyUpdates(-1);
      except
        FRecordsView.CancelUpdates;
        raise;
      end;
    FRecordPos := RecPos;
  end;
end;

procedure TCustomMemTableEh.InternalCancel;
begin
  if not CachedUpdates and FRecordsView.MemTableData.RecordsList.HasCachedChanges then
    CancelUpdates;
end;

procedure TCustomMemTableEh.InternalPost;
begin
  if State = dsEdit then
  begin
    FRecordsView.ViewRecord[FRecordPos].Edit;
    SetMemoryRecordData(ActiveBuffer, FRecordsView.ViewRecord[FRecordPos]);
    FRecordsView.ViewRecord[FRecordPos].Post;
    if not CachedUpdates then
//      try
        InternalApplyUpdates(-1);
//      except
//        FRecordsView.CancelUpdates;
//        raise;
//      end;
  end else
    InternalAddRecord(ActiveBuffer, Eof);
end;

procedure TCustomMemTableEh.InternalDelete;
begin
  { TODO : Add support of MemoryTreeList }
  FRecordsView.DeleteRecord(FRecordPos);
  if not CachedUpdates then
    try
      InternalApplyUpdates(-1);
    except
      FRecordsView.CancelUpdates;
      raise;
    end;

  if FRecordPos >= FRecordsView.ViewItemsCount then
    Dec(FRecordPos);
  Resync([]);
end;

procedure TCustomMemTableEh.CreateFields;
begin
  inherited CreateFields;
end;

procedure TCustomMemTableEh.OpenCursor(InfoQuery: Boolean);
begin
  if not InfoQuery then
  begin
    if  DataDriver <> nil then
    begin
      if (MasterSource <> nil) and (MasterDetailSide = mdsOnProviderEh) then
        SetParamsFromCursor;
      { TODO : realise DataDriver.SetParams(FParams); }
      // DataDriver.PSSetParams(FParams);
      FDataSetReader := FDataDriver.GetDataReader;
      if FDataSetReader <> nil then
        FDataSetReader.FreeNotification(Self);
    end;
    if DataDriver <> nil then
      //? 念徉忤螯 (FieldCount > 0) then 眍 蝾朦觐 礤 潆