memtableeh.pas

EHLIB控件源码,很好用的表格控件,可进行统计求和功能.

  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;

{
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.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);
  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
    for I := 0 to FieldCount - 1 do
    begin
      with Fields[I] do
        if (FieldKind in fkStoredFields) and not (DataType in ftSupported) then
          ErrorFmt(SUnknownFieldType, [DisplayName]);
    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
    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;

  RecBuf := TRecBuf.Create;
  ClearBuffer(RecBuf);
  RecBuf.RecordStatus := -2;
//  RecBuf.TreeNode := nil;
//  RecBuf.MemRec := nil;
  RecBuf.RecordsView := nil;
  NewIndex := FRecordCache.Add(RecBuf);
  Result := InitializeBuffer(NewIndex);
end;

procedure TCustomMemTableEh.FreeRecordBuffer(var Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
var
//  RecBuf: TRecBuf;
  I, J: Integer;
begin

  I := BufferToIndex(Buffer);
  if (I = FRecordCache.Count - 1) and (BufferCount < FRecordCache.Count - 2) then
  begin
//    FRecordCache[FRecordCache.Count-1].Free;
    FRecordCache.Count := I;
  end else
  begin
    TRecBuf(FRecordCache[I]).InUse := False;
    TRecBuf(FRecordCache[I]).RecordNumber := -1;
    for J := 0 to Length(TRecBuf(FRecordCache[I]).Values) - 1 do
      TRecBuf(FRecordCache[I]).Values[J] := Null;
//    TRecBuf(FRecordCache[I]).TreeNode := nil;
//    TRecBuf(FRecordCache[I]).MemRec := nil;
    TRecBuf(FRecordCache[I]).RecordsView := nil;
  end;

{  RecBuf := PRecBuf(Buffer);
  SetLength(RecBuf^.Values, 0);
  Dispose(RecBuf);}
  Buffer := nil;
end;

procedure TCustomMemTableEh.ClearCalcFields(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
var
  I: Integer;
begin
  if CalcFieldsSize > 0 then
    for I := 0 to Fields.Count - 1 do
      with Fields[I] do
        if FieldKind in [fkCalculated, fkLookup] then
//new          PRecBuf(Buffer)^.Values[Offset + DataFieldsCount].IsNull := True;
//ddd          PRecBuf(Buffer)^.Values[FCalcFieldIndexes[I] + DataFieldsCount].VarValue := Null;
          BufferToRecBuf(Buffer).Values[Index] := Null;
end;

procedure TCustomMemTableEh.InternalInitRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
var
  I: Integer;
begin
  for I := 0 to Fields.Count - 1 do
    BufferToRecBuf(Buffer).Values[I] := Null;
//  BufferToRecBuf(Buffer).TreeNode := nil;
//  BufferToRecBuf(Buffer).MemRec := nil;
  BufferToRecBuf(Buffer).RecordsView := Nil;
end;

procedure TCustomMemTableEh.InitRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  inherited InitRecord(Buffer);

  with BufferToRecBuf(Buffer) do
  begin
    Bookmark := Low(Integer);
    BookmarkFlag := bfInserted;
//    RecordStatus := 0;
    RecordNumber := -1;
  end;
end;

function TCustomMemTableEh.GetCurrentRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): Boolean;
begin
  Result := False;
{  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  begin
    UpdateCursorPos;
    if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
    begin
      Move(FRecords[FRecordPos]^, Buffer^, FDataRecordSize);
      Result := True;
    end;
  end;
}
end;

procedure TCustomMemTableEh.RecordToBuffer(MemRec: TMemoryRecordEh;
  DataValueVersion: TDataValueVersionEh;
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}; RecIndex: Integer);
var
  i: Integer;
begin

  with BufferToRecBuf(Buffer) do