memtabledataeh.pas

delphi 比较好用的控件

  if Changed then
    FChanged := Changed;
  if FChangeCount > 0 then
    Dec(FChangeCount);
  if FChangeCount = 0 then
  begin
    if FChanged and (RecordsList <> nil) then
      RecordsList.Notify(Self, Index, rlnRecChangedEh);
    if FChanged and (RecordsList <> nil) and RecordsList.CachedUpdates then
    begin
      if FUpdateStatus = usDeleted then
         raise Exception.Create('Can not modify deleted record')
      else if FUpdateStatus = usInserted then
      begin
        // Nothing to do
      end else
      begin
        FUpdateStatus := usModified;
        if FUpdateIndex = -1 then
          FUpdateIndex := RecordsList.FDeltaList.Add(Self);
        if FOldData = nil then
        begin
  //        Dispose(FOldData);
          FOldData := FTmpOldRecValue;
          FTmpOldRecValue := nil;
        end;
      end;
    end;
    if FTmpOldRecValue <> nil then
    begin
      Dispose(FTmpOldRecValue);
      FTmpOldRecValue := nil;
    end;
    FChanged := False;
  end;
end;

procedure TMemoryRecordEh.MergeChanges;
begin
  if FOldData = nil then Exit;
  Dispose(FOldData);
  FOldData := nil;
  FUpdateStatus := usUnmodified;
end;

function TMemoryRecordEh.GetIndex: Integer;
begin
  if FRecordsList <> nil then
    Result := FRecordsList.IndexOf(Self) else
    Result := -1;
end;

procedure TMemoryRecordEh.SetIndex(Value: Integer);
var
  CurIndex: Integer;
begin
  CurIndex := GetIndex;
  if (CurIndex >= 0) and (CurIndex <> Value) then
    FRecordsList.Move(CurIndex, Value);
end;

procedure TMemoryRecordEh.RevertRecord;
begin
  case FUpdateStatus of
    usModified:
      begin
        Dispose(FData);
        FData := FOldData;
        FOldData := nil;
        FUpdateStatus := usUnmodified;
        RecordsList.Notify(Self, Index, rlnRecChangedEh);
      end;
    usDeleted:
      begin
        FUpdateStatus := usUnmodified;
        RecordsList.Notify(Self, Index, rlnRecChangedEh);
      end;
  end;
end;

procedure TMemoryRecordEh.RefreshRecord(RecValues: TRecDataValues);
begin
  if FUpdateStatus = usModified
    then FOldData^ := RecValues
    else FData^ := RecValues;
end;

procedure TMemoryRecordEh.SetUpdateStatus(const Value: TUpdateStatus);
begin
  FUpdateStatus := Value;
end;

{$IFNDEF EH_LIB_6}

function ReadVariantProp(Reader: TReader): Variant;
const
  ValTtoVarT: array[TValueType] of Integer = (varNull, varError, varByte,
    varSmallInt, varInteger, varDouble, varString, varError, varBoolean,
    varBoolean, varError, varError, varString, varEmpty, varError, varSingle,
    varCurrency, varDate, varOleStr, varError);
var
  Value: Variant;
  ValType: TValueType;
begin
  ValType := Reader.NextValue;
  case ValType of
    vaNil, vaNull:
    begin
      if Reader.ReadValue = vaNil then
        VarClear(Value) else
        Value := NULL;
    end;
    vaInt8: TVarData(Value).VByte := Byte(Reader.ReadInteger);
    vaInt16: TVarData(Value).VSmallint := Smallint(Reader.ReadInteger);
    vaInt32: TVarData(Value).VInteger := Reader.ReadInteger;
    vaExtended: TVarData(Value).VDouble := Reader.ReadFloat;
    vaSingle: TVarData(Value).VSingle := Reader.ReadSingle;
    vaCurrency: TVarData(Value).VCurrency := Reader.ReadCurrency;
    vaDate: TVarData(Value).VDate := Reader.ReadDate;
    vaString, vaLString: Value := Reader.ReadString;
    vaWString: Value := Reader.ReadWideString;
    vaFalse, vaTrue: TVarData(Value).VBoolean := Reader.ReadValue = vaTrue;
  else
    raise EReadError.Create('SReadError');
  end;
  TVarData(Value).VType := ValTtoVarT[ValType];
  Result := Value;
end;

procedure WriteVariantProp(Writer: TWriter; Value: Variant);
var
  VType: Integer;

  procedure WriteValue(Value: TValueType);
  begin
    Writer.Write(Value, SizeOf(Value));
  end;

