memtabledataeh.pas

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

    ftBoolean: Result := varBoolean;
    ftFloat: Result := varDouble;
    ftCurrency: Result := varCurrency;
    ftBCD: Result := varCurrency;
    ftDate: Result := varDate;
    ftTime: Result := varDate;
    ftDateTime: Result := varDate;
    ftBytes: Result := varString;
    ftVarBytes: Result := varString;
    ftAutoInc: Result := varInteger;
    ftBlob: Result := varString;
    ftMemo: Result := varString;
    ftGraphic: Result := varString;
    ftFmtMemo: Result := varString;
    ftParadoxOle: Result := varString;
    ftDBaseOle: Result := varString;
    ftTypedBinary: Result := varString;
    ftCursor: Result := varError;
    ftFixedChar: Result := varString;
    ftWideString: Result := varOleStr;
{$IFDEF EH_LIB_6}
    ftLargeint: Result := varInt64;
{$ELSE}
    ftLargeint: Result := varError;
{$ENDIF}
    ftADT: Result := varError;
    ftArray: Result := varError;
    ftReference: Result := varError;
    ftDataSet: Result := varError;
    ftOraBlob: Result := varString;
    ftOraClob: Result := varString;
    ftVariant: Result := varVariant;
{$IFNDEF CIL}
    ftInterface: Result := varUnknown;
    ftIDispatch: Result := varDispatch;
{$ENDIF}
    ftGuid: Result := varString;
{$IFDEF EH_LIB_6}
    ftTimeStamp: Result := varSQLTimeStamp;
    ftFMTBcd: Result := varFMTBcd;
{$ENDIF}
  else
    Result := varEmpty;
  end;
end;

procedure TMTDataFieldEh.AssignDataType(FieldType: TFieldType);
begin
  raise Exception.Create('Can not assign DataType from Field');
end;

function TMTDataFieldEh.GetIndex: Integer;
begin
  Result := DataStruct.FList.IndexOf(Self);
end;

{ TMTBooleanDataFieldEh }

procedure TMTBooleanDataFieldEh.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TMTBooleanDataFieldEh then
  begin
    DisplayValues := TMTBooleanDataFieldEh(Source).DisplayValues;
  end;
end;

procedure TMTBooleanDataFieldEh.AssignDataType(FieldType: TFieldType);
begin
  if DataType <> ftBoolean then
    raise Exception.Create('Can not assign DataType from Field');
end;

procedure TMTBooleanDataFieldEh.AssignProps(Field: TField);
begin
  inherited AssignProps(Field);
  if (Field is TBooleanField) then
    DisplayValues := TBooleanField(Field).DisplayValues;
end;

function TMTBooleanDataFieldEh.GetDataType: TFieldType;
begin
  Result := ftBoolean;
end;

procedure TMTBooleanDataFieldEh.SetDisplayValues(const Value: string);
begin
  FDisplayValues := Value;
end;

{ TMTStringDataFieldEh }

procedure TMTStringDataFieldEh.AssignDataType(FieldType: TFieldType);
begin
  case FieldType of
    ftString: FStringDataType := fdtStringEh;
    ftFixedChar: FStringDataType := fdtFixedCharEh;
    ftWideString: FStringDataType := fdtWideStringEh;
  else
    raise Exception.Create('Can not assign DataType from Field');
  end;
end;

procedure TMTStringDataFieldEh.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TMTStringDataFieldEh then
  begin
    StringDataType := TMTStringDataFieldEh(Source).StringDataType;
    FixedChar := TMTStringDataFieldEh(Source).FixedChar;
    Transliterate := TMTStringDataFieldEh(Source).Transliterate;
  end;
end;

procedure TMTStringDataFieldEh.AssignProps(Field: TField);
begin
  inherited AssignProps(Field);

  if (Field is TStringField) then
  begin
    FixedChar := TStringField(Field).FixedChar;
    Transliterate := TStringField(Field).Transliterate;
  end
end;

function TMTStringDataFieldEh.CanDinaSize: Boolean;
begin
  Result := True;
end;

function TMTStringDataFieldEh.DefaultSize: Integer;
begin
  Result := 20;
end;

function TMTStringDataFieldEh.GetDataType: TFieldType;
begin
  Result := StringDataFieldsToFields[FStringDataType];
end;

