Delphi implementation of ERP document list column Setup

Source: Internet
Author: User

Needless to say, ERP you understand. A report, different customers can be transferred to death you. Direct

Through this setup interface, the Dbgrideh of the parameter adjustment report is generated directly. Yes, it is Dbgrideh, not DBGrid, nor Cxgrid.

These parameters are then generated in a JSON and saved to the database. Next time you open it, just take this JSON. In this way, customers can adjust their own reports according to their own needs.

Unit ugriddes;interfaceuses 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& Lt;> ' 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 ', ') the           N fieldname:=itemjson.valuebyname (' Cfieldname ', '); If Width<>strtoint (' iwidth ', ' itemjson.valuebyname ') then Width:=strtoint (Itemjson.valuebyname (' IWidt           H ', ' 64 ')); If Title.caption<>itemjson.valuebyname (' Cdeftitle ', ' 1 ') then Title.caption:=itemjson.valuebyname (' CDefTi           Tle ', ' 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 does 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 (' column settings not saved, cannot exit ');    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 clien Theight = 416 ClientWidth = 425 Color = Clbtnface Font.charset = Default_charset Font.Color = Clwindowtext Font.Heigh t = -11 font.name = ' Tahoma ' Font.style = [] Oldcreateorder = False OnCreate = formcreate onshow = formshow Pixelspe  Rinch = TextHeight = 0 Object Toolbar1:ttoolbar left = Top = 0 Width = 425 Height = Buttonwidth     = 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:ttoolbutto N left = 0 Top = 0 Caption = #20462 #25913 imageindex = 0 OnClick = Toolbutton1click End obj ECT Toolbutton5:ttoolbuTton left = from Top = 0 Caption = #21521 #19978 Enabled = False ImageIndex = 3 OnClick = Toolb  Utton5click End Object Toolbutton6:ttoolbutton left = 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 ob Ject Toolbutton4:ttoolbutton left = 124 Top = 0 Caption = #25918 #24323 Enabled = False Imageinde x = 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 = Panels = < Item Text = #26639 #30446#33258#23450#20041#35774#3  2622 Width = 50    End> End Object Dbgrideh1:tdbgrideh left = 0 Top = Width = 425 Height = 371 Align = alclient Color = 13816530 ColumnDefValues.Title.Alignment = Tacenter ColumnDefValues.Title.Color = Clbtnshadow Datagroup Ing. Color = Clwindow Datagrouping.parentcolor = False DataSource = DataSource1 Dynprops = <> Evenrowcolor = Clscrollbar Gridlineparams.datahorzlines = True Gridlineparams.datavertlines = False indicatoroptions = [GioShowR Owindicatoreh] Backgrounddata.visible = True Oddrowcolor = clgradientactivecaption RowHeight = rowpanel.act ive = True Stfilter.color = Clactiveborder TabOrder = 2 TitleParams.Font.Charset = Default_charset Titleparams . Font.Color = Clwindowtext TitleParams.Font.Height = 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 = & lt;> editbuttons = <> FieldName = ' iwidth ' footers = <> title.caption = #23485 # 24230 End Item Dynprops = <> Editbuttons = <> FieldName = ' bvisible ' Foo ters = <> TItle.        Caption = #26174 #31034 Width = $ end Item Dynprops = <> Editbuttons = <> FieldName = ' iRow ' footers = <> Visible = False end> Object Rowdetaildata:trowdetailpane Lcontroleh end End Object Fdmem:tfdmemtable Fielddefs = < Item Name = ' IRow ' DataType = FtI        Nteger End Item Name = ' Cfieldname ' DataType = ftstring Size = + END Item name = ' Ctitle ' DataType = ftstring Size = ' End Item ' name = ' Cdeftitle ' DataType        = Ftstring Size = The end item Name = ' iwidth ' DataType = Ftfloat End Item Name = ' bvisible ' DataType = Ftboolean end> indexdefs = <> Fetchoptions.assignedvalues = [Evmod    E] Fetchoptions.mode = Fmall resourceoptions.assignedvalues = [Rvsilentmode] Resourceoptions.silentmode = True Updateoptions.assiGnedvalues = [uvcheckrequired, uvautocommitupdates] updateoptions.checkrequired = False UPDATEOPTIONS.AUTOCOMMITUPDA  TES = True Storedefs = True left = $ Top = 144 End Object Datasource1:tdatasource DataSet = Fdmem Left = 288 Top = 176 EndEnd

Delphi implementation of ERP document list column Setup

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.