memtabledataeh.pas

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

    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 GetChildDefs write SetChildDefs stored HasChildDefs;
//    property DataType: TFieldType read FDataType write SetDataType default ftUnknown;
    if DataField is TMTNumericDataFieldEh then
      (DataField as TMTNumericDataFieldEh).Precision := FieldDefs[i].Precision;
    if DataField.CanDinaSize then
      DataField.Size := FieldDefs[i].Size;
  end;
end;

procedure TMTDataStructEh.BuildStructFromFields(Fields: TFields);
var
  i: Integer;
  DataField: TMTDataFieldEh;
begin
  MemTableData.DestroyTable;
  for i := 0 to Fields.Count-1 do
  begin
    if Fields[i].FieldKind in [fkData, fkInternalCalc] then
    begin
      DataField := CreateField(DefaultDataFieldClasses[Fields[i].DataType]);
      DataField.AssignDataType(Fields[i].DataType);
      DataField.FieldName := Fields[i].FieldName;
      DataField.AssignProps(Fields[i]);
    end;
  end;
end;

procedure TMTDataStructEh.BuildFieldDefsFromStruct(FieldDefs: TFieldDefs);

  procedure CreateFieldDefs(FieldDefs: TFieldDefs);
  var
    I: Integer;
    F: TMTDataFieldEh;
    FieldDef: TFieldDef;
  begin
    for I := 0 to Count - 1 do
    begin
      F := DataFields[I];
      with F do
      begin
        FieldDef := FieldDefs.AddFieldDef;
        FieldDef.Name := F.FieldName;
        FieldDef.DataType := DataType;
        FieldDef.Size := Size;
        if Required then
          FieldDef.Attributes := [faRequired];
//        if ReadOnly then
//          FieldDef.Attributes := FieldDef.Attributes + [faReadonly];
        if (DataType = ftBCD) and (F is TMTNumericDataFieldEh) then
          FieldDef.Precision := TMTNumericDataFieldEh(F).Precision;
//        if F is TObjectField then
//          CreateFieldDefs(TObjectField(F).Fields, FieldDef.ChildDefs);
      end;
    end;
  end;

begin
  FieldDefs.BeginUpdate;
  FieldDefs.Clear;
  try
    CreateFieldDefs(FieldDefs);
  finally
    FieldDefs.EndUpdate;
  end;
end;