{ TMTNumericDataFieldEh }

procedure TMTNumericDataFieldEh.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TMTNumericDataFieldEh then
  begin
    NumericDataType := TMTNumericDataFieldEh(Source).NumericDataType;
    DisplayFormat := TMTNumericDataFieldEh(Source).DisplayFormat;
    EditFormat := TMTNumericDataFieldEh(Source).EditFormat;
    currency := TMTNumericDataFieldEh(Source).currency;
    MaxValue := TMTNumericDataFieldEh(Source).MaxValue;
    MinValue := TMTNumericDataFieldEh(Source).MinValue;
    Precision := TMTNumericDataFieldEh(Source).Precision;
  end;
end;

procedure TMTNumericDataFieldEh.AssignDataType(FieldType: TFieldType);
begin
  case FieldType of
    ftSmallint: FNumericDataType := fdtSmallintEh;
    ftInteger: FNumericDataType := fdtIntegerEh;
    ftWord: FNumericDataType := fdtWordEh;
    ftFloat: FNumericDataType := fdtFloatEh;
    ftCurrency: FNumericDataType := fdtCurrencyEh;
    ftBCD: FNumericDataType := fdtBCDEh;
    ftAutoInc: FNumericDataType := fdtAutoIncEh;
{$IFDEF EH_LIB_6}
    ftLargeint: FNumericDataType := fdtLargeintEh;
    ftFMTBcd: FNumericDataType := fdtFMTBcdEh;
{$ENDIF}
  else
    raise Exception.Create('Can not assign DataType from Field');
  end;
end;

procedure TMTNumericDataFieldEh.AssignProps(Field: TField);
begin
  inherited AssignProps(Field);
  if (Field is TNumericField) then
  begin
    DisplayFormat := TNumericField(Field).DisplayFormat;
    EditFormat := TNumericField(Field).EditFormat;
    if (Field is TIntegerField) then
    begin
      MaxValue := TIntegerField(Field).MaxValue;
      MinValue := TIntegerField(Field).MinValue;
    end;
    if (Field is TLargeintField) then
    begin
      MaxValue := TLargeintField(Field).MaxValue;
      MinValue := TLargeintField(Field).MinValue;
    end;
    if (Field is TFloatField) then
    begin
      currency := TFloatField(Field).currency;
      MaxValue := TFloatField(Field).MaxValue;
      MinValue := TFloatField(Field).MinValue;
      Precision := TFloatField(Field).Precision;
    end;
    if (Field is TBCDField) then
    begin
      currency := TBCDField(Field).currency;
      MaxValue := TBCDField(Field).MaxValue;
      MinValue := TBCDField(Field).MinValue;
      Precision := TBCDField(Field).Precision;
    end;
{$IFDEF EH_LIB_6}
    if (Field is TFMTBCDField) then
    begin
      currency := TFMTBCDField(Field).currency;
//      MaxValue := TFMTBCDField(Field).MaxValue;
//      MinValue := TFMTBCDField(Field).MinValue;
      Precision := TFMTBCDField(Field).Precision;
    end;
{$ENDIF}
  end
end;

function TMTNumericDataFieldEh.GetDataType: TFieldType;
begin
  Result := NumericDataFieldsToFields[FNumericDataType];
end;

{ TMTDateTimeDataFieldEh }

procedure TMTDateTimeDataFieldEh.AssignDataType(FieldType: TFieldType);
begin
  case FieldType of
    ftDate: FDateTimeDataType := fdtDateEh;
    ftTime: FDateTimeDataType := fdtTimeEh;
    ftDateTime: FDateTimeDataType := fdtDateTimeEh;
{$IFDEF EH_LIB_6}
    ftTimeStamp: FDateTimeDataType := fdtTimeStampEh;
{$ENDIF}
  else
    raise Exception.Create('Can not assign DataType from Field');
  end;
end;

procedure TMTDateTimeDataFieldEh.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TMTDateTimeDataFieldEh then
  begin
    DateTimeDataType := TMTDateTimeDataFieldEh(Source).DateTimeDataType;
    DisplayFormat := TMTDateTimeDataFieldEh(Source).DisplayFormat;
  end;
end;

procedure TMTDateTimeDataFieldEh.AssignProps(Field: TField);
begin
  inherited AssignProps(Field);
  if (Field is TDateTimeField) then
    DisplayFormat := TDateTimeField(Field).DisplayFormat;
