Delphi实现ERP单据列表栏目设置

什么都不用说了，ERP你懂的。一张报表，不同的客户都可以调死你。直接上图

通过这个设置界面，直接生成参数调整报表所用的DBGridEh。对，是DBGridEh，不是DBGrid,也不是CXGrid。

然后再将这些参数生成一个JSON，保存到数据库。下次打开，直接取这个JSON就可以了。这样，客户可以根据自己的需要调整自己的报表。

unit uGridDes;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,DbGridEh, DBGridEhGrouping, ToolCtrlsEh,
  DBGridEhToolCtrls, DynVarsEh, FireDAC.Stan.Intf, FireDAC.Stan.Option,
  FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
  FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
  EhLibVCL, GridsEh, DBAxisGridsEh,QJson, Vcl.ComCtrls, Vcl.ToolWin;

type
  RGridIndex=record
    cFileName:String;
    cTitle:String;
    cDefTitle:String;
    iWidth:Integer;
    bVisible:Boolean;
  end;
  TFrmGridDes = class(TForm)
    FDMem: TFDMemTable;
    DataSource1: TDataSource;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    StatusBar1: TStatusBar;
    DBGridEh1: TDBGridEh;
    procedure FormShow(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure DBGridEh1CellClick(Column: TColumnEh);
    procedure ToolButton4Click(Sender: TObject);
  private
  //  function JsonLoadGrid: TQJson;
    { Private declarations }
  public
    FDBGridEh:TDBGridEh;
    FJson:TQJson;
    function UPDateJson:TQJson;
    function GetJsonFromGrid:TQJson;
    function UPDateGrid:Boolean;
    Function TryParsetojson(Text:String):Boolean;
  class Function SetGridasJson(FDBGrid:TDBGridEh;Ajson:TQjson):TQJson;
    { Public declarations }
  end;

var
  FrmGridDes: TFrmGridDes;

implementation

{$R *.dfm}

procedure TFrmGridDes.DBGridEh1CellClick(Column: TColumnEh);
begin
// if  then
  if DBGridEh1.ReadOnly=False  And (Column.FieldName<>'cFieldName') then
    DBGridEh1.EditorMode:=True;

end;

procedure TFrmGridDes.FormCreate(Sender: TObject);
begin
  FJson:=TQJson.Create;
  FDMem.CreateDataSet;
end;

procedure TFrmGridDes.FormShow(Sender: TObject);
var
  I:integer;
begin

  Self.Left:=(Screen.Width-Self.Width) div 2;
  Self.Top:=(Screen.Height-Self.Height)div 2;
  DBGridEh1.ReadOnly:=True;
  DBGridEh1.Options:=DBGridEh1.Options-[dgEditing]+[dgRowSelect];
  FDMem.Close;
  FDMem.CreateDataSet;
//  if FJson.Count=0 then

     for I := 0 to FDBGridEh.Columns.Count-1 do
        FDMem.AppendRecord([I,FDBGridEh.Columns[i].FieldName,FDBGridEh.Columns[i].Title.Caption,
        FDBGridEh.Columns[i].Title.Caption,FDBGridEh.Columns[i].Width,FDBGridEh.Columns[i].Visible]);

   FDMem.First;


end;

function TFrmGridDes.GetJsonFromGrid: TQJson;
Var
  I:integer;
begin
  Result:=nil;
  FDMem.DisableControls;
  FDMem.Table.Clear;
   for I := 0 to FDBGridEh.Columns.Count-1 do
      FDMem.AppendRecord([I,FDBGridEh.Columns[i].FieldName,FDBGridEh.Columns[i].Title.Caption,
      FDBGridEh.Columns[i].Title.Caption,FDBGridEh.Columns[i].Width,FDBGridEh.Columns[i].Visible]);
   UPDateJson;
   FDMem.First;
   FDMem.EnableControls;
   Result:=Fjson;
end;



function TFrmGridDes.UPDateGrid:Boolean;
Var
  ItemJson:TQJson;
  I:integer;
begin
  Result:=False;
  if Fjson.Count=0 then Exit;

  Try

  for I := 0 to FJson.Count-1 do
      begin
       ItemJson:=FJson.ItemByName(IntToStr(I));
       With FDBGridEh.Columns[i] do// else
         begin
           if  FieldName<>ItemJson.ValueByName('cFieldName','') then
             FieldName:=ItemJson.ValueByName('cFieldName','');
           if Width<>StrTOInt(ItemJson.ValueByName('iWidth','64')) then
             Width:=StrTOInt(ItemJson.ValueByName('iWidth','64'));
           if Title.Caption<>ItemJson.ValueByName('cDefTitle','1') then
             Title.Caption:=ItemJson.ValueByName('cDefTitle','1');
           if Visible<>StrToBool(ItemJson.ValueByName('bVisible','2')) then
             Visible:=StrToBool(ItemJson.ValueByName('bVisible','2'));
         end;
//         ItemJson.Free;
      end;
  except
    Exit(False);
  End;

   Result:=True;

end;

function TFrmGridDes.UPDateJson: TQJson;
Var
  ItemJson:TQJson;
  str:string;
begin
 FJson.Clear;
 FDMem.DisableControls;
 FDMem.First;
 while Not FDMem.Eof do
   begin
     ItemJson:=TQJson.Create;
     for Str in FDMem.FieldList do
       ItemJson.Add(Str,FDMem.FieldByName(Str).AsString);
     FJson.Add(IntToStr(FDMem.FieldByName('iRow').AsInteger),ItemJson);
     FDMem.Next;
   end;
 FDMem.First;
 FDMem.EnableControls;
 Result:=FJson;
end;

class function TFrmGridDes.SetGridasJson(FDBGrid: TDBGridEh;
  Ajson: TQjson): TQJson;
begin
  if FrmGridDes=nil then
   FrmGridDes:=TFrmGridDes.Create(nil);
   FrmGridDes.FDBGridEh:=FDBGrid;

     FrmGridDes.UPDateGrid;
   FrmGridDes.ShowModal;
   FrmGridDes.UPDateGrid;
   Result:=TQJson.Create;
   Result.Assign(FrmGridDes.fJson);

end;

procedure TFrmGridDes.ToolButton1Click(Sender: TObject);
begin

 DBGridEh1.ReadOnly:=False;
 DBGridEh1.Options:=DBGridEh1.Options+[dgediting]-[dgRowSelect];
 ToolButton2.Enabled:=True;
 ToolButton1.Enabled:=False;
 ToolButton5.Enabled:=True;
 ToolButton6.Enabled:=True;
 ToolButton4.Enabled:=True;
end;

procedure TFrmGridDes.ToolButton2Click(Sender: TObject);
begin
 FDMem.Edit;
 FDMem.Post;
 DBGridEh1.ReadOnly:=True;
 UPDateJson;
 DBGridEh1.Options:=DBGridEh1.Options-[dgediting]+[dgRowSelect];
 ToolButton1.Enabled:=True;
 ToolButton2.Enabled:=False;
  ToolButton4.Enabled:=False;
  ToolButton5.Enabled:=False;
 ToolButton6.Enabled:=False;
end;

procedure TFrmGridDes.ToolButton3Click(Sender: TObject);
begin
 if ToolButton2.Enabled then
    begin
      ShowMessage('栏目设置未保存，不能退出');
      Exit;
    end;

 Close;
end;

procedure TFrmGridDes.ToolButton4Click(Sender: TObject);
begin
 FDMem.Edit;
 FDMem.Post;
 DBGridEh1.ReadOnly:=True;
 GetJsonFromGrid;
 DBGridEh1.Options:=DBGridEh1.Options-[dgediting]+[dgRowSelect];
 ToolButton1.Enabled:=True;
 ToolButton2.Enabled:=False;
 ToolButton4.Enabled:=False;
 ToolButton5.Enabled:=False;
 ToolButton6.Enabled:=False;
end;

procedure TFrmGridDes.ToolButton5Click(Sender: TObject);

Var
  R1,R2:RGridIndex;
begin
  if FDMem.Bof then exit;

  FDMem.DisableControls;
  R1.cFileName:=FDMem.FieldByName('cFieldName').AsString;
  R1.cTitle:=FDMem.FieldByName('cTitle').AsString;
  R1.cDefTitle:=FDMem.FieldByName('cDefTitle').AsString;
  R1.iWidth:=FDMem.FieldByName('iWidth').AsInteger;
  R1.bVisible:=FDMem.FieldByName('bVisible').AsBoolean;

  FDMem.Prior;

  R2.cFileName:=FDMem.FieldByName('cFieldName').AsString;
  R2.cTitle:=FDMem.FieldByName('cTitle').AsString;
  R2.cDefTitle:=FDMem.FieldByName('cDefTitle').AsString;
  R2.iWidth:=FDMem.FieldByName('iWidth').AsInteger;
  R2.bVisible:=FDMem.FieldByName('bVisible').AsBoolean;
  FDMem.Edit;
  FDMem.FieldByName('cFieldName').AsString:=R1.cFileName;
  FDMem.FieldByName('ctitle').AsString:=R1.cTitle;
  FDMem.FieldByName('cDeftitle').AsString:=R1.cDefTitle;
  FDMem.FieldByName('iWidth').AsInteger:=r1.iWidth;
  FDMem.FieldByName('bVisible').AsBoolean:=R1.bVisible;
  FDMem.Next;
  FDMem.Edit;
  FDMem.FieldByName('cFieldName').AsString:=R2.cFileName;
  FDMem.FieldByName('ctitle').AsString:=R2.cTitle;
  FDMem.FieldByName('cDeftitle').AsString:=R2.cDefTitle;
  FDMem.FieldByName('iWidth').AsInteger:=r2.iWidth;
  FDMem.FieldByName('bVisible').AsBoolean:=R2.bVisible;
  FDMem.Prior;
  FDMem.EnableControls;

end;

procedure TFrmGridDes.ToolButton6Click(Sender: TObject);
Var
  R1,R2:RGridIndex;
begin
 if FDMem.Eof then Exit;

  FDMem.DisableControls;
  R1.cFileName:=FDMem.FieldByName('cFieldName').AsString;
  R1.cTitle:=FDMem.FieldByName('cTitle').AsString;
  R1.cDefTitle:=FDMem.FieldByName('cDefTitle').AsString;
  R1.iWidth:=FDMem.FieldByName('iWidth').AsInteger;
  R1.bVisible:=FDMem.FieldByName('bVisible').AsBoolean;

  FDMem.Next;

  R2.cFileName:=FDMem.FieldByName('cFieldName').AsString;
  R2.cTitle:=FDMem.FieldByName('cTitle').AsString;
  R2.cDefTitle:=FDMem.FieldByName('cDefTitle').AsString;
  R2.iWidth:=FDMem.FieldByName('iWidth').AsInteger;
  R2.bVisible:=FDMem.FieldByName('bVisible').AsBoolean;
  FDMem.Edit;
  FDMem.FieldByName('cFieldName').AsString:=R1.cFileName;
  FDMem.FieldByName('ctitle').AsString:=R1.cTitle;
  FDMem.FieldByName('cDeftitle').AsString:=R1.cDefTitle;
  FDMem.FieldByName('iWidth').AsInteger:=r1.iWidth;
  FDMem.FieldByName('bVisible').AsBoolean:=R1.bVisible;
  FDMem.Prior;
  FDMem.Edit;
  FDMem.FieldByName('cFieldName').AsString:=R2.cFileName;
  FDMem.FieldByName('ctitle').AsString:=R2.cTitle;
  FDMem.FieldByName('cDeftitle').AsString:=R2.cDefTitle;
  FDMem.FieldByName('iWidth').AsInteger:=r2.iWidth;
  FDMem.FieldByName('bVisible').AsBoolean:=R2.bVisible;
  FDMem.Next;
  FDMem.EnableControls;

end;

function TFrmGridDes.TryParsetojson(Text: String): Boolean;
begin
  Result:=FJson.TryParse(Text);
end;

end.

object FrmGridDes: TFrmGridDes
  Left = 0
  Top = 0
  BorderIcons = []
  BorderStyle = bsDialog
  Caption = #35774#32622
  ClientHeight = 416
  ClientWidth = 425
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ToolBar1: TToolBar
    Left = 0
    Top = 0
    Width = 425
    Height = 26
    ButtonWidth = 31
    Caption = 'ToolBar1'
    DrawingStyle = dsGradient
    EdgeBorders = [ebLeft, ebTop, ebRight]
    EdgeInner = esNone
    EdgeOuter = esNone
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -12
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    ShowCaptions = True
    TabOrder = 0
    object ToolButton1: TToolButton
      Left = 0
      Top = 0
      Caption = #20462#25913
      ImageIndex = 0
      OnClick = ToolButton1Click
    end
    object ToolButton5: TToolButton
      Left = 31
      Top = 0
      Caption = #21521#19978
      Enabled = False
      ImageIndex = 3
      OnClick = ToolButton5Click
    end
    object ToolButton6: TToolButton
      Left = 62
      Top = 0
      Caption = #21521#19979
      Enabled = False
      ImageIndex = 3
      OnClick = ToolButton6Click
    end
    object ToolButton2: TToolButton
      Left = 93
      Top = 0
      Caption = #20445#23384
      Enabled = False
      ImageIndex = 1
      OnClick = ToolButton2Click
    end
    object ToolButton4: TToolButton
      Left = 124
      Top = 0
      Caption = #25918#24323
      Enabled = False
      ImageIndex = 3
      OnClick = ToolButton4Click
    end
    object ToolButton3: TToolButton
      Left = 155
      Top = 0
      Caption = #36864#20986
      ImageIndex = 2
      OnClick = ToolButton3Click
    end
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 397
    Width = 425
    Height = 19
    Panels = <
      item
        Text = #26639#30446#33258#23450#20041#35774#32622
        Width = 50
      end>
  end
  object DBGridEh1: TDBGridEh
    Left = 0
    Top = 26
    Width = 425
    Height = 371
    Align = alClient
    Color = 13816530
    ColumnDefValues.Title.Alignment = taCenter
    ColumnDefValues.Title.Color = clBtnShadow
    DataGrouping.Color = clWindow
    DataGrouping.ParentColor = False
    DataSource = DataSource1
    DynProps = <>
    EvenRowColor = clScrollBar
    GridLineParams.DataHorzLines = True
    GridLineParams.DataVertLines = False
    IndicatorOptions = [gioShowRowIndicatorEh]
    BackgroundData.Visible = True
    OddRowColor = clGradientActiveCaption
    RowHeight = 23
    RowPanel.Active = True
    STFilter.Color = clActiveBorder
    TabOrder = 2
    TitleParams.Font.Charset = DEFAULT_CHARSET
    TitleParams.Font.Color = clWindowText
    TitleParams.Font.Height = 15
    TitleParams.Font.Name = 'Tahoma'
    TitleParams.Font.Style = [fsBold]
    TitleParams.ParentFont = False
    OnCellClick = DBGridEh1CellClick
    Columns = <
      item
        Color = 11776947
        DynProps = <>
        EditButtons = <>
        FieldName = 'cFieldName'
        Footers = <>
        ReadOnly = True
        TextEditing = False
        Title.Caption = #23383#27573
        Title.Color = clGradientInactiveCaption
        Width = 113
      end
      item
        DynProps = <>
        EditButtons = <>
        FieldName = 'cTitle'
        Footers = <>
        ReadOnly = True
        Title.Caption = #26631#39064
        Visible = False
        Width = 126
      end
      item
        DynProps = <>
        EditButtons = <>
        FieldName = 'cDefTitle'
        Footers = <>
        Title.Caption = #33258#23450#20041#26631#39064
        Width = 143
      end
      item
        DynProps = <>
        EditButtons = <>
        FieldName = 'iWidth'
        Footers = <>
        Title.Caption = #23485#24230
      end
      item
        DynProps = <>
        EditButtons = <>
        FieldName = 'bVisible'
        Footers = <>
        Title.Caption = #26174#31034
        Width = 53
      end
      item
        DynProps = <>
        EditButtons = <>
        FieldName = 'iRow'
        Footers = <>
        Visible = False
      end>
    object RowDetailData: TRowDetailPanelControlEh
    end
  end
  object FDMem: TFDMemTable
    FieldDefs = <
      item
        Name = 'iRow'
        DataType = ftInteger
      end
      item
        Name = 'cFieldName'
        DataType = ftString
        Size = 20
      end
      item
        Name = 'cTitle'
        DataType = ftString
        Size = 50
      end
      item
        Name = 'cDefTitle'
        DataType = ftString
        Size = 50
      end
      item
        Name = 'iWidth'
        DataType = ftFloat
      end
      item
        Name = 'bVisible'
        DataType = ftBoolean
      end>
    IndexDefs = <>
    FetchOptions.AssignedValues = [evMode]
    FetchOptions.Mode = fmAll
    ResourceOptions.AssignedValues = [rvSilentMode]
    ResourceOptions.SilentMode = True
    UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
    UpdateOptions.CheckRequired = False
    UpdateOptions.AutoCommitUpdates = True
    StoreDefs = True
    Left = 152
    Top = 144
  end
  object DataSource1: TDataSource
    DataSet = FDMem
    Left = 288
    Top = 176
  end
end