begin
  if VarIsArray(Value) then raise EWriteError.Create('SWriteError');
  VType := VarType(Value);
  case VType and varTypeMask of
    varEmpty: WriteValue(vaNil);
    varNull: WriteValue(vaNull);
    varOleStr: Writer.WriteWideString(Value);
    varString: Writer.WriteString(Value);
    varByte, varSmallInt, varInteger: Writer.WriteInteger(Value);
    varSingle: Writer.WriteSingle(Value);
    varDouble: Writer.WriteFloat(Value);
    varCurrency: Writer.WriteCurrency(Value);
    varDate: Writer.WriteDate(Value);
    varBoolean:
      if Value then
        WriteValue(vaTrue) else
        WriteValue(vaFalse);
  else
    try
      Writer.WriteString(Value);
    except
      raise EWriteError.Create('SWriteError');
    end;
  end;
end;

{$ENDIF}

procedure TMemoryRecordEh.ReadData(Reader: TReader);
var
  v: Variant;
  i: Integer;
begin
  Reader.ReadListBegin;
  for i := 0 to Length(Data^)-1 do
  begin
{$IFDEF EH_LIB_6}
    v := Reader.ReadVariant;
{$ELSE}
    v := ReadVariantProp(Reader);
{$ENDIF}
    if VarIsEmpty(v) then
      Data^[i] := Null
    else
      VarCast(Data^[i], v, DataStruct[i].GetVarDataType);
  end;
  Reader.ReadListEnd;
end;

procedure TMemoryRecordEh.WriteData(Writer: TWriter);
var
  i: Integer;
begin
  Writer.WriteListBegin;
  for i := 0 to Length(Data^)-1 do
  begin
    if VarIsNull(Data^[i]) then
{$IFDEF EH_LIB_6}
    Writer.WriteVariant(Unassigned)
{$ELSE}
    WriteVariantProp(Writer, Unassigned)
{$ENDIF}
    else if VarIsEmpty(Data^[i]) then
      raise Exception.Create('"TMemoryRecordEh.WriteData" - Invalid variant type - varEmpty')
    else
{$IFDEF EH_LIB_6}
      Writer.WriteVariant(Data^[i]);
{$ELSE}
      WriteVariantProp(Writer, Data^[i]);
{$ENDIF}
  end;
  Writer.WriteListEnd;
end;

function TMemoryRecordEh.GetDataStruct: TMTDataStructEh;
begin
  Result := RecordsList.DataStruct;
end;

function TMemoryRecordEh.GetDataValues(const FieldNames: string; DataValueType: TDataValueTypeEh): Variant;
var
  I: Integer;
  Fields: TList;
begin
  if (DataValueType = dvtOldValueEh) and (FOldData = nil) then
    raise Exception.Create('TMemoryRecordEh.GetDataValues: Old values is not accessible.');
  if Pos(';', FieldNames) <> 0 then
  begin
    Fields := TList.Create;
    try
      DataStruct.GetFieldList(Fields, FieldNames);
      Result := VarArrayCreate([0, Fields.Count - 1], varVariant);
      for I := 0 to Fields.Count - 1 do
        Result[I] := Data^[TMTDataFieldEh(Fields[I]).Index];
    finally
      Fields.Free;
    end;
  end else
    if DataValueType = dvtOldValueEh
      then Result := OldData^[DataStruct.FieldIndex(FieldNames)]
      else Result := Data^[DataStruct.FieldIndex(FieldNames)];
end;

procedure TMemoryRecordEh.SetDataValues(const FieldNames: string;
  DataValueType: TDataValueTypeEh; const Value: Variant);
var
  I: Integer;
  Fields: TList;
begin
  if Pos(';', FieldNames) <> 0 then
  begin
    Fields := TList.Create;
    try
      DataStruct.GetFieldList(Fields, FieldNames);
      for I := 0 to Fields.Count - 1 do
        TField(Fields[I]).Value := Value[I];
    finally
      Fields.Free;
    end;
  end else
    Data^[DataStruct.FieldIndex(FieldNames)] := Value;
end;

{ TRecordsListNotificatorEh }

constructor TRecordsListNotificatorEh.Create;
begin
  inherited Create;
end;

destructor TRecordsListNotificatorEh.Destroy;
begin
  RecordsList := nil;
  inherited Destroy;
end;

procedure TRecordsListNotificatorEh.DataEvent(MemRec: TMemoryRecordEh;
  Index: Integer; Action: TRecordsListNotification);
begin
  if Assigned(FOnDataEvent) then
    FOnDataEvent(MemRec, Index, Action);
  case Action of
    rlnRecAddedEh: RecordAdded(MemRec, Index);
    rlnRecChangedEh: RecordChanged(MemRec, Index);
    rlnRecDeletedEh: RecordDeleted(MemRec, Index);
    rlnListChangedEh: RecordListChanged;
  end;
