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: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.