memtabledataeh.pas

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

  const ComponentName: string; ComponentClass: TPersistentClass;
  var Component: TComponent);
begin
  if (ComponentName = 'DataStruct') and (Reader.Root <> nil) then
    Component := FDataStruct
  else if (ComponentName = 'RecordsList') and (Reader.Root <> nil) then
    Component := FRecordsList;
end;

procedure TMemTableDataEh.CreateComponent(Reader: TReader;
  ComponentClass: TComponentClass; var Component: TComponent);
begin
  if ComponentClass.InheritsFrom(TMTDataStructEh) then
    Component := FDataStruct
  else if ComponentClass.InheritsFrom(TRecordsListEh) then
    Component := FRecordsList;
end;

procedure TMemTableDataEh.ReadState(Reader: TReader);
var
  OldOnCreateComponent: TCreateComponentEvent;
  OldOnAncestorNotFound: TAncestorNotFoundEvent;
begin
  DestroyTable; //Clear before read

  OldOnCreateComponent := Reader.OnCreateComponent;
  OldOnAncestorNotFound := Reader.OnAncestorNotFound;
  Reader.OnCreateComponent := CreateComponent;
  Reader.OnAncestorNotFound := AncestorNotFound;

  try
    inherited ReadState(Reader);
  finally
    Reader.OnCreateComponent := OldOnCreateComponent;
    Reader.OnAncestorNotFound := OldOnAncestorNotFound;
  end;
end;

procedure TMemTableDataEh.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  Proc(DataStruct);
  Proc(RecordsList);
end;

procedure TMemTableDataEh.Restruct;

  function FieldId(AFieldId: Longint): TMTDataFieldEh;
  var
    i: Integer;
  begin
    Result := nil;
    for i := 0 to DataStruct.Count-1 do
    begin
      if DataStruct[i].FFieldId = AFieldId then
      begin
        Result := DataStruct[i];
        Exit;
      end;
    end;
  end;

var
  i: Integer;
begin
  for i := 0 to FNewDataStruct.Count-1 do
  begin
    if FieldId(FNewDataStruct[i].FFieldId) <> nil then
    begin
      { TODO : Really do change struct}
    end;
  end;
end;

function TMemTableDataEh.GetIsEmpty: Boolean;
begin
  Result := (DataStruct.Count = 0);
end;

procedure TMemTableDataEh.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('AutoIncCurValue', ReadAutoIncCurValue,
    WriteAutoIncCurValue, AutoIncrement.CurValue <> AutoIncrement.InitValue);
end;

procedure TMemTableDataEh.ReadAutoIncCurValue(Reader: TReader);
begin
  FAutoIncrement.FCurValue := Reader.ReadInteger;
end;

procedure TMemTableDataEh.WriteAutoIncCurValue(Writer: TWriter);
begin
  Writer.WriteInteger(FAutoIncrement.FCurValue);
end;

procedure TMemTableDataEh.AddNotificator(RecordsList: TRecordsListNotificatorEh);
begin
  FNotificators.Add(RecordsList);
end;

procedure TMemTableDataEh.RemoveNotificator(RecordsList: TRecordsListNotificatorEh);
begin
  FNotificators.Remove(RecordsList);
end;

procedure TMemTableDataEh.Notify(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification);
var
  i: Integer;
begin
  for i := 0 to FNotificators.Count-1 do
    TRecordsListNotificatorEh(FNotificators[i]).DataEvent(MemRec, Index, Action);
end;

function TMemTableDataEh.FetchRecords(Count: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to FNotificators.Count-1 do
    Result := Result + TRecordsListNotificatorEh(FNotificators[i]).FetchRecords(Count);
end;

function TMemTableDataEh.GetAutoIncrement: TAutoIncrementEh;
begin
  Result := FAutoIncrement;
end;

function TMemTableDataEh.GetDataStruct: TMTDataStructEh;
begin
  Result := FDataStruct;
end;

function TMemTableDataEh.GetRecordsList: TRecordsListEh;
begin
  Result := FRecordsList;
end;

procedure TMemTableDataEh.SetAutoIncrement(const Value: TAutoIncrementEh);
begin
  FAutoIncrement.Assign(Value);
end;

procedure TMemTableDataEh.ApplyUpdates(AMemTableData: TMemTableDataEh);
var
  i: Integer;
begin
  for i := 0 to FNotificators.Count-1 do
    TRecordsListNotificatorEh(FNotificators[i]).ApplyUpdates(AMemTableData);
end;

procedure TMemTableDataEh.RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer);
var
  i: Integer;
begin
  for i := 0 to FNotificators.Count-1 do
    TRecordsListNotificatorEh(FNotificators[i]).RecordMoved(Item, OldIndex, NewIndex);
end;

procedure TMemTableDataEh.SetAutoIncValue(Rec: TMemoryRecordEh);
var
  I: Integer;
  NewIncValue: Integer;
  AutoIncReceived: Boolean;
begin
  AutoIncReceived := False;
  NewIncValue := 0;
