memtableeh.pas

最新的 DBGRIDEH4.0

        if not Result then Exit;
      end
    else
      Result := V1 = V2;
  except
  end;
end;
//{$DEBUGINFO ON}

(*
function GetOldFieldValue(DataSet: TDataSet; const FieldName: string): Variant;
var
  I: Integer;
  Fields: TObjectList;
begin
  if Pos(';', FieldName) <> 0 then
  begin
    Fields := TObjectList.Create(False);
    try
      DataSet.GetFieldList(Fields, FieldName);
      Result := VarArrayCreate([0, Fields.Count - 1], varVariant);
      for I := 0 to Fields.Count - 1 do
        Result[I] := TField(Fields[I]).OldValue;
    finally
      Fields.Free;
    end;
  end else
    Result := DataSet.FieldByName(FieldName).OldValue
end;
*)

{ TRecBuf }
{unction TRecBuf.GetTreeNode: TMemRecViewEh;
begin
  Result := nil;
  if Assigned(RecordsView) and (RecordNumber >= 0) and RecordsView.ViewAsTreeList then
    Result := RecordsView.MemoryTreeList.VisibleItem[RecordNumber];
end;

function TRecBuf.GetMemRec: TMemoryRecordEh;
begin
  Result := nil;
  if Assigned(RecordsView) and (RecordNumber >= 0) then
    Result := RecordsView.ViewRecord[RecordNumber];
end;}

destructor TRecBuf.Destroy;
var
  i: Integer;
begin
  for i := 0 to Length(Values) - 1 do
    Values[i] := Null;
  Values := nil;
  inherited Destroy;
end;

function TRecBuf.GetValue(Field: TField): Variant;
begin
  if UseMemRec and (MemRec <> nil) and (Field.FieldNo > 0) then
    Result := MemRec.Value[Field.FieldNo-1, dvvValueEh]
  else
    Result := Values[Field.Index];
end;

procedure TRecBuf.SetValue(Field: TField; v: Variant);
var
  i: Integer;
begin
  if UseMemRec and not (Field.FieldKind in [fkCalculated, fkLookup]) then
  begin
    for i := 0 to Field.DataSet.Fields.Count-1 do
      if Field.DataSet.Fields[i].FieldNo > 0 then
        Values[Field.DataSet.Fields[i].Index] :=
          MemRec.Value[Field.DataSet.Fields[i].FieldNo-1, dvvValueEh];
    UseMemRec := False;
  end;
  Values[Field.Index] := v;
end;

function TRecBuf.ReadValueCount: Integer;
begin
  Result := Length(Values);
end;

procedure TRecBuf.SetLength(Len: Integer);
begin
{$IFDEF CIL}
  Borland.Delphi.System.SetLength(Values, Len);
{$ELSE}
  System.SetLength(Values, Len);
{$ENDIF}
  Clear;
end;

procedure TRecBuf.Clear;
var
  I: Integer;
begin
  for I := 0 to Length(Values) - 1 do
    Values[I] := Null;
end;
{
type
  TDataSetOrderByList = class(TOrderByList)
  protected
    FDataSet: TDataSet;
    function FindFieldIndex(FieldName: String): Integer; override;
  public
    constructor Create(ADataSet: TDataSet);
  end;

constructor TDataSetOrderByList.Create(ADataSet: TDataSet);
begin
  inherited Create;
  FDataSet := ADataSet;
end;

function TDataSetOrderByList.FindFieldIndex(FieldName: String): Integer;
var
  Field: TField;
begin
  Result := -1;
  Field := FDataSet.FindField(FieldName);
  if Field <> nil then
    Result := Field.Index;
end;
}

{ TMasterDataLinkEh }

constructor TMasterDataLinkEh.Create(DataSet: TDataSet);
begin
  inherited Create;
  FDataSet := DataSet;
  FFields := TObjectList.Create(False);
end;

destructor TMasterDataLinkEh.Destroy;
begin
  FreeAndNil(FFields);
  inherited Destroy;
end;

procedure TMasterDataLinkEh.ActiveChanged;
begin
  FFields.Clear;
  if Active then
    try
      DataSet.GetFieldList(FFields, FFieldNames);
    except
      FFields.Clear;
      raise;
    end;
  if FDataSet.Active and not (csDestroying in FDataSet.ComponentState) then
    if Active {and (FFields.Count > 0)} then
    begin
      if Assigned(FOnMasterChange) then FOnMasterChange(Self);
    end else
      if Assigned(FOnMasterDisable) then FOnMasterDisable(Self);
end;

procedure TMasterDataLinkEh.CheckBrowseMode;
begin
  if FDataSet.Active then FDataSet.CheckBrowseMode;
end;

function TMasterDataLinkEh.GetDetailDataSet: TDataSet;
begin
  Result := FDataSet;
end;

procedure TMasterDataLinkEh.LayoutChanged;
begin
  ActiveChanged;
end;

procedure TMasterDataLinkEh.RecordChanged(Field: TField);
begin
  if (DataSource.State <> dsSetKey) and FDataSet.Active and
    {(FFields.Count > 0) and }((Field = nil) or
    (FFields.IndexOf(Field) >= 0)) and
     Assigned(FOnMasterChange)
  then
    FOnMasterChange(Self);
end;

procedure TMasterDataLinkEh.SetFieldNames(const Value: string);
begin
  if FFieldNames <> Value then
  begin
    FFieldNames := Value;
    ActiveChanged;
  end;
end;

{ TCustomMemTableEh }