end;

function TMTDateTimeDataFieldEh.GetDataType: TFieldType;
begin
  Result := DateTimeDataFieldsToFields[FDateTimeDataType];
end;

{ TMTBlobDataFieldEh }

procedure TMTBlobDataFieldEh.AssignDataType(FieldType: TFieldType);
begin
  if FieldType in [Low(TBlobType)..High(TBlobType)] then
    FBlobType := FieldType;
//  if not (Field is TBlobField) then
//    raise Exception.Create('Can not assign DataType from Field');
end;

procedure TMTBlobDataFieldEh.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TMTBlobDataFieldEh then
  begin
    BlobType := TMTBlobDataFieldEh(Source).BlobType;
    GraphicHeader := TMTBlobDataFieldEh(Source).GraphicHeader;
    Transliterate := TMTBlobDataFieldEh(Source).Transliterate;
  end;
end;

procedure TMTBlobDataFieldEh.AssignProps(Field: TField);
begin
  inherited AssignProps(Field);
  if (Field is TBlobField) then
  begin
    BlobType := TBlobField(Field).BlobType;
{$IFDEF EH_LIB_6}
    GraphicHeader := TBlobField(Field).GraphicHeader;
{$ENDIF}
    Transliterate := TBlobField(Field).Transliterate;
  end;
end;

function TMTBlobDataFieldEh.GetDataType: TFieldType;
begin
  Result := BlobType;
end;

{ TMemoryRecordEh }

constructor TMemoryRecordEh.Create;
begin
  inherited Create;
  FData := nil;
  FUpdateStatus := usUnmodified;
  FUpdateIndex := -1;
  FEditState := resInsertEh;
end;

destructor TMemoryRecordEh.Destroy;
begin
//  MergeChanges;
  FData := nil;
  FUpdateError.Free;
  inherited Destroy;
end;

function TMemoryRecordEh.GetAttached: Boolean;
begin
  Result := (Index <> -1);
end;

procedure TMemoryRecordEh.Edit;
begin
  if FEditState <> resBrowseEh then Exit;
  FEditState := resEditEh;
  FEditChanged := False;
//  New(FTmpOldRecValue);
  FTmpOldRecValue := Copy(FData, 0, Length(FData));
end;

procedure TMemoryRecordEh.Post;
begin
  if not (EditState in mrEditStatesEh) then
    EDatabaseError.Create(SNotEditing);
  if FEditState = resInsertEh then
  begin
     RecordsList.AddRecord(Self);
  end else // resEditEh
  begin
    if RecordsList.CachedUpdates then
    begin
      if FUpdateStatus = usUnmodified then
        FUpdateStatus := usModified;
      if FUpdateIndex = -1 then
        FUpdateIndex := RecordsList.FDeltaList.Add(Self);
      if (FUpdateStatus = usModified) and (FOldData = nil) then
        FOldData := FTmpOldRecValue;
      FTmpOldRecValue := nil;
    end else
    begin
      //Dispose(FTmpOldRecValue);
      FTmpOldRecValue := nil;
    end;
    FEditState := resBrowseEh;
    RecordsList.Notify(Self, GetIndex, rlnRecChangedEh);
  end;
end;

procedure TMemoryRecordEh.Cancel;
begin
  if not (EditState in mrEditStatesEh) then
    EDatabaseError.Create(SNotEditing);
  if FEditState = resInsertEh then
  begin
     Free;
  end else
  begin
//    Dispose(FTmpOldRecValue);
    FTmpOldRecValue := nil;
  end;
  FEditState := resBrowseEh;
end;

procedure TMemoryRecordEh.MergeChanges;
begin
//  if FOldData = nil then Exit;
  if UpdateStatus = usUnmodified then Exit;
  if UpdateStatus = usDeleted then
    RecordsList.PersistRemoveRecord(Self.Index);
  FOldData := nil;
  FUpdateStatus := usUnmodified;
  if FUpdateIndex >= 0 then
  begin
    RecordsList.DeltaList[FUpdateIndex] := nil;
    FUpdateIndex := -1;
  end;
  if FUpdateError <> nil then
  begin
    FUpdateError.Free;
    FUpdateError := nil;
  end;
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.Rev