本文介绍了如何使用Delphi的运行时类型信息（RTTI）来动态配置TdxDBGrid和TDBGrid，包括标题、列宽、显示顺序和字体大小颜色等属性。提供了源代码下载链接以及后台表结构和测试端、配置端及数据库访问端的代码示例。
测试界面：
配置界面：
配置表
代码实现：
可以通过配置表，也可以通过配置文件保存，我这里试通过数据库表保存的。
源代码下载地址：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:TCo
最低0.47元/天 解锁文章
613
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