constructor TCustomMemTableEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRecordPos := -1;
  FInstantReadCurRowNum := -1;
  FAutoInc := 1;
  FRecordCache := TObjectList.Create(True);

  FInternMemTableData := TMemTableDataEh.Create(Self);
  FInternMemTableData.Name := 'MemTableData';

  FRecordsView := TRecordsViewEh.Create(Self);
  FRecordsView.OnFilterRecord := IsRecordInFilter;
  FRecordsView.OnParseOrderByStr := ParseOrderByStr;
  FRecordsView.OnCompareRecords := CompareRecords;
  FRecordsView.OnCompareTreeNode := CompareTreeNodes;
  FRecordsView.OnGetPrefilteredList := GetPrefilteredList;
  FRecordsView.OnViewDataEvent := ViewDataEvent;
//  FRecordsView.MemTableData := FInternMemTableData;
  FRecordsView.DataObject := FInternMemTableData;
  FRecordsView.OnFetchRecords := DoFetchRecords;
  FRecordsView.MemoryTreeList.OnExpandedChanging := TreeViewNodeExpanding;
  FRecordsView.MemoryTreeList.OnExpandedChanged := TreeViewNodeExpanded;
  FRecordsView.OnApplyUpdates := MTApplyUpdates;

  FMasterDataLink := TMasterDataLinkEh.Create(Self);
  FMasterDataLink.OnMasterChange := MasterChange;
  FDetailFieldList := TObjectList.Create(False);
  FParams := TParams.Create(Self);
  FFilterExpr := TDataSetExprParserEh.Create(Self, dsptFilterEh);
  FTreeList := TMemTableTreeListEh.Create(Self);
  FDetailRecList := TObjectList.Create(False);
  FInstantBuffers := TObjectList.Create(False);
  FMasterValList := TSortedVarlistEh.Create;
  FMasterValList.Clear;

end;

destructor TCustomMemTableEh.Destroy;
begin
  Close;
  FreeAndNil(FMasterValList);
  TreeList.Active := False;
  FreeAndNil(FFilterExpr);
  FreeAndNil(FParams);
  FDetailFieldList.Clear;
  FreeAndNil(FDetailFieldList);
  if ExternalMemData = nil then
    ClearRecords;
  FreeAndNil(FRecordsView);
  FreeAndNil(FMasterDataLink);
  FreeAndNil(FTreeList);
  FreeAndNil(FIndexDefs);
  FreeAndNil(FRecordCache);
  FreeAndNil(FDetailRecList);
  FreeAndNil(FInternMemTableData);
  FreeAndNil(FInstantBuffers);
  DataDriver := nil;
  inherited Destroy;
end;

{ Field Management }

{$IFNDEF EH_LIB_5}

function TCustomMemTableEh.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
begin
  Move(BCD^, Curr, SizeOf(Currency));
  Result := True;
end;

function TCustomMemTableEh.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  Decimals: Integer): Boolean;
begin
  Move(Curr, BCD^, SizeOf(Currency));
  Result := True;
end;

{$ENDIF EH_LIB_5}

procedure TCustomMemTableEh.InitFieldDefsFromFields;
var
  I: Integer;
begin
  if FieldDefs.Count = 0 then
  begin
    FAutoIncrementFieldName := '';
    for I := 0 to FieldCount - 1 do
    begin
      with Fields[I] do
      begin
        if (FieldKind in fkStoredFields) and not (DataType in ftSupported) then
          ErrorFmt(SUnknownFieldType, [DisplayName]);
        if AutoGenerateValue = arAutoInc then
          FAutoIncrementFieldName := FieldName;
      end;
    end;
//    FreeIndexList;
  end;

  inherited InitFieldDefsFromFields;
end;

{ Buffer Manipulation }

procedure TCustomMemTableEh.InitBufferPointers(GetProps: Boolean);
begin
//  if GetProps then
//    FDataRecordSize := (Fields.Count * SizeOf(OleVariant));

  { TODO : FRecBufSize need? }
  FRecBufSize := -1; //SizeOf(TRecInfo) + (Fields.Count * SizeOf(Pointer));
end;

procedure TCustomMemTableEh.ClearRecords;
begin
  RecordsView.MemTableData.RecordsList.Clear;
  RecordsView.MemTableData.AutoIncrement.Reset;
  FRecordPos := -1;
  FInstantReadCurRowNum := -1;
end;

function TCustomMemTableEh.IndexToBuffer(I: Integer): {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
begin
{$IFDEF CIL}
  Result := TRecordBuffer(I + 1);
{$ELSE}
  Result := PChar(I + 1);
{$ENDIF}
end;

function TCustomMemTableEh.BufferToIndex(Buf: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): Integer;
begin
  Result := Integer(Buf) - 1; // Buf is off by one so that nil (0) represents an invalid buffer
end;

function TCustomMemTableEh.BufferToRecBuf(Buf: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): TRecBuf;
begin
  Result := TRecBuf(FRecordCache[BufferToIndex(Buf)]);
end;

function TCustomMemTableEh.AllocRecordBuffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};

  procedure ClearBuffer(RecBuf: TRecBuf);
//  var
//    I: Integer;
  begin
    RecBuf.SetLength(FieldCount);
//    SetLength(RecBuf.Values, FieldCount);
//    for I := 0 to Fields.Count - 1 do
//      RecBuf.Values[I] := Null;
  end;

  function InitializeBuffer(I: Integer): {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
  begin
    TRecBuf(FRecordCache[I]).InUse := True;
    TRecBuf(FRecordCache[I]).RecordNumber := -2;
    ClearBuffer(TRecBuf(FRecordCache[I]));
    Result := IndexToBuffer(I);
  end;

var
  RecBuf: TRecBuf;
  I, NewIndex: Integer;
begin
  for I := 0 to FRecordCache.Count - 1 do
    if not TRecBuf(FRecordCache[I]).InUse then
    begin
      Result := InitializeBuffer(I);
      Exit;
    end;