end;

procedure TRecordsListNotificatorEh.SetRecordsList(const Value: TRecordsListEh);
begin
  if Value = FRecordsList then Exit;
  if FRecordsList <> nil then FRecordsList.RemoveNotificator(Self);
  if Value <> nil then Value.AddNotificator(Self);
  FRecordsList := Value;
end;

procedure TRecordsListNotificatorEh.RecordAdded(MemRec: TMemoryRecordEh; Index: Integer);
begin
end;

procedure TRecordsListNotificatorEh.RecordChanged(MemRec: TMemoryRecordEh; Index: Integer);
begin
end;

procedure TRecordsListNotificatorEh.RecordDeleted(MemRec: TMemoryRecordEh; Index: Integer);
begin
end;

procedure TRecordsListNotificatorEh.RecordListChanged;
begin
end;

{ TRecordsListEh }

constructor TRecordsListEh.Create(AMemTableData: TMemTableDataEh);
begin
  inherited Create(nil);
  FItemClass := TMemoryRecordEh;
  FNotificators := TList.Create;
  FDeltaList := TList.Create;
  FNewRecId := 1;
  FRecList := TList.Create;
  FMemTableData := AMemTableData;
  FCachedUpdates := True;
end;

destructor TRecordsListEh.Destroy;
var
  i: Integer;
begin
  for i := 0 to FRecList.Count-1 do
    Rec[i].FUpdateIndex := -1;
  while FNotificators.Count > 0 do
    TRecordsListNotificatorEh(FNotificators[0]).RecordsList := nil;
  FNotificators.Free;
  FDeltaList.Free;
  FRecList.Free;
  inherited Destroy;
end;

function TRecordsListEh.NewRecord: TMemoryRecordEh;
begin
  Result := TMemoryRecordEh.Create;
  Result.FID := NewRecId;
  SetLength(Result.Data^, RecValCount);
  InitRecord(Result.Data);
  Result.FRecordsList := Self;
end;

function TRecordsListEh.AddRecord(Rec: TMemoryRecordEh): Integer;
begin
  Result := FRecList.Add(Rec);
  Rec.FRecordsList := Self;
  if CachedUpdates then
  begin
    Rec.FUpdateStatus := usInserted;
    if Rec.FUpdateIndex = -1 then
      Rec.FUpdateIndex := FDeltaList.Add(Rec);
  end else
    Rec.FUpdateStatus := usUnmodified;
  Notify(Rec, Result, rlnRecAddedEh);
end;

procedure TRecordsListEh.InsertRecord(Index: Integer; Rec: TMemoryRecordEh);
begin
  FRecList.Insert(Index, Rec);
  Rec.FRecordsList := Self;
  if CachedUpdates then
  begin
    Rec.FUpdateStatus := usInserted;
    if Rec.FUpdateIndex = -1 then
      Rec.FUpdateIndex := FDeltaList.Add(Rec);
  end else
    Rec.FUpdateStatus := usUnmodified;
  Notify(Rec, Index, rlnRecAddedEh);
end;

procedure TRecordsListEh.DeleteRecord(Index: Integer);
var
  ARec: TMemoryRecordEh;
begin
  if CachedUpdates then
  begin
    ARec := Rec[Index];
    if ARec.FUpdateStatus = usDeleted then
      raise Exception.Create('Can not MarkDel Deleted record');

    if ARec.FUpdateStatus = usInserted then
    begin
      if ARec.FUpdateIndex >= 0 then
        FDeltaList.Items[Rec[Index].FUpdateIndex] := nil;
      PersistDeleteRecord(Index);
    end else
    begin
      ARec.MergeChanges;
      ARec.FUpdateStatus := usDeleted;
      if ARec.FUpdateIndex = -1 then
        ARec.FUpdateIndex := FDeltaList.Add(Rec[Index]);
      Notify(ARec, Index, rlnRecMarkedForDelEh);
    end;
  end else
    PersistDeleteRecord(Index);
end;

procedure TRecordsListEh.PersistDeleteRecord(Index: Integer);
begin
  Notify(Rec[Index], Index, rlnRecDeletedEh);
  Delete(Index);
end;

function TRecordsListEh.GetValue(RecNo, ValNo: Integer): Variant;
begin
  Result := Rec[RecNo].Data^[ValNo];
end;

procedure TRecordsListEh.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;

{
procedure TRecordsListEh.SetRecValCount(const Value: Integer);
begin
  if FRecValCount <> Value then
  begin
    Clear;
    FRecValCount := Value;
  end;
end;
}

procedure T