(*  for I := 0 to Length(FIncFieldIndexes)-1 do
  begin
    if not AutoIncReceived then
    begin
      NewIncValue := AutoIncrement.Promote;
      AutoIncReceived := True;
    end;
    Rec.Value[FIncFieldIndexes[I], dvvValueEh] := NewIncValue;
  end;*)
  for I := 0 to DataStruct.Count - 1 do
    if (DataStruct.DataFields[I].DataType = ftAutoInc) or
        DataStruct.DataFields[I].AutoIncrement then
    begin
      if not AutoIncReceived then
      begin
        NewIncValue := AutoIncrement.Promote;
        AutoIncReceived := True;
      end;
      Rec.Value[I, dvvValueEh] := NewIncValue;
    end;
end;

procedure TMemTableDataEh.StructChanged;
var
  I: Integer;
begin
  SetLength(FIncFieldIndexes, 0);
  if DataStruct = nil then Exit;
  for I := 0 to DataStruct.Count-1 do
  begin
    if DataStruct.DataFields[I].DataType = ftAutoInc then
    begin
      SetLength(FIncFieldIndexes, Length(FIncFieldIndexes)+1);
      FIncFieldIndexes[Length(FIncFieldIndexes)-1] := I;
    end;
  end;
end;

{ TMemTableDataShadowEh }

constructor TMemTableDataShadowEh.Create(AMasterTable: TMemTableDataEh);
begin
  inherited Create(AMasterTable);
  FMasterTable := AMasterTable;
end;

destructor TMemTableDataShadowEh.Destroy;
begin
  inherited Destroy;
end;

function TMemTableDataShadowEh.GetDataStruct: TMTDataStructEh;
begin
  Result := FMasterTable.DataStruct;
end;

procedure TMemTableDataShadowEh.SetAutoIncValue(Rec: TMemoryRecordEh);
begin
 // Don't set AutoIncValue in shadow MemTable.
end;

{
function TMemTableDataShadowEh.GetAutoIncrement: TAutoIncrementEh;
begin
  Result := FMasterTable.AutoIncrement;
end;

procedure TMemTableDataShadowEh.SetAutoIncrement(
  const Value: TAutoIncrementEh);
begin
  FMasterTable.AutoIncrement := Value;
end;
}

{ TMTDataStructEh }

constructor TMTDataStructEh.Create(AMemTableData: TMemTableDataEh);
begin
  inherited Create(AMemTableData);
  FMemTableData := AMemTableData;
  FList := TObjectList.Create(False);
end;

destructor TMTDataStructEh.Destroy;
begin
  Clear;
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure TMTDataStructEh.Clear;
var
  i: Integer;
begin
  for i := 0 to FList.Count-1 do
    TMTDataFieldEh(FList[i]).Free;
  FList.Clear;
  MemTableData.StructChanged;
end;

function TMTDataStructEh.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TMTDataStructEh.GetDataField(Index: Integer): TMTDataFieldEh;
begin
  Result := TMTDataFieldEh(FList[Index]);
end;

function TMTDataStructEh.CreateField(FieldClass: TMTDataFieldClassEh): TMTDataFieldEh;
begin
  Result := FieldClass.Create(Self);
  Result.DataStruct := Self;
  Result.FFieldId := FNextFieldId;
  Inc(FNextFieldId);
end;

procedure TMTDataStructEh.InsertField(Field: TMTDataFieldEh);
begin
//  if Field.FDataStruct <> nil then
//    Field.DataStruct.RemoveField(Field);
  FList.Add(Field);
  Field.FDataStruct := Self;
  MemTableData.StructChanged;
end;

procedure TMTDataStructEh.RemoveField(Field: TMTDataFieldEh);
var
  Index: Integer;
begin
  if Field.DataStruct <> Self then Exit;
  Index := FList.IndexOf(Field);
  if Index >= 0 then
  begin
    FList.Delete(Index);
    Field.FDataStruct := nil;
  end;
  MemTableData.StructChanged;
end;

procedure TMTDataStructEh.CheckFieldName(const FieldName: string);
begin
  if FieldName = '' then DatabaseError('SFieldNameMissing', MemTableData);
  if FindField(FieldName) <> nil then
    DatabaseErrorFmt(SDuplicateFieldName, [FieldName], MemTableData);
end;

function TMTDataStructEh.FindField(const FieldName: string): TMTDataFieldEh;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
  begin
    Result := TMTDataFieldEh(FList.Items[I]);
    if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
  end;
  Result := nil;
end;

procedure TMTDataStructEh.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
  Field: TMTDataFieldEh;
begin
  for I := 0 to Count - 1 do
  begin
    Field := DataFields[I];
    Proc(Field);
  end;
end;

function TMTDataStructEh.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TMTDataStructEh.BuildStructFromFieldDefs(FieldDefs: TFieldDefs);
var
  i: Integer;
  DataField: TMTDataFieldEh;
begin
  MemTableData.DestroyTable;
  for i := 0 to FieldDefs.Count-1 do
  begin
    DataField := CreateField(DefaultDataFieldClasses[FieldDefs[i].DataType]);
    DataField.AssignDataType(FieldDefs[i].DataType);
    DataField.FieldName := FieldDefs[i].Name;
//    property FieldNo: Integer read GetFieldNo write FFieldNo stored False;
//    property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
//    property ParentDef: TFieldDef read GetParentDef;
    DataField.Required := FieldDefs[i].Required;
//    property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
//    property ChildDefs: TFieldDefs read Ge