function TMTDataStructEh.FieldIndex(const FieldName: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Count - 1 do
    if UpperCase(DataFields[I].FieldName) = UpperCase(FieldName) then
    begin
      Result := I;
      Exit;
    end;
//  if Result = -1 then
//    DatabaseErrorFmt(SFieldNotFound, [FieldName], Self);
end;

procedure TMTDataStructEh.GetFieldList(List: TList; const FieldNames: string);
var
  Pos: Integer;
  Field: TMTDataFieldEh;
begin
  Pos := 1;
  while Pos <= Length(FieldNames) do
  begin
    Field := FieldByName(ExtractFieldName(FieldNames, Pos));
    if Assigned(List) then List.Add(Field);
  end;
end;

function TMTDataStructEh.FieldByName(const FieldName: string): TMTDataFieldEh;
begin
  Result := FindField(FieldName);
  if Result = nil then
    DatabaseErrorFmt(SFieldNotFound, [FieldName], Self);
end;

procedure TMTDataStructEh.Assign(Source: TPersistent);
var
  i: Integer;
  DataField: TMTDataFieldEh;
begin
  if Source is TMTDataStructEh then
  begin
    if MemTableData.RecordsList.RecsCount > 0 then
      raise Exception.Create('Can not assign struct for not empty list of records');
    Clear;
    for i:=0 to TMTDataStructEh(Source).Count-1 do
    begin
      DataField := CreateField(TMTDataFieldClassEh(TMTDataStructEh(Source)[i].ClassType));
      DataField.Assign(TMTDataStructEh(Source)[i]);
//??      InsertField(DataField);
    end;
  end else
    inherited Assign(Source);
end;

{ TMTDataFieldEh }

constructor TMTDataFieldEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TMTDataFieldEh.Destroy;
begin
  inherited Destroy;
end;

function TMTDataFieldEh.DefaultAlignment: TAlignment;
begin
  Result := taLeftJustify;
end;

function TMTDataFieldEh.DefaultDisplayLabel: String;
begin
  Result := Name;
end;

function TMTDataFieldEh.DefaultDisplayWidth: Integer;
begin
  Result := 50;
end;

function TMTDataFieldEh.DefaultEditMask: String;
begin
  Result := '';
end;

function TMTDataFieldEh.DefaultRequired: Boolean;
begin
  Result := False;
end;

function TMTDataFieldEh.DefaultSize: Integer;
begin
  Result := 0;
end;

function TMTDataFieldEh.DefaultVisible: Boolean;
begin
  Result := True;
end;

function TMTDataFieldEh.DefValueForDefaultExpression: String;
begin
  Result := '';
end;

function TMTDataFieldEh.GetAlignment: TAlignment;
begin
  Result := FAlignment;
end;

function TMTDataFieldEh.GetDataType: TFieldType;
begin
  Result := ftUnknown;
end;

function TMTDataFieldEh.GetDefaultExpression: String;
begin
  Result := FDefaultExpression;
end;

function TMTDataFieldEh.GetDisplayLabel: String;
begin
  Result := FDisplayLabel;
end;

function TMTDataFieldEh.GetDisplayWidth: Integer;
begin
  Result := FDisplayWidth;
end;

function TMTDataFieldEh.GetEditMask: String;
begin
  Result := FEditMask;
end;

function TMTDataFieldEh.GetFieldName: String;
begin
  Result := FFieldName;
end;

function TMTDataFieldEh.GetReadOnly: Boolean;
begin
  Result := FReadOnly;
end;

function TMTDataFieldEh.GetRequired: Boolean;
begin
  Result := FRequired;
end;

function TMTDataFieldEh.GetSize: Integer;
begin
  Result := FSize;
end;

function TMTDataFieldEh.GetVisible: Boolean;
begin
  Result := FVisible;
end;

procedure TMTDataFieldEh.SetAlignment(const Value: TAlignment);
begin
  FAlignment := Value;
end;

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

procedure TMTDataFieldEh.SetDefaultExpression(const Value: String);
begin
  FDefaultExpression := Value;
end;

procedure TMTDataFieldEh.SetDisplayLabel(const Value: String);
begin
  FDisplayLabel := Value;
end;

procedure TMTDataFieldEh.SetDisplayWidth(const Value: Integer);
begin
  FDisplayWidth := Value;
end;

procedure TMTDataFieldEh.SetEditMask(const Value: String);
begin
  FEditMask := Value;
end;

function GenerateName(FieldName: string; Number: Integer): string;
var
  I: Integer;
begin
  I := 1;
  while I <= Length(FieldName) do
  begin
    if FieldName[I] in ['A'..'Z','a'..'z','_','0'..'9'] then
      Inc(I)
    else if FieldName[I] in LeadBytes then
      Delete(FieldName, I, 2)
    else
      Delete(FieldName, I, 1);
  end;
  Result := FieldName;
end;

function TMTDataFieldEh.CreateUniqueName(const FieldName: string): string;
var
  I: Integer;

  function IsUnique(const AName: string): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    if DataStruct <> nil then
      for I := 0 to DataStruct.Count - 1 do
        if AnsiCompareText(DataStruct[I].Name, AName) = 0 then Exit;
    Result := True;
  end;

begin
  for I := 1 to MaxInt do
  begin
    Result := GenerateName(FieldName, I);
    if IsUnique(Result) then Exit;
  end;
end;

procedure TMTDataFieldEh.SetFieldName(const Value: String);
begin
  CheckInactive;
  if (DataStruct <> nil) and (AnsiCompareText(Value, FFieldName) <> 0) then
    DataStruct.CheckFieldName(Value);
  FFieldName := Value;
  Name := CreateUniqueName(Value);
//  if FDisplayLabel = Value then FDisplayLabel := '';
//  if FDataSet <> nil then FDataSet.FFields.Changed;
end;

procedure TMTDataFieldEh.SetReadOnly(const Value: Boolean);
begin
  FReadOnly := Value;
end;

procedure TMTDataFieldEh.SetRequired(const Value: Boolean);
begin
  FRequired := Value;
end;

procedure TMTDataFieldEh.SetSize(const Value: Integer);
begin
  if not CanDinaSize then
    DatabaseError(SInvalidFieldSize);
  FSize := Value;
end;

procedure TMTDataFieldEh.SetVisible(const Value: Boolean);
begin
  FVisible := Value;
end;

function TMTDataFieldEh.GetParentComponent: TComponent;
begin
  Result := DataStruct;
end;

procedure TMTDataFieldEh.SetParentComponent(AParent: TComponent);
begin
  if not (csLoading in ComponentState) then
    FDataStruct := AParent as TMTDataStructEh;
end;

function TMTDataFieldEh.HasParent: Boolean;
begin
  Result := True;
end;

procedure TMTDataFieldEh.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  DataStruct := TMTDataStructEh(Reader.Parent);
end;

procedure TMTDataFieldEh.Assign(Source: TPersistent);
begin
  if Source is TMTDataFieldEh then
  begin
    FieldName := TMTDataFieldEh(Source).FieldName;
    if CanDinaSize then
      Size := TMTDataFieldEh(Source).Size;
    Alignment := TMTDataFieldEh(Source).Alignment;
    DefaultExpression := TMTDataFieldEh(Source).DefaultExpression;
    DisplayLabel := TMTDataFieldEh(Source).DisplayLabel;
    DisplayWidth := TMTDataFieldEh(Source).DisplayWidth;
    EditMask := TMTDataFieldEh(Source).EditMask;
    Required := TMTDataFieldEh(Source).Required;
    Visible := TMTDataFieldEh(Source).Visible;
  end else
    inherited Assign(Source);
end;

procedure TMTDataFieldEh.CheckInactive;
begin
  if (DataStruct <> nil) and (DataStruct.MemTableData <> nil) then
    DataStruct.MemTableData.CheckInactive;
end;

function TMTDataFieldEh.CanDinaSize: Boolean;
begin
  Result := False;
end;

procedure TMTDataFieldEh.AssignProps(Field: TField);
begin
  Alignment := Field.Alignment;
  DefaultExpression := Field.DefaultExpression;
  DisplayLabel := Field.DisplayLabel;
  DisplayWidth := Field.DisplayWidth;
  EditMask := Field.EditMask;
  Required := Field.Required;
  if CanDinaSize then
    Size := Field.Size;
  Visible := Field.Visible;
end;

function TMTDataFieldEh.GetVarDataType: TVarType;
begin
  case DataType of
    ftUnknown: Result := varError;
    ftString: Result := varString;
    ftSmallint: Result := varSmallint;
    ftInteger: Result := varInteger;
    ftWord: Result := varInteger;