Delphi通过RTTI实现TdxDBGrid，TDBGrid标题，列宽，显示顺序，字体大小颜色等动态配置 ...

OStack程序员社区-中国程序员成长平台 › 门户 › 编程›综合其他

Delphi通过RTTI实现TdxDBGrid，TDBGrid标题，列宽，显示顺序，字体大小颜色等动态配置 ...

原作者: [db:作者] 来自: [db:来源] 收藏邀请

测试界面：

配置界面：

配置表

代码实现：

可以通过配置表，也可以通过配置文件保存，我这里试通过数据库表保存的。
源代码下载地址：https://download.csdn.net/download/weixin_41660162/11110045

后台表结构设计（DBDsigner）：

if not exists(select 1 from sysobjects where name='YY_TABLE_DISPLAY' and type='U')
begin
	create table YY_TABLE_DISPLAY
	(
		xh int identity(1,1),--序号
		czyh ut_czyh not null,
		dllname ut_mc64 not null,--dll名
		formname ut_mc64 not null,--窗体名
		controlname ut_mc64 not null,--控件名
		color ut_mc64 null,--颜色
		fontcolor ut_mc64 null,--字体颜色
		gridlinecolor ut_mc64 null,--边框线颜色
		--showbands ut_bz null,--显示Band
		--bandcolor ut_mc64 null,--Band颜色
		--bandfontcolor ut_mc64 null,--Band字体颜色
		--bandmaxrowcount int null,--Band最大行数
		--bandrowcount int null,--Band行数
		borderstyle ut_mc64 null,--边框样式
		showgrouppanel ut_bz not null,--显示分组
		grouppanelcolor ut_mc64 null,--分组颜色
		grouppanelfontcolor ut_mc64 null,--分组字体颜色
		--showheader ut_bz not null,--显示标题
		headercolor ut_mc64 null,--标题颜色
		headerfontcolor ut_mc64 null,--标题字体颜色
		showhint ut_bz not null,--显示提示
		hint ut_mc64 null,--提示内容
		fontsize int null,--字体大小
		headerfontsize int null,--标题字体大小
		constraint PK_YY_TABLE_DISPLAY primary key(xh),
		constraint INDEX_YY_TABLE_DISPLAY unique(czyh,dllname,formname,controlname)		
	) 
end
go



if not exists(select 1 from sysobjects where name='YY_TABLE_DISPLAY_DETAIL' and type='U')
begin
	create table YY_TABLE_DISPLAY_DETAIL
	(
		xh int identity(1,1),--序号
		masterxh int not null,--主表序号YY_TABLE_DISPLAY.xh
		fieldname ut_mc64 not null,--字段名
		caption ut_mc64 not null,--显示名
		fieldwidth int not null,--列宽
		fieldindex int not null,--列的显示序号
		fieldvisible ut_bz not null,--列是否可见
		color ut_mc64 null,--背景颜色
		fontcolor ut_mc64 null,--字体颜色	
		disableediter ut_bz null,--是否可编辑
		alignment ut_mc64 null,--字体的停靠格式
		headeralignment ut_mc64 null,--标题字体的停靠格式
		fontsize int null,--字体大小
		constraint PK_YY_TABLE_DISPLAY_DETAIL primary key(xh),
		constraint INDEX_YY_TABLE_DISPLAY_DETAIL unique(masterxh,fieldname)		
	) 
end
go


alter table YY_TABLE_DISPLAY add headerfontsize int null

select xh,color,fontcolor,gridlinecolor,borderstyle  ,showgrouppanel,grouppanelcolor,grouppanelfontcolor,headercolor,
headerfontcolor,showhint,hint  from YY_TABLE_DISPLAY (nolock) where czyh='00' and dllname='ProjectTest' 
and formname='Form1' and controlname='dbgrd1' 

select fieldname,caption,fieldwidth,fieldindex  ,fieldvisible,color,fontcolor,disableediter,alignment,headeralignment  
from YY_TABLE_DISPLAY_DETAIL (nolock) where masterxh='1'

测试端代码（Client）：

unit UnitTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxExEdtr, DB, DBClient, dxCntner, dxTL, dxDBCtrl, dxDBGrid,uDm, ShareMem,
  RzButton, StdCtrls, Buttons, Grids, DBGrids, dxInspct, dxOI;

type
  TForm1 = class(TForm)
    dbgrd1: TdxDBGrid;
    cds1: TClientDataSet;
    ds1: TDataSource;
    btn1: TRzBitBtn;
    btn2: TBitBtn;
    dbgrd2: TDBGrid;
    btn3: TRzBitBtn;
    dxrtnspctr1: TdxRTTIInspector;
    btn4: TBitBtn;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
  private
    { Private declarations }
    strsql,errmsg:string;
    dm:TDM;
    h: THandle;
    pSettingDisplay: function(const _oObject : TComponent;_sDllName,_sFormName,_sControlName,_sCzyh:string;_sInXml:widestring;out _sOutXml:widestring;_bDesigner:Boolean=true):string; stdcall;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
    dbgrd1.DefaultFields := true;
    strsql := ' select top 10 hzxm as 患者姓名,sfzh as 身份证号,patid as PATID,blh as 病历号,lxdh as 联系电话 from SF_BRXXK ';
    dm.FCdsOpen(strsql,errmsg,cds1);
    dbgrd1.ApplyBestFit(nil);
    dxrtnspctr1.InspectedObject := dbgrd2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    dm := TDM.Create(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    dm.Destroy;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
    i:integer;
    masterxh:string;
    inXml,OutXml:widestring;
Begin
    h := LoadLibrary('dynamicdisplay.dll');
    try
      try
        If h <> 0 Then
        Begin
            @pSettingDisplay := GetProcAddress(h, 'pSettingDisplay');
            if Assigned(pSettingDisplay) then masterxh := pSettingDisplay(dbgrd1,'ProjectTest','Form1','dbgrd1','00',inXml,OutXml,false);
            //dbgrd1.LoadFromIniFile('C:\123.ini');
            showmessage(masterxh);
        End;
      finally
        FreeLibrary(h);
      end;
    except
      on ex:Exception do
      begin
        dm.showerr(ex.Message);
      end;
    end;
End;

procedure TForm1.btn2Click(Sender: TObject);
var
    i:integer;
    masterxh:string;
    inXml,OutXml:widestring;
Begin
    h := LoadLibrary('dynamicdisplay.dll');
    try
      try
        If h <> 0 Then
        Begin
            @pSettingDisplay := GetProcAddress(h, 'pSettingDisplay');
            if Assigned(pSettingDisplay) then masterxh := pSettingDisplay(dbgrd1,'ProjectTest','Form1','dbgrd1','00',inXml,OutXml,true);
            //dbgrd1.LoadFromIniFile('C:\123.ini');
            showmessage(masterxh);
        End;
      finally
        FreeLibrary(h);
      end;
    except
      on ex:Exception do
      begin
        dm.showerr(ex.Message);
      end;
    end;
End;

procedure TForm1.btn3Click(Sender: TObject);
var
    i:integer;
    masterxh:string;
    inXml,OutXml:widestring;
Begin
    h := LoadLibrary('dynamicdisplay.dll');
    try
      try
        If h <> 0 Then
        Begin
            @pSettingDisplay := GetProcAddress(h, 'pSettingDisplay');
            if Assigned(pSettingDisplay) then masterxh := pSettingDisplay(dbgrd2,'ProjectTest','Form1','dbgrd2','00',inXml,OutXml,true);
            //dbgrd1.LoadFromIniFile('C:\123.ini');
            showmessage(masterxh);
        End;
      finally
        FreeLibrary(h);
      end;
    except
      on ex:Exception do
      begin
        dm.showerr(ex.Message);
      end;
    end;
End;

procedure TForm1.btn4Click(Sender: TObject);
var
    i:integer;
    masterxh:string;
    inXml,OutXml:widestring;
Begin
    h := LoadLibrary('dynamicdisplay.dll');
    try
      try
        If h <> 0 Then
        Begin
            @pSettingDisplay := GetProcAddress(h, 'pSettingDisplay');
            if Assigned(pSettingDisplay) then masterxh := pSettingDisplay(dbgrd2,'ProjectTest','Form1','dbgrd2','00',inXml,OutXml,false);
            //dbgrd1.LoadFromIniFile('C:\123.ini');
            showmessage(masterxh);
        End;
      finally
        FreeLibrary(h);
      end;
    except
      on ex:Exception do
      begin
        dm.showerr(ex.Message);
      end;
    end;
End;
end.

配置端代码(BLL):

{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}
unit UnitMain;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxCntner, dxInspct, dxOI,dxDBGrid, dxExEdtr, dxTL, dxDBCtrl,
  StdCtrls, Buttons, ExtCtrls, DB, dxDBTLCl, dxGrClms, DBClient,udm,StrUtils,ShareMem,
  RzPanel, RzSplit, RzButton, RzCmboBx,TypInfo, Grids, DBGrids;
const
    gc_sFieldName='字段名(FieldName)';
    gc_sCaptionName='显示名(Caption)';
    gc_sIndexName='索引位(Index)';
    gc_sWidthName='列  宽(Width)';
    gc_sVisibleName='可见性(Visible)';
    gc_sFontColorName='字体颜色(FontColor)';
type
    MasterTable=record//存放配置主表信息
        color:string;
        fontcolor:string;
        gridlinecolor:string;
        borderstyle:string;
        showgrouppanel:string;
        grouppanelcolor:string;
        grouppanelfontcolor:string;
        headercolor:string;
        headerfontcolor:string;
        showhint:string;
        hint:string;
        fontsize:integer;
        headerfontsize:integer;
    end;
type
    TColumnsObject=record //临时存储传入对象列的属性
        oColumn : TObject;
        sFieldName:string;
        sCaption:string;
        iIndex:integer;
        iWidth:integer;
        bVisible:Boolean;
        cColor:TColor;
        cFontColor:TColor;
        bDisableEditor:Boolean;
        sAlignment:string;
        sHeaderAlignment:string;
    end;
type
    TControlObject=record //临时存储传入对象的属性
        oObject : TComponent;
        iColumnCount:integer;
        oColumns : array of TColumnsObject;
        cColor:TColor;
        cFontColor:TColor;
        cGridLineColor:TColor;
        sBorderStyle:string;
        bShowGroupPanel:Boolean;
        cGroupPanelColor:TColor;
        cGroupPanelFontColor:TColor;
        cHeaderColor:TColor;
        cHeaderFontFolor:TColor;
        bShowHint:Boolean;
        sHint:string;
        iFontSize:integer;
        iHeaderFontSize:integer;
    end;
type
  TfrmMain = class(TForm)
    dxrtnspctr1: TdxRTTIInspector;
    dsMain: TDataSource;
    Panel2: TPanel;
    cdsFields: TClientDataSet;
    dbgrdMain: TdxDBGrid;
    dxdbgrdclmnMainColumn1: TdxDBGridColumn;
    Panel1: TPanel;
    PanelControlName: TPanel;
    rzspltr1: TRzSplitter;
    Panel4: TPanel;
    Panel5: TPanel;
    btnSave: TRzBitBtn;
    btnExit: TRzBitBtn;
    btnUse: TRzBitBtn;
    rzbFilter: TCheckBox;
    comboxVisible: TRzComboBox;
    clrbxColColor: TColorBox;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure dbgrdMainChangeColumn(Sender: TObject; Node: TdxTreeListNode;
      Column: Integer);
    procedure dbgrdMainChangedColumnsWidth(Sender: TObject);
    procedure dbgrdMainColumnMoved(Sender: TObject; FromIndex,
      ToIndex: Integer);
    procedure dbgrdMainEdited(Sender: TObject; Node: TdxTreeListNode);
    procedure dbgrdMainColumnClick(Sender: TObject;
      Column: TdxDBTreeListColumn);
    procedure dbgrdMainDblClick(Sender: TObject);
    procedure dbgrdMainClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnUseClick(Sender: TObject);
    procedure rzbFilterClick(Sender: TObject);
    procedure dbgrdMainCustomDrawCell(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; ANode: TdxTreeListNode; AColumn: TdxTreeListColumn;
      ASelected, AFocused, ANewItemRow: Boolean; var AText: String;
      var AColor: TColor; AFont: TFont; var AAlignment: TAlignment;
      var ADone: Boolean);
    procedure comboxVisibleChange(Sender: TObject);
    procedure clrbxColColorChange(Sender: TObject);
    procedure ComboBoxEnter(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    { Private declarations }
    gv_sSql
    ,gv_sFieldNameSql
    ,gv_sFieldCaptionSql
    ,gv_sFieldIndexSql
    ,gv_sFieldWidthSql
    ,gv_sFieldVisibleSql
    ,gv_sFieldFontColorSql
    :string;
    gv_sMessage:string;
    gv_odm:Tdm;
    gv_iColumnIndex:integer;
    gv_oObject : TComponent;
    gv_sDllName,gv_sFormName,gv_sControlName,gv_sCzyh,gv_sReSultMasterXH:string;
    gv_rMasterTable:MasterTable;
    gv_rControlObject:TControlObject;
  public
    { Public declarations }
    procedure OnBandClick(Sender: TObject;band:TdxTreeListBand);
    procedure FilterProperty;//筛选属性
    procedure UpdateDxdbgrid;//根据选择更新TdxDbGrid
    function ConvertObjectToRecord(_oObject:TComponent):Boolean;//将传入的对象属性保存到记录中
    function GetMasterTable(ErrMsg:string):Boolean;//获取主配置表表属性
    procedure UseForControl(_oObject:TComponent);//将配置表的设置赋值给控件
  end;
  function pSettingDisplay(const _oObject : TComponent;_sDllName,_sFormName,_sControlName,_sCzyh:string;_sInXml:widestring;out _sOutXml:widestring;_bDesigner:Boolean=true):string;StdCall;
  //procedure pSettingDisplay(const _oObject : TComponent);
var
  frmMain: TfrmMain;
implementation
{$R *.dfm}

{$IFDEF MSWINDOWS}
    //ShowMessage('Windows');
    //请在Linux环境下编译！
{$ENDIF}

{$IFDEF LINUX}
    //ShowMessage('Linux');
    请在windows环境下编译！
{$ENDIF}

//{$WARN PACKAGE_NO_LINK ON}
//{$WARN PACKAGED_THREADVAR ON}

//{$DCC -IC:\DELPHI -DDEBUG SORTNAME -$R- -$U+}

{$IFDEF PACKAGE_NO_LINK}
{$ENDIF}
//{$LU+}
//{$Use packages (-LU) option}
//{$-LU}
{$IFDEF dcc32 [options] filename [options]}
{$ENDIF}

function pSettingDisplay(const _oObject : TComponent;_sDllName,_sFormName,_sControlName,_sCzyh:string;_sInXml:widestring;out _sOutXml:widestring;_bDesigner:Boolean):string;
//procedure pSettingDisplay(const _oObject : TComponent);
begin
    frmMain := TfrmMain.Create(nil);
    with frmMain do
    begin
        gv_oObject := _oObject;
        gv_sDllName := _sDllName;
        gv_sFormName := _sFormName;
        gv_sControlName := _sControlName;
        gv_sCzyh := _sCzyh;

        if (gv_oObject=nil) or (gv_sDllName='') or (gv_sFormName='') or (gv_sControlName='') then
            dm.ShowErr('入参不符合规范!')
        else
        begin
            if _bDesigner then
            begin
                btnUse.Enabled := false;
                ShowModal;
            end
            else
            begin
                btnUse.Click;
            end;
        end;
        result := gv_sReSultMasterXH;
        Free;
    end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
    i:integer;
begin
    if not ConvertObjectToRecord(gv_oObject) then
    begin
        gv_odm.ShowErr('将传入的对象转换为记录时出错！');
        exit;
    end;

    //for i := 0 to pred(TdxDBGrid(gv_oObject).ColumnCount) do
    for i := 0 to pred(gv_rControlObject.iColumnCount) do
    begin
        gv_sFieldNameSql := format('%sconvert(varchar(100),%s) as %s,',[
            gv_sFieldNameSql
            ,quotedstr(gv_rControlObject.oColumns[i].sFieldName)
            ,quotedstr(gv_rControlObject.oColumns[i].sFieldName)
        ]);
        gv_sFieldCaptionSql := format('%s%s,',[
            gv_sFieldCaptionSql
            ,quotedstr(gv_rControlObject.oColumns[i].sCaption)
        ]);
        gv_sFieldIndexSql := format('%s%s,',[
            gv_sFieldIndexSql
            ,quotedstr(IntToStr(gv_rControlObject.oColumns[i].iIndex))
        ]);
        gv_sFieldWidthSql := format('%s%s,',[
            gv_sFieldWidthSql
            ,quotedstr(IntToStr(gv_rControlObject.oColumns[i].iWidth))
        ]);
        gv_sFieldVisibleSql := format('%s%s,',[
            gv_sFieldVisibleSql
            ,quotedstr(IfThen(gv_rControlObject.oColumns[i].bVisible, 'true','false'))
        ]);
        gv_sFieldFontColorSql := format('%s%s,',[
            gv_sFieldFontColorSql
            ,quotedstr(ColorToString(gv_rControlObject.oColumns[i].cFontColor))
        ]);

    end;
    gv_sFieldNameSql := format(' select %s%s as 字段说明 ',[gv_sFieldNameSql,quotedstr(gc_sFieldName)]);
    gv_sFieldCaptionSql := format(' union all select %s%s',[gv_sFieldCaptionSql,quotedstr(gc_sCaptionName)]);
    gv_sFieldIndexSql := format(' union all select %s%s',[gv_sFieldIndexSql,quotedstr(gc_sIndexName)]);
    gv_sFieldWidthSql := format(' union all select %s%s',[gv_sFieldWidthSql,quotedstr(gc_sWidthName)]);
    gv_sFieldVisibleSql  := format(' union all select %s%s',[gv_sFieldVisibleSql,quotedstr(gc_sVisibleName)]);
    gv_sFieldFontColorSql := format(' union all select %s%s',[gv_sFieldFontColorSql,quotedstr(gc_sFontColorName)]);

    gv_sSql := format('%s%s%s%s%s%s',[gv_sFieldNameSql
    ,gv_sFieldCaptionSql
    ,''//index通过拖拽来调整//gv_sFieldIndexSql
    ,gv_sFieldWidthSql
    ,gv_sFieldVisibleSql
    ,gv_sFieldFontColorSql
    ]);
    gv_odm.FCdsOpen(gv_sSql,gv_sMessage,cdsFields);

    //设置一下dbgrdMain的相关属性
    with dbgrdMain do
    begin
        DefaultFields := true;
        Font.Size := 12;//字体大小
        HeaderFont.Size := 12;//标题字体大小
        BandFont.Size := 12;//Band字体大小
        ShowHeader := true;//展示列名
        ShowBands := true;//展示Band
        BandRowCount :=1;//Band占1行
        Bands[0].Caption := '业务字段(拖拽可修改列宽和位置)';
        with Bands.Add do
        begin
            Caption := '☆☆☆';
            Fixed := bfLeft;//靠左侧显示
            Columns[pred(ColumnCount)].BandIndex := Index;//指定Band索引
            Columns[pred(ColumnCount)].ReadOnly := true;//只读
            DisableDragging := true;//不可拖动
            OnlyOwnColumns := true;//不可接受其他的列
            //OnClick := OnBandClick;
        end;
        Options := Options+ [egoColumnMoving//可移动
                            ,egoColumnSizing//可调整列宽
                            ,egoEditing//可编辑
                            ];
        //KeyField := '字段说明';
        //OptionsDB := OptionsDB+[edgoLoadAllRecords];
        ApplyBestFit(nil);
    end;

    //根据实际的列宽来给单元格赋值
    with cdsFields do
    begin
        if (Active) and (not IsEmpty) then
        begin
            for i:= 0 to pred(dbgrdMain.ColumnCount) do
            begin
                if dbgrdMain.Columns[i].Caption<>'字段说明' then
                begin
                    //列宽
                    if Locate('字段说明',gc_sWidthName,[]) then
                        dbgrdMain.Columns[i].Width := FieldByName(dbgrdMain.Columns[i].FieldName).Value;
                    //标题
                    if Locate('字段说明',gc_sCaptionName,[]) then
                        dbgrdMain.Columns[i].Caption := FieldByName(dbgrdMain.Columns[i].FieldName).value;
                    //字体颜色
                    if Locate('字段说明',gc_sFontColorName,[]) then
                        dbgrdMain.Columns[i].Font.Color := StringToColor(FieldByName(dbgrdMain.Columns[i].FieldName).value);
                end;
            end;
            First;
        end;
    end;
    //如果存在已配置的数据，则根据配置数据显示
    UseForControl(dbgrdMain);
    //绑定属性控件
    dxrtnspctr1.InspectedObject := dbgrdMain;
    PanelControlName.Caption := format('表：%s',[dbgrdMain.Name]);
    FilterProperty;
end;
function TfrmMain.ConvertObjectToRecord(_oObject:TComponent):Boolean;
var
    i:integer;
begin
    result := false;
    with gv_rControlObject do
    begin
        oObject := _oObject;

        if _oObject is TdxDBGrid then
        begin

            iColumnCount := TdxDBGrid(_oObject).ColumnCount;
            cColor := TdxDBGrid(_oObject).Color;
            cFontColor := TdxDBGrid(_oObject).Font.Color;
            cGridLineColor := TdxDBGrid(_oObject).GridLineColor;
            sBorderStyle := GetPropValue(TdxDBGrid(_oObject),'BorderStyle');
            bShowGroupPanel := TdxDBGrid(_oObject).ShowGroupPanel;
            cGroupPanelColor := TdxDBGrid(_oObject).GroupPanelColor;
            cGroupPanelFontColor := TdxDBGrid(_oObject).GroupPanelFontColor;
            cHeaderColor := TdxDBGrid(_oObject).HeaderColor;
            cHeaderFontFolor := TdxDBGrid(_oObject).HeaderFont.Color;
            bShowHint := TdxDBGrid(_oObject).ShowHint;
            sHint := TdxDBGrid(_oObject).Hint;
            iFontSize := TdxDBGrid(_oObject).Font.Size;
            iHeaderFontSize := TdxDBGrid(_oObject).HeaderFont.Size;

            setlength(oColumns,iColumnCount);
            for i:=0 to pred(iColumnCount) do
            begin
                with TdxDBGrid(_oObject).Columns[i] do
                begin
                    oColumns[i].oColumn := TdxDBGrid(_oObject).Columns[i];
                    oColumns[i].sFieldName := FieldName;
                    oColumns[i].sCaption := Caption;
                    oColumns[i].iIndex := Index;
                    oColumns[i].iWidth := Width;
                    oColumns[i].cColor := Color;
                    oColumns[i].cFontColor := Font.Color;
                    oColumns[i].bDisableEditor := DisableEditor;
                    oColumns[i].sAlignment := GetPropValue(TdxDBGrid(_oObject).Columns[i],'Alignment');
                    oColumns[i].sHeaderAlignment := GetPropValue(TdxDBGrid(_oObject).Columns[i],'HeaderAlignment');
                    oColumns[i].bVisible := Visible;
                end;
            end;
        end
        else if _oObject is TDBGrid then
        begin
            iColumnCount := TDBGrid(_oObject).Columns.Count;
            cColor := TDBGrid(_oObject).Color;
            cFontColor := TDBGrid(_oObject).Font.Color;
            //cGridLineColor := TDBGrid(_oObject).GridLineColor;
            sBorderStyle := GetPropValue(TDBGrid(_oObject),'BorderStyle');
            //bShowGroupPanel := TDBGrid(_oObject).ShowGroupPanel;
            //cGroupPanelColor := TDBGrid(_oObject).GroupPanelColor;
            //cGroupPanelFontColor := TDBGrid(_oObject).GroupPanelFontColor;
            //cHeaderColor := GetPropValue(TDBGrid(_oObject).Title,'Color');
            cHeaderFontFolor := TDBGrid(_oObject).TitleFont.Color;
            bShowHint := TDBGrid(_oObject).ShowHint;
            sHint := TDBGrid(_oObject).Hint;
            iFontSize := TDBGrid(_oObject).Font.Size;
            iHeaderFontSize := TDBGrid(_oObject).TitleFont.Size;

            setlength(oColumns,iColumnCount);
            for i:=0 to pred(iColumnCount) do
            begin
                with TDBGrid(_oObject).Columns[i] do
                begin
                    oColumns[i].oColumn := TDBGrid(_oObject).Columns[i];
                    oColumns[i].sFieldName := FieldName;
                    oColumns[i].sCaption := TDBGrid(_oObject).Columns[i].Title.Caption;
                    oColumns[i].iIndex := Index;
                    oColumns[i].iWidth := Width;
                    oColumns[i].cColor := Color;
                    oColumns[i].cFontColor := Font.Color;
                    oColumns[i].bDisableEditor := true;
                    oColumns[i].sAlignment := GetPropValue(TDBGrid(_oObject).Columns[i],'Alignment');
                    oColumns[i].sHeaderAlignment := GetPropValue(TDBGrid(_oObject).Columns[i].Title,'Alignment');
                    oColumns[i].bVisible := Visible;
                end;
            end;
        end
        else
            iColumnCount := 1;
    end;
    result := true;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    gv_odm := Tdm.Create(nil);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
    gv_odm.Destroy;
end;
procedure TfrmMain.dbgrdMainChangeColumn(Sender: TObject;
  Node: TdxTreeListNode; Column: Integer);
begin
    gv_iColumnIndex := Column-1;
end;
procedure TfrmMain.dbgrdMainChangedColumnsWidth(Sender: TObject);
var
    i:integer;
begin
    with dbgrdMain.DataSource.DataSet do
    begin
        if Locate('字段说明',gc_sWidthName,[]) then
        begin
            DisableControls;
            Edit;
            //FieldByName(dbgrdMain.Columns[dbgrdMain.FocusedColumn].FieldName).Value := dbgrdMain.Columns[dbgrdMain.FocusedColumn].Width;
            for i:= 0 to pred(dbgrdMain.ColumnCount) do
            begin
                if dbgrdMain.Columns[i].Caption<>'字段说明' then
                    FieldByName(dbgrdMain.Columns[i].FieldName).Value := dbgrdMain.Columns[i].Width;
            end;
            Post;
            EnableControls;
        end;
    end;
end;
procedure TfrmMain.dbgrdMainColumnMoved(Sender: TObject; FromIndex,
  ToIndex: Integer);
begin
//    showmessage('3');
end;
procedure TfrmMain.dbgrdMainEdited(Sender: TObject; Node: TdxTreeListNode);
begin
    if not (dbgrdMain.DataSource.DataSet.State in [dsInsert,dsEdit]) then Exit;
     //dbgrdMain.FocusedField.OldValue;//旧值
     //dbgrdMain.FocusedField.NewValue;//新值
     //showmessage(inttostr(dbgrdMain.FocusedField.Index));
     //dbgrdMain.FocusedField.Index;//X坐标
     //(Sender as TdxDBGrid).FocusedColumn-1;//X坐标
     //Node.Index;//Y坐标
     with dbgrdMain.FocusedField do
     begin
         if Node.Strings[pred(dbgrdMain.ColumnCount)]=gc_sCaptionName then//Caption
         begin
             dbgrdMain.FindColumnByFieldName(FieldName).Caption := NewValue;
         end
         else if Node.Strings[pred(dbgrdMain.ColumnCount)]=gc_sIndexName then//Index
         begin
             Text := OldValue;
             ShowMessage('索引序列请使用鼠标拖动列标题进行调整!');
             Exit;
             if StrToIntDef(NewValue,-1)<0 then
             begin
                 Text := OldValue;
                 ShowMessage('请输入大于0的有效数值!');
                 Exit;
             end;
             dbgrdMain.FindColumnByFieldName(FieldName).Index := NewValue
         end
         else if Node.Strings[pred(dbgrdMain.ColumnCount)]=gc_sWidthName then//Width
         begin
             if (StrToIntDef(NewValue,-1)<0) or (StrToIntDef(NewValue,-1)>500) then
             begin
                 Text := OldValue;
                 ShowMessage('请输入大于0小于500的有效数值!');
                 Exit;
             end;
             dbgrdMain.FindColumnByFieldName(FieldName).Width := NewValue
         end
         else if Node.Strings[pred(dbgrdMain.ColumnCount)]=gc_sFieldName then//Field
         begin
             Text := OldValue;
             //ShowMessage(format('%s不允许修改！',[gc_sFieldName]));
             Exit;
         end
         else if Node.Strings[pred(dbgrdMain.ColumnCount)]=gc_sVisibleName then//Visible 
         begin
             if (LowerCase(NewValue)<>'true') or (LowerCase(NewValue)<>'false') then
             begin
                 Text := OldValue;
                 ShowMessage('请输入有效值[true/false],或者双击修改!');
                 Exit;
             end;
             dbgrdMain.FindColumnByFieldName(FieldName).Width := NewValue
         end
         else
         begin
             Text := OldValue;
             Exit;
         end
     end;
end;
procedure TfrmMain.dbgrdMainColumnClick(Sender: TObject;
  Column: TdxDBTreeListColumn);
var
    i:integer;
begin
    if Column.Caption = '字段说明' then
    begin
        dxrtnspctr1.InspectedObject := nil;
        PanelControlName.Caption := '';
        rzspltr1.Percent := 100;
    end
    else
    begin
        dxrtnspctr1.InspectedObject := Column;
        PanelControlName.Caption := format('字段：%s',[Column.Caption]);
        rzspltr1.Percent := StrToIntDef(IfThen(rzspltr1.Percent=100,'75',inttostr(rzspltr1.Percent)),75);
    end;

    FilterProperty;
end;

procedure TfrmMain.dbgrdMainDblClick(Sender: TObject);
begin
    with dbgrdMain.DataSource.DataSet do
    begin
        if (FieldByName('字段说明').AsString=gc_sVisibleName)
        and (dbgrdMain.FocusedField.Text<>gc_sVisibleName) then
        begin
            DisableControls;
            Edit;
            dbgrdMain.FocusedField.Text := IfThen(dbgrdMain.FocusedField.Text='true', 'false','true');
            Post;
            EnableControls;
        end;
    end;
end;

procedure TfrmMain.OnBandClick(Sender: TObject;band:TdxTreeListBand);
begin
    PanelControlName.Caption := format('test：%s',['123']);
end;

procedure TfrmMain.dbgrdMainClick(Sender: TObject);
begin
    dxrtnspctr1.InspectedObject := dbgrdMain;
    PanelControlName.Caption := format('表：%s',[dbgrdMain.Name]);
    rzspltr1.Percent := StrToIntDef(IfThen(rzspltr1.Percent=100,'75',inttostr(rzspltr1.Percent)),75);
    FilterProperty;       
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
    Close;
end;

procedure TfrmMain.btnUseClick(Sender: TObject);
begin
    UseForControl(gv_oObject);
end;
procedure TfrmMain.UseForControl(_oObject:TComponent);
var
    i:integer;
begin
    //====================主表========================
    with gv_rMasterTable do
    begin
        if not GetMasterTable(gv_sMessage) then
        begin
            gv_odm.ShowErr(gv_sMessage);
            exit;
        end;
        if gv_sMessage='无记录' then exit;

        //Color
        if IsPublishedProp(_oObject,'Color') then
            SetPropValue(_oObject,'Color',StringToColor(color));
        //GridLineColor
        if IsPublishedProp(_oObject,'GridLineColor') then
            SetPropValue(_oObject,'GridLineColor',StringToColor(gridlinecolor));
        //BorderStyle
        if IsPublishedProp(_oObject,'BorderStyle') then
            SetPropValue(_oObject,'BorderStyle',borderstyle);
        //ShowGroupPanel
        if IsPublishedProp(_oObject,'ShowGroupPanel') then
            SetPropValue(_oObject,'ShowGroupPanel',showgrouppanel='1');
        //GroupPanelColor
        if IsPublishedProp(_oObject,'GroupPanelColor') then
            SetPropValue(_oObject,'GroupPanelColor',StringToColor(grouppanelcolor));
        //GroupPanelFontColor
        if IsPublishedProp(_oObject,'GroupPanelFontColor') then
            SetPropValue(_oObject,'GroupPanelFontColor',StringToColor(grouppanelfontcolor));
        //HeaderColor
        if IsPublishedProp(_oObject,'HeaderColor') then
            SetPropValue(_oObject,'HeaderColor',StringToColor(headercolor));
        //ShowHint
        if IsPublishedProp(_oObject,'ShowHint') then
            SetPropValue(_oObject,'ShowHint',showhint='1');
        //Hint
        if IsPublishedProp(_oObject,'Hint') then
            SetPropValue(_oObject,'Hint',hint);
        if _oObject is TdxDBGrid then
        begin
            //Font.Color
            if IsPublishedProp(TdxDBGrid(_oObject).Font,'Color') then
                SetPropValue(TdxDBGrid(_oObject).Font,'Color',StringToColor(fontcolor));
            //HeaderFont.Color
            if IsPublishedProp(TdxDBGrid(_oObject).HeaderFont,'Color') then
                SetPropValue(TdxDBGrid(_oObject).HeaderFont,'Color',StringToColor(headerfontcolor));
            //Font.Size
            if IsPublishedProp(TdxDBGrid(_oObject).Font,'Size') then
                SetPropValue(TdxDBGrid(_oObject).Font,'Size',fontsize);
            //HeaderFont.Size
            if IsPublishedProp(TdxDBGrid(_oObject).HeaderFont,'Size') then
                SetPropValue(TdxDBGrid(_oObject).HeaderFont,'Size',headerfontsize);
        end;
        if _oObject is TDBGrid then
        begin
            //Font.Color
            if IsPublishedProp(TDBGrid(_oObject).Font,'Color') then
                SetPropValue(TDBGrid(_oObject).Font,'Color',StringToColor(fontcolor));
            //HeaderFont.Color
            if IsPublishedProp(TDBGrid(_oObject).TitleFont,'Color') then
                SetPropValue(TDBGrid(_oObject).TitleFont,'Color',StringToColor(headerfontcolor));
            //Font.Size
            if IsPublishedProp(TDBGrid(_oObject).Font,'Size') then
                SetPropValue(TDBGrid(_oObject).Font,'Size',fontsize);
            //HeaderFont.Size
            if IsPublishedProp(TDBGrid(_oObject).TitleFont,'Size') then
                SetPropValue(TDBGrid(_oObject).TitleFont,'Size',headerfontsize);
        end;
    end;
    //================明细==========================
    gv_sSql := format(' select fieldname,caption,fieldwidth,fieldindex '//0-3
              +' ,fieldvisible,color,fontcolor,disableediter,alignment,headeralignment '//4-9
              +' from YY_TABLE_DISPLAY_DETAIL (nolock) where masterxh=%s '//1%s
              ,[quotedstr(gv_sReSultMasterXH)]);
    if not gv_odm.FCdsOpen(gv_sSql,gv_sMessage) then
    begin
        gv_odm.ShowErr(gv_sMessage);
        exit;
    end;
    //赋值
    if _oObject is TdxDBGrid then
    begin
        for i := 0 to pred(TdxDBGrid(_oObject).ColumnCount) do
        begin
            if not gv_odm.cdsTemp.Locate('fieldname',TdxDBGrid(_oObject).Columns[i].FieldName,[]) then continue;
            //Caption
            TdxDBGrid(_oObject).Columns[i].Caption := gv_odm.cdsTemp.fieldbyname('caption').AsString;
            //Index
            TdxDBGrid(_oObject).Columns[i].Index := gv_odm.cdsTemp.fieldbyname('fieldindex').AsInteger;
            //Width
            TdxDBGrid(_oObject).Columns[i].Width := gv_odm.cdsTemp.fieldbyname('fieldwidth').AsInteger;
            //Color
            TdxDBGrid(_oObject).Columns[i].Color := StringToColor(gv_odm.cdsTemp.fieldbyname('color').AsString);
            //FontColor
            TdxDBGrid(_oObject).Columns[i].Font.Color := StringToColor(gv_odm.cdsTemp.fieldbyname('fontcolor').AsString);
            //Visible
            TdxDBGrid(_oObject).Columns[i].Visible := gv_odm.cdsTemp.fieldbyname('fieldvisible').AsString='1';
            //disableediter
            TdxDBGrid(_oObject).Columns[i].DisableEditor := gv_odm.cdsTemp.fieldbyname('disableediter').AsString='1';
            //alignment
            if IsPublishedProp(TdxDBGrid(_oObject).Columns[i],'Alignment') then
                SetPropValue(TdxDBGrid(_oObject).Columns[i],'Alignment',gv_odm.cdsTemp.fieldbyname('alignment').AsString);
            //headeralignment
            if IsPublishedProp(TdxDBGrid(_oObject).Columns[i],'HeaderAlignment') then
                SetPropValue(TdxDBGrid(_oObject).Columns[i],'HeaderAlignment',gv_odm.cdsTemp.fieldbyname('headeralignment').AsString);
        end;
    end
    else if _oObject is TDBGrid then
    begin
        for i := 0 to pred(TDBGrid(_oObject).Columns.Count) do
        begin
            if not gv_odm.cdsTemp.Locate('fieldname',TDBGrid(_oObject).Columns[i].FieldName,[]) then continue;
            //Caption
            TDBGrid(_oObject).Columns[i].Title.Caption := gv_odm.cdsTemp.fieldbyname('caption').AsString;
            //Index
            TDBGrid(_oObject).Columns[i].Index := gv_odm.cdsTemp.fieldbyname('fieldindex').AsInteger;
            //Width
            TDBGrid(_oObject).Columns[i].Width := gv_odm.cdsTemp.fieldbyname('fieldwidth').AsInteger;
            //Color
            TDBGrid(_oObject).Columns[i].Color := StringToColor(gv_odm.cdsTemp.fieldbyname('color').AsString);
            //FontColor
            TDBGrid(_oObject).Columns[i].Font.Color := StringToColor(gv_odm.cdsTemp.fieldbyname('fontcolor').AsString);
            //Visible
            TDBGrid(_oObject).Columns[i].Visible := gv_odm.cdsTemp.fieldbyname('fieldvisible').AsString='1';
            //disableediter
            //TDBGrid(gv_oObject).Columns[i].DisableEditor := gv_odm.cdsTemp.fieldbyname('disableediter').AsString='1';
            //alignment
            if IsPublishedProp(TDBGrid(_oObject).Columns[i],'Alignment') then
                SetPropValue(TDBGrid(_oObject).Columns[i],'Alignment',gv_odm.cdsTemp.fieldbyname('alignment').AsString);
            //headeralignment
            if IsPublishedProp(TDBGrid(_oObject).Columns[i].Title,'Alignment') then
                SetPropValue(TDBGrid(_oObject).Columns[i].Title,'Alignment',gv_odm.cdsTemp.fieldbyname('headeralignment').AsString);
        end;
    end;
    //dbgrdMain.SaveToIniFile('C:\123.ini');
    Close;
end;

function TfrmMain.GetMasterTable(ErrMsg:string):Boolean;
begin
    result := false;
    with gv_rMasterTable do
    begin
        gv_sSql := format(' select xh,color,fontcolor,gridlinecolor,borderstyle '//0-4
                  +' ,showgrouppanel,grouppanelcolor,grouppanelfontcolor,headercolor,headerfontcolor,showhint,hint '//5-11
                  +' ,fontsize,headerfontsize '//12-13
                  +' from YY_TABLE_DISPLAY (nolock) where czyh=%s and dllname=%s and formname=%s and controlname=%s '//1-4%s
                  //+' if @@error<>0 select "F","查询失败！" '
                  //+' else if @@rowcount=0 select "R","无记录" '
                  //+' else select "T",sql '
                  ,[
                  //select parameter
                  quotedstr(gv_sCzyh)
                  ,quotedstr(gv_sDllName)
                  ,quotedstr(gv_sFormName)
                  ,quotedstr(gv_sControlName)
                  ]);
        if not gv_odm.Fztsql(gv_sSql,ErrMsg,0) then
        begin
            //gv_odm.ShowErr(gv_sMessage);
            exit;
        end;
        if gv_odm.ztsql.eof then
        begin
            ErrMsg := '无记录';
            result := true;
            exit;
        end;
        gv_sReSultMasterXH := gv_odm.ztsql.sqldata(0);
        color := gv_odm.ztsql.sqldata(1);
        fontcolor := gv_odm.ztsql.sqldata(2);
        gridlinecolor := gv_odm.ztsql.sqldata(3);
        borderstyle := gv_odm.ztsql.sqldata(4);
        showgrouppanel := gv_odm.ztsql.sqldata(5);
        grouppanelcolor := gv_odm.ztsql.sqldata(6);
        grouppanelfontcolor := gv_odm.ztsql.sqldata(7);
        headercolor := gv_odm.ztsql.sqldata(8);
        headerfontcolor := gv_odm.ztsql.sqldata(9);
        showhint := gv_odm.ztsql.sqldata(10);
        hint := gv_odm.ztsql.sqldata(11);
        fontsize := StrToIntDef(gv_odm.ztsql.sqldata(12),12);
        headerfontsize := StrToIntDef(gv_odm.ztsql.sqldata(13),12);
    end;
    result := true;
end;

procedure TfrmMain.rzbFilterClick(Sender: TObject);
var
    pv_oObject:TObject;
begin
    //赋空重新绑定，否则属性无法分组显示
    pv_oObject := dxrtnspctr1.InspectedObject;
    dxrtnspctr1.InspectedObject := nil;
    dxrtnspctr1.InspectedObject := pv_oObject as TPersistent;
    FilterProperty;
end;

procedure TfrmMain.FilterProperty;
var
    i:integer;
begin
    with dxrtnspctr1 do
    begin
        if dxrtnspctr1.InspectedObject is TdxDBTreeListColumn then
        begin
            for i:=0 to pred(TotalRowCount) do
            begin
                if ((Rows[i].Caption = 'Color')
                   or (Rows[i].Caption = 'Alignment')
                   //or (Rows[i].Caption = 'CharCase')
                   or (Rows[i].Caption = 'DisableEditor')
                   or (Rows[i].Caption = 'Font')
                   or (Rows[i].Caption = 'Size')
                   or ((Rows[i].Caption = 'Name') and ((Rows[i].Node<>nil) and (Rows[i].Node.Level=1)))//控件的Nane不显示
                   or (Rows[i].Caption = 'HeaderAlignment')
                   or (Rows[i].Caption = 'ColIndex')
                   //or (Rows[i].Caption = 'Visible')
                   //or (Rows[i].Caption = 'Caption')
                   //or (Rows[i].Caption = 'Width')
                   )
                   then
                begin
                    Rows[i].Visible := True;
                end
                else
                begin
                    Rows[i].Visible := rzbFilter.Checked;
                end;
            end;
        end;
        if dxrtnspctr1.InspectedObject is TdxDBGrid then
        begin
            for i:=0 to pred(TotalRowCount) do
            begin
                if ((Rows[i].Caption = 'Color')
                    or (Rows[i].Caption = 'GridLineColor')
                    or (Rows[i].Caption = 'Font')
                    or (Rows[i].Caption = 'HeaderColor')
                    or (Rows[i].Caption = 'HeardFont')
                    or (Rows[i].Caption = 'Hint')
                    or (Rows[i].Caption = 'ShowHint')
                    //or (Rows[i].Caption = 'ShowBands')
                    or (Rows[i].Caption = 'ShowHeader')
                    or (Rows[i].Caption = 'ShowGroupPanel')
                    or (Rows[i].Caption = 'GroupPanelColor')
                    or (Rows[i].Caption = 'GroupPanelFontColor')
                    or (Rows[i].Caption = 'BorderStyle')
                    or (Rows[i].Caption = 'BandMaxRowCount')
                    or (Rows[i].Caption = 'BandRowCount')
                    or (Rows[i].Caption = 'BandColor')
                    or (Rows[i].Caption = 'BandFont')
                    or (Rows[i].Caption = 'HeaderFont')
                    or (Rows[i].Caption = 'Size')
                    //or (Rows[i].Caption = 'PreviewFont')
                   ) then
                begin
                    Rows[i].Visible := true;
                end
                else
                begin
                    Rows[i].Visible := rzbFilter.Checked;
                end;

                if Rows[i].Caption = 'Color' then
                begin
                    //if (Rows[i].Node<>nil) and (Rows[i].Node.Level>0) and (not Rows[i].Node.Parent.IsVisible) then
                    //    Rows[i].Visible := false;
                    //PreviewFont的Color无需显示
                    if dxrtnspctr1.IndexOf(Rows[i].Node) in [17,41] then Rows[i].Visible := false;
                end;
            end;
        end;
    end;
end;

procedure TfrmMain.dbgrdMainCustomDrawCell(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; ANode: TdxTreeListNode;
  AColumn: TdxTreeListColumn; ASelected, AFocused, ANewItemRow: Boolean;
  var AText: String; var AColor: TColor; AFont: TFont;
  var AAlignment: TAlignment; var ADone: Boolean);
var
    r: trect;
begin
    r := dbgrdMain.ClientRect;
    if AFocused then
    begin
        if (r.bottom < ARect.bottom) then exit;

        comboxVisible.Visible := false;
        clrbxColColor.Visible := false;

        //是否可见
        if (cdsFields.FieldByName('字段说明').AsString=gc_sVisibleName)
        and (dbgrdMain.FocusedField.Text<>gc_sVisibleName) then
        begin
            comboxVisible.Top := ARect.top + 2;
            comboxVisible.Left := ARect.left + 2;
            comboxVisible.Width := ARect.Right - ARect.left;
            comboxVisible.Height := ARect.Bottom - ARect.Top;
            comboxVisible.Visible := True;
            if comboxVisible.Visible then
            begin
                comboxVisible.ItemIndex := comboxVisible.IndexOf(dbgrdMain.FocusedField.Text);
                comboxVisible.SetFocus;
            end;
        end;
        //字体颜色
        if (cdsFields.FieldByName('字段说明').AsString=gc_sFontColorName)
        and (dbgrdMain.FocusedField.Text<>gc_sFontColorName) then
        begin
            clrbxColColor.Top := ARect.top + 2;
            clrbxColColor.Left := ARect.left + 2;
            clrbxColColor.Width := ARect.Right - ARect.left;
            clrbxColColor.Height := ARect.Bottom - ARect.Top;
            clrbxColColor.Visible := True;
            if clrbxColColor.Visible then
            begin
                clrbxColColor.ItemIndex := clrbxColColor.Items.IndexOf(dbgrdMain.FocusedField.Text);
                clrbxColColor.SetFocus;
            end;
        end;
    end;
end;

procedure TfrmMain.comboxVisibleChange(Sender: TObject);
begin
    UpdateDxdbgrid;
end;

procedure TfrmMain.clrbxColColorChange(Sender: TObject);
begin
    UpdateDxdbgrid;
end;

procedure TfrmMain.UpdateDxdbgrid;
begin
    with dbgrdMain.DataSource.DataSet do
    begin
        DisableControls;
        Edit;
        //是否可见
        if (FieldByName('字段说明').AsString=gc_sVisibleName)
        and (dbgrdMain.FocusedField.Text<>gc_sVisibleName) then
        begin
            dbgrdMain.FocusedField.Text := comboxVisible.Text;
        end;
        //字体颜色
        if (FieldByName('字段说明').AsString=gc_sFontColorName)
        and (dbgrdMain.FocusedField.Text<>gc_sFontColorName) then
        begin
            dbgrdMain.FocusedField.Text := ColorToString(clrbxColColor.Selected);
            dbgrdMain.ColumnByFieldName(dbgrdMain.FocusedField.FieldName).Font.Color := clrbxColColor.Selected;
        end;
        Post;
        EnableControls;
    end;
end;

procedure TfrmMain.ComboBoxEnter(Sender: TObject);
var
    i,pv_iMaxWidth:integer;
begin
    if Sender is TColorBox then
    begin
        pv_iMaxWidth := TColorBox(Sender).Width;
        for i := 0 to TColorBox(Sender).Items.Count - 1 do
        begin
            //设置控件下拉框的宽度自适应(根据像素比较)
            Canvas.Font.Size := 14;//经试验字体设置为14，刚刚好完全显示，但是ComBobox的Font.size = 12
            if pv_iMaxWidth < Canvas.TextWidth(TColorBox(Sender).Items.Strings[i]) then
            begin
                pv_iMaxWidth := Canvas.TextWidth(TColorBox(Sender).Items.Strings[i]);
                //第一个参数是下拉框组件的句柄,第二个参数是要发送的消息,第三个参数是要设定的宽度,第四个参数未使用
                SendMessage(TColorBox(Sender).Handle, CB_SETDROPPEDWIDTH, pv_iMaxWidth, 0);
            end;
        end;
    end
    else if Sender is TRzComboBox then
    begin
        pv_iMaxWidth := TRzComboBox(Sender).Width;
        for i := 0 to TRzComboBox(Sender).Items.Count - 1 do
        begin
            //设置控件下拉框的宽度自适应(根据像素比较)
            Canvas.Font.Size := 14;//经试验字体设置为14，刚刚好完全显示，但是ComBobox的Font.size = 12
            if pv_iMaxWidth < Canvas.TextWidth(TRzComboBox(Sender).Items.Strings[i]) then
            begin
                pv_iMaxWidth := Canvas.TextWidth(TRzComboBox(Sender).Items.Strings[i]);
                //第一个参数是下拉框组件的句柄,第二个参数是要发送的消息,第三个参数是要设定的宽度,第四个参数未使用
                SendMessage(TRzComboBox(Sender).Handle, CB_SETDROPPEDWIDTH, pv_iMaxWidth, 0);
            end;
        end;
    end;
end;

procedure TfrmMain.btnSaveClick(Sender: TObject);
var
    i:integer;
begin
    //====================主表========================
    with gv_rMasterTable do
    begin
        color := ColorToString(dbgrdMain.Color);
        fontcolor := ColorToString(dbgrdMain.Font.Color);
        gridlinecolor := ColorToString(dbgrdMain.GridLineColor);
        //if IsPublishedProp(dbgrdMain,'BorderStyle') then
        borderstyle := GetPropValue(dbgrdMain,'BorderStyle');
        showgrouppanel := IfThen(dbgrdMain.ShowGroupPanel,'1','0');
        grouppanelcolor := ColorToString(dbgrdMain.GroupPanelColor);
        grouppanelfontcolor := ColorToString(dbgrdMain.GroupPanelFontColor);
        headercolor := ColorToString(dbgrdMain.HeaderColor);
        headerfontcolor := ColorToString(dbgrdMain.HeaderFont.Color);
        showhint := IfThen(dbgrdMain.ShowHint,'1','0');
        hint := dbgrdMain.Hint;
        fontsize :=  dbgrdMain.Font.Size;
        headerfontsize := dbgrdMain.HeaderFont.Size;
        gv_sSql := format('declare @masterxh int '
                  +' select @masterxh=xh from YY_TABLE_DISPLAY where czyh=%s and dllname=%s and formname=%s and controlname=%s '//1-4%s
                  +' if @@rowcount=0 begin'
                  +' insert into YY_TABLE_DISPLAY (czyh,dllname,formname,controlname,color,fontcolor,gridlinecolor,borderstyle '//1-8
                  +' ,showgrouppanel,grouppanelcolor,grouppanelfontcolor,headercolor,headerfontcolor,showhint,hint '//9-15
                  +' ,fontsize,headerfontsize '//16-17
                  +' ) values(%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s) '//5-18%s +2%s
                  +' select @masterxh=scope_identity() end else '
                  +' update YY_TABLE_DISPLAY set color=%s,fontcolor=%s,gridlinecolor=%s,borderstyle=%s '//19-26
                  +' ,showgrouppanel=%s,grouppanelcolor=%s,grouppanelfontcolor=%s,headercolor=%s,headerfontcolor=%s,showhint=%s,hint=%s '//27-33%s
                  +' ,fontsize=%s,headerfontsize=%s '
                  +' where [email protected] '
                  +' if @@error<>0 select "F","保存失败！" else select "T",@masterxh '
                  ,[
                  //select parameter
                  quotedstr(gv_sCzyh)
                  ,quotedstr(gv_sDllName)
                  ,quotedstr(gv_sFormName)
                  ,quotedstr(gv_sControlName)
                  //insert parameter
                  ,quotedstr(gv_sCzyh)
                  ,quotedstr(gv_sDllName)
                  ,quotedstr(gv_sFormName)
                  ,quotedstr(gv_sControlName)
                  ,quotedstr(color)
                  ,quotedstr(fontcolor)
                  ,quotedstr(gridlinecolor)
                  ,quotedstr(borderstyle)
                  ,quotedstr(showgrouppanel)
                  ,quotedstr(grouppanelcolor)
                  ,quotedstr(grouppanelfontcolor)
                  ,quotedstr(headercolor)
                  ,quotedstr(headerfontcolor)
                  ,quotedstr(showhint)
                  ,quotedstr(hint)
                  ,quotedstr(inttostr(fontsize))
                  ,quotedstr(inttostr(headerfontsize))
                  //update parameter
                  ,quotedstr(color)
                  ,quotedstr(fontcolor)
                  ,quotedstr(gridlinecolor)
                  ,quotedstr(borderstyle)
                  ,quotedstr(showgrouppanel)
                  ,quotedstr(grouppanelcolor)
                  ,quotedstr(grouppanelfontcolor)
                  ,quotedstr(headercolor)
                  ,quotedstr(headerfontcolor)
                  ,quotedstr(showhint)
                  ,quotedstr(hint)
                  ,quotedstr(inttostr(fontsize))
                  ,quotedstr(inttostr(headerfontsize))
                  ]);
        if not gv_odm.Fztsql(gv_sSql,gv_sMessage,0) then
        begin
            gv_odm.ShowErr(gv_sMessage);
            exit;
        end;
        gv_sReSultMasterXH := gv_odm.ztsql.sqldata(1);
    end;
    //================明细==========================
    if not cdsFields.Locate('字段说明',gc_sVisibleName,[]) then Exit;

    for i := 0 to pred(dbgrdMain.ColumnCount) do
    begin
        if dbgrdMain.Columns[i].Caption = '字段说明' then continue;
        gv_sSql := format(' update YY_TABLE_DISPLAY_DETAIL set caption=%s,fieldwidth=%s,fieldindex=%s,fieldvisible=%s '//1-4
          +' ,color=%s,fontcolor=%s,disableediter=%s,alignment=%s,headeralignment=%s where masterxh=%s and fieldname=%s '//5-11%s
          +' if @@rowcount=0 '
          +' insert into YY_TABLE_DISPLAY_DETAIL (masterxh,fieldname,caption,fieldwidth,fieldindex '//1-5
          +' ,fieldvisible,color,fontcolor,disableediter,alignment,headeralignment) '//6-11
          +' values(%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s) '//12-22%s
          +' if @@error<>0 select "F","保存失败！" else select "T" '
          ,[
          //update parameter
           quotedstr(dbgrdMain.Columns[i].Caption)
          ,quotedstr(IntToStr(dbgrdMain.Columns[i].Width))
          ,quotedstr(IntToStr(dbgrdMain.Columns[i].Index))
          ,quotedstr(IfThen(dbgrdMain.Columns[i].Visible,'1','0'))
          ,quotedstr(ColorToString(dbgrdMain.Columns[i].Color))
          ,quotedstr(ColorToString(dbgrdMain.Columns[i].Font.Color))
          ,quotedstr(IfThen(dbgrdMain.Columns[i].DisableEditor,'1','0'))
          ,quotedstr(GetPropValue(dbgrdMain.Columns[i],'Alignment'))
          ,quotedstr(GetPropValue(dbgrdMain.Columns[i],'HeaderAlignment'))
          ,quotedstr(gv_sReSultMasterXH)
          ,quotedstr(dbgrdMain.Columns[i].FieldName)
          //insert parameter
          ,quotedstr(gv_sReSultMasterXH)
          ,quotedstr(dbgrdMain.Columns[i].FieldName)
          ,quotedstr(dbgrdMain.Columns[i].Caption)
          ,quotedstr(IntToStr(dbgrdMain.Columns[i].Width))
          ,quotedstr(IntToStr(dbgrdMain.Columns[i].Index))
          ,quotedstr(IfThen(cdsFields.FieldByName(dbgrdMain.Columns[i].FieldName).AsString='true','1','0'))
          ,quotedstr(ColorToString(dbgrdMain.Columns[i].Color))
          ,quotedstr(ColorToString(dbgrdMain.Columns[i].Font.Color))
          ,quotedstr(IfThen(dbgrdMain.Columns[i].DisableEditor,'1','0'))
          ,quotedstr(GetPropValue(dbgrdMain.Columns[i],'Alignment'))
          ,quotedstr(GetPropValue(dbgrdMain.Columns[i],'HeaderAlignment'))
          ]);
        if not gv_odm.Fztsql(gv_sSql,gv_sMessage,0) then
        begin
            gv_odm.ShowErr(gv_sMessage);
            exit;
        end;
    end;
    btnUse.Enabled := true;
    //dbgrdMain.SaveToIniFile('C:\123.ini');
    //Close;
end;

end.

数据库访问端（DAL）：

unit uDM;

interface

uses
  windows,SysUtils, Classes, DB, DBClient, MConnect,forms,Dialogs,dxDBGrid
  ,DBGrids;
const
  ColWidth =100;
type
  TDM = class(TDataModule)
    DCOMConn: TDCOMConnection;
    cds1: TClientDataSet;
    cdsTemp: TClientDataSet;
    cdsGetData: TClientDataSet;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    procedure InitGridColumnWidth(aGrid: TdxDBGrid);

    { Private declarations }
  public
    { Public declarations }
    ztapp, ztsql:variant;
    fLogDir:string;//交易日志
    strsql,errmsg,m_xzdqbm,m_yydm_Fsxnh :string;

    //webservice方式 = wsdl:'http://10.1.1.10:5632/nh_Service.asmx?wsdl',地区编码:210423,用户：jk_nckuser,密码：P72Z09G25H
    web_WSDL,web_dqbm,web_user,web_password,m_WebServerUrl : string;

    procedure WriteLog(logText: string);//写日志
    function FCdsOpen(asql :string;var errmsg :string;PCds:TClientDataSet=nil):Boolean;//执行store proc
    function  Fztsql(asql: string; var Errmsg: string;aFlag: Integer=1): Boolean;//执行ztsql,一般用于执行sql语句,如select,update
    procedure ShowErr(AErrmsg: string);//统一提示框
    function ksdate2date(aKsDate:string):TDateTime;  //20120329 转成 2012-03-29
    function TranslateDate(aKsDate:string):string; //20120329转成 2012年3月29日
    procedure InitGridCol(aGrid:TDBGrid);overload; //初始化DBGrid列宽
    procedure InitGridCol(aGrid:TdxDBGrid);overload;//初始化dxDBGrid列宽
    function CDS2EXCEL(acds :TClientDataSet;var Errmsg :string):boolean;//导出Excel
  end;

var
  DM: TDM;

implementation

{$R *.dfm}

{ TDM }

uses
    comobj,Variants,inifiles;

procedure TDM.DataModuleCreate(Sender: TObject);
var
    inihandle:Tinifile;
begin
    ztapp := CreateOleObject('ztmain.ztapp');
    ztsql := CreateOleObject('ztmain.ztsql');
    ztsql.sqlconnect('dsquery');
    //inihandle:=Tinifile.Create(extractfilepath(Application.ExeName)+'kwsystem.ini');
    //fLogDir :=inihandle.ReadString('kwdata','LogDirectory','c:\');
    fLogDir:='c:\';
end;

procedure TDM.DataModuleDestroy(Sender: TObject);
begin
    ztapp := Unassigned;
    ztsql := Unassigned;
end;

procedure TDM.WriteLog(logText: string);
var
    hFile:integer;
    strDate,strFileName:string;
begin
    strDate:=FormatDateTime('yyyymmdd',date);
    strFileName:=fLogDir+'FSXNH'+ztapp.zgdm+strDate+'.log';
    logtext:=formatdatetime('HH:NN:SS',now)+#9+logtext+#13#10;
    if not FileExists(strFileName) then
        hFile:=FileCreate(strFileName)
    else
        hFile:=FileOpen(strFileName,fmOpenReadWrite or fmShareDenyNone);
    FileSeek(hfile,0,2);
    FileWrite(hFile,logText[1],length(logText));
    fileclose(hFile);
end;
function TDM.FCdsOpen(asql: string; var errmsg: string;PCds:TClientDataSet=nil): Boolean;
var
  sqlException :string;
  sqlError :string;
  acds:TClientDataSet;
begin
    Result :=False;
    sqlException:=asql+'--ClientDataSet执行SQL异常';
    sqlError :=asql+'--ClientDataSet执行SQL出错';
    if asql ='' then
    begin
        Errmsg :='要执行的SQL语句不能为空';
        Exit;
    end;
    acds :=nil;
//    if PCds<>nil then
//    begin
//        acds :=PCds;
//    end
//    else
    acds :=cdsTemp;

    acds.Close;
    acds.DataRequest(asql);
    try
      acds.Open;
    except
      errmsg := sqlException;
      Exit;
    end;

    if acds.Fields[0].AsString ='F' then
    begin
        errmsg :=sqlError+'['+acds.Fields[1].AsString+']';
        Exit;
    end;

    if PCds<>nil then
    begin
        PCds.Data := acds.Data;
    end;
    
    Result :=True;
end;
function TDM.Fztsql(asql: string; var Errmsg: string;aFlag :Integer): Boolean;
var
  sqlException :string;
  sqlError :string;
begin
    Result :=False;
    sqlException:=asql+'--ztsql执行SQL异常';
    sqlError :=asql+'--ztsql执行SQL出错';

    if asql ='' then
    begin
        Errmsg :='要执行的SQL语句不能为空';
        Exit;
    end;
    
    ztsql.sqlcmd(asql);
    ztsql.sqlopen;
    if ztsql.dberr =1 then
    begin
        Errmsg :=sqlException;
        Exit;
    end;
    
    if aFlag =0 then
    begin
        if  ztsql.sqldata(0)='F' then
        begin
            Errmsg :=sqlError+#10#13+'['+ztsql.sqldata(1)+']';
            Exit;
        end;
    end;

    Result :=True;
end;
procedure TDm.ShowErr(AErrmsg: string);
begin
    if AErrmsg='没有取到病人信息' then
        exit;
    
    showmessage(AErrmsg);
end;
function TDM.ksdate2date(aKsDate:string): TDateTime;
var
    aDateTem1,aDateTem2:string;
begin
    aDateTem1 :=copy(aKsDate,1,8);
    aDateTem2 :=copy(aKsDate,9,8);
    Result :=StrToDateTime(Trim(Copy(aDateTem1,1,4)+'-'+Copy(aDateTem1,5,2)+'-'+Copy(aDateTem1,7,2)+' '+aDateTem2));
end;

function TDM.TranslateDate(aKsDate: string): string;
var
    aDateTem1,aDateTem2:string;
begin
    aDateTem1 :=copy(aKsDate,1,8);
    aDateTem2 :=copy(aKsDate,9,8);
    Result :=Trim(Copy(aDateTem1,1,4)+'年'+Copy(aDateTem1,5,2)+'月'+Copy(aDateTem1,7,2)+'日'+aDateTem2);
end;

procedure TDM.InitGridColumnWidth(aGrid: TdxDBGrid);
var
    aDataset :TDataSet;
    I:Integer;
begin
    aDataset := aGrid.DataSource.DataSet;

    if aDataset.IsEmpty or not aDataset.Active then
        Exit;
    for I:=0 to aDataset.Fields.Count-1 do
    begin
        aGrid.Columns[I].Width :=ColWidth;
    end;
end;

procedure TDM.InitGridCol(aGrid: TDBGrid);
var
  I :Integer;
begin
    for I :=0 to aGrid.DataSource.DataSet.Fields.Count -1 do
    begin
        aGrid.Columns[I].Width :=colWidth;
    end;
end;

procedure TDM.InitGridCol(aGrid: TdxDBGrid);
var
  aDataSet:TDataSet;
  I :Integer;
begin
    aDataSet :=aGrid.DataSource.DataSet;
    aGrid.DestroyColumns;
    aGrid.CreateDefaultColumns(aDataSet,nil);
    for I :=0 to aDataSet.Fields.Count -1 do
    begin
        aGrid.Columns[I].Width :=colWidth;
    end;
end;

function TDM.CDS2EXCEL(acds: TClientDataSet; var Errmsg: string): boolean;
var
    msExcel,msExcelSheet :Variant;
    Row,col: Integer;
begin
    result := False;
    try
        msExcel :=CreateOleObject('Excel.Application');
    except
        Errmsg :='请确认已经安装了Excel软件';
        Exit;
    end;
    msExcel.Application.WorkBooks.add();
    msExcelSheet :=msExcel.application.ActiveSheet;
    
    with acds do
    begin
        try
            DisableControls;
            First;
            Row:=2;
            while not Eof do
            begin
                for col := 0 to FieldCount - 1 do    // Iterate
                begin
                    if not Fields.Fields[col].IsNull then
                        msExcelSheet.cells[row,col+1].value :=Fields[col].AsString;
                end;    // for
                Next;
                Inc(Row);
            end;    // while
        finally
            EnableControls;
        end;
    end;    // with

    row :=1;
    for col := 0 to acds.FieldCount - 1 do    // Iterate
    begin
        msExcelSheet.cells[row,col+1].value :=acds.Fields[col].FieldName;
        msExcelSheet.columns[col+1].ColumnWidth :=20;
    end;    // for

    msexcel.Application.visible :=True;

    msExcel :=Unassigned;
    result := True;
end;

end.