Delphi使用DataSet上的任何字段將OnCalcFields填充爲DBGrid中的值數組的簡單方法

簡單方法是使用條件數據,窗體定義使用DataSet上的任何字段來像DBGrid中的值數組一樣填充OnCalcFields  :歡迎加入Delphi開發局QQ羣:32422310 但我還是強烈建議在開發大型商業軟件中使用TMS TAdvStringGrid組件來代替類似DBGrid的數據綁定的網格控件,因爲TMS TAdvStringGrid的最大優點是強大的可控制性和邏輯與數據分離,能滿足頸椎枕用戶的變態要求。

object frmFormMain: TfrmFormMain
  Left = 0
  Top = 0
  Caption = 'frmFormMain'
  ClientHeight = 352
  ClientWidth = 402
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 8
    Top = 16
    Width = 385
    Height = 328
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
    Columns = <
      item
        Expanded = False
        FieldName = 'ID'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'DATA'
        Width = 150
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'C1'
        Width = 50
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'C2'
        Width = 50
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'C3'
        Width = 50
        Visible = True
      end>
  end
  object FDMemTable1: TFDMemTable
    OnCalcFields = FDMemTable1CalcFields
    FieldDefs = <>
    IndexDefs = <>
    FetchOptions.AssignedValues = [evMode]
    FetchOptions.Mode = fmAll
    ResourceOptions.AssignedValues = [rvPersistent, rvSilentMode]
    ResourceOptions.Persistent = True
    ResourceOptions.SilentMode = True
    UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
    UpdateOptions.CheckRequired = False
    UpdateOptions.AutoCommitUpdates = True
    StoreDefs = True
    Left = 80
    Top = 257
    object FDMemTable1ID: TIntegerField
      DisplayWidth = 10
      FieldName = 'ID'
    end
    object FDMemTable1DATA: TStringField
      DisplayWidth = 20
      FieldName = 'DATA'
    end
    object FDMemTable1C1: TStringField
      DisplayWidth = 2
      FieldKind = fkCalculated
      FieldName = 'C1'
      Size = 1
      Calculated = True
    end
    object FDMemTable1C2: TStringField
      DisplayWidth = 2
      FieldKind = fkCalculated
      FieldName = 'C2'
      Size = 1
      Calculated = True
    end
    object FDMemTable1C3: TStringField
      DisplayWidth = 18
      FieldKind = fkCalculated
      FieldName = 'C3'
      Size = 1
      Calculated = True
    end
  end
  object FDGUIxWaitCursor1: TFDGUIxWaitCursor
    Provider = 'Forms'
    Left = 272
    Top = 192
  end
  object FDStanStorageXMLLink1: TFDStanStorageXMLLink
    Left = 128
    Top = 184
  end
  object DataSource1: TDataSource
    DataSet = FDMemTable1
    Left = 192
    Top = 256
  end
end

my frmFormMain.pas
...

var
  frmFormMain: TfrmFormMain;
implementation
{$R *.dfm}
var
  // what will be writed if the "initial value" was empty? = first record, for example!
  lC1: string = '?';
  lC2: string = '?';
  lC3: string = '?';
procedure TfrmFormMain.FDMemTable1CalcFields(DataSet: TDataSet);
var
  lMyArrayString: TArray<string>;
  lMyTextTmp    : string;
  lMyField      : TField;
begin
  lMyTextTmp     := '';
  lMyArrayString := nil;
  lMyField       := nil;
  //
  for lMyField in DataSet.Fields do
  begin
    if (lMyField.FieldNo = -1) then // only CalcField (FieldNo = -1) will be processed!
    begin
      lMyTextTmp := DataSet.Fields.Fields[1].AsString; // Field "DATA" it's the source!
      //
      lMyArrayString := lMyTextTmp.Split([';'], TStringSplitOptions.ExcludeEmpty);
      lMyTextTmp     := '';
      //
      for lMyTextTmp in lMyArrayString do // analizing what will be write!
      begin
        if lMyTextTmp.Contains('0=') then
        begin
          DataSet.Fields.Fields[2].AsString := lMyTextTmp.Chars[2];
          lC1          := DataSet.Fields.Fields[2].AsString;
        end;
        //
        if lMyTextTmp.Contains('1=') then
        begin
          DataSet.Fields.Fields[3].AsString := lMyTextTmp.Chars[2];
          lC2          := DataSet.Fields.Fields[3].AsString;
        end;
        //
        if lMyTextTmp.Contains('2=') then
        begin
          DataSet.Fields.Fields[4].AsString := lMyTextTmp.Chars[2];
          lC3          := DataSet.Fields.Fields[4].AsString;
        end;
        //
      end;
      //
      if DataSet.Fields.Fields[2].IsNull then
        DataSet.Fields.Fields[2].AsString := lC1;
      //
      if DataSet.Fields.Fields[3].IsNull then
        DataSet.Fields.Fields[3].AsString := lC2;
      //
      if DataSet.Fields.Fields[4].IsNull then
        DataSet.Fields.Fields[4].AsString := lC3;
    end;
  end;
end;
procedure TfrmFormMain.FormCreate(Sender: TObject);
begin
  // loading my fields structure and some initial value
  FDMemTable1.ResourceOptions.PersistentFileName := '..\..\MyXMLFDMemTableData.xml';
  FDMemTable1.ResourceOptions.Persistent         := True;
  //
  FDMemTable1.LoadFromFile(FDMemTable1.ResourceOptions.PersistentFileName, sfXML);
  //
  if FDMemTable1.Active then;
end;

 { NOTE:
    if your table had all records deleted, verify if your "initial value - your vars" should be "cleaned" too!
  }

procedure TfrmFormMain.FDMemTable1AfterDelete(DataSet: TDataSet);
begin
  if DataSet.RecordCount = 0 then // for example, to re-start your vars!
  begin
    lC1 := '?';
    lC2 := '?';
    lC3 := '?';
  end;
end;

 

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章