u_datamodule.~pas

对于医院的影像室的资料进行管理,主要方便查阅,特别是对于病人的照片的病前后比较对于病情的发展很有价值

unit U_datamodule;

interface

uses
  SysUtils, Classes, DB, ADODB,typinfo,inifiles,forms,dbgrids,Graphics;

type
  TDm = class(TDataModule)
    ADOConnection1: TADOConnection;
    qFileRecord: TADOQuery;
    qExec: TADOQuery;
    qSearch: TADOQuery;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Dm: TDm;
  ConfigFilename:string='Config.ini';
  currImeName:string;

function getDatabySql(sql:string):string;
function execSql(sql:string):string;
procedure setImeName(owner0:Tcomponent;imeName:string);overload;
procedure setImeName(imeName:string);overload;
function get_inicsxx(xmdh:string;strvalue:string='';sectionname:string='GLOBAL'):string;
function set_inicsxx(xmdh:string;strvalue:string='';sectionname:string='GLOBAL'):boolean;
procedure SortDataset(Column0:Tcolumn);


implementation

{$R *.dfm}


procedure SortDataset(Column0:Tcolumn);
var strSort:string;p1,p2:integer;grid0:Tcustomdbgrid;
const bSingle=true;
begin
if column0=nil then exit;
grid0:=column0.Grid;
{if (grid0.DataSource.DataSet is tquery)   then exit;
if (grid0.DataSource.DataSet is ttable)   then
begin
strSort:=(grid0.DataSource.DataSet as ttable).IndexFieldNames;
if pos(column0.FieldName+';',strSort)>0 then strSort:=StringReplace(strSort,column0.FieldName+';','',[rfReplaceAll]);
(grid0.DataSource.DataSet as ttable).IndexFieldNames:=strSort+(column0.FieldName)+';';
end;
}
{
//对于TQUERY 控件,无法排序,目前不考虑.
if (grid0.DataSource.DataSet is tquery)   then
begin
strSort:=(grid0.DataSource.DataSet as tquery).IndexFieldNames;
if pos(column0.FieldName+';',strSort)>0 then begin messagebox(handle,'该列已经被排序了,操作被废弃!','[增加列排序]操作错误提示',mb_iconwarning);exit; end;
(grid0.DataSource.DataSet as tquery).IndexFieldNames:=strSort+(column0.FieldName)+';';
end;
}
if (grid0.DataSource.DataSet is tadotable)   then
begin
if not bSingle then
begin
strSort:=(grid0.DataSource.DataSet as tadotable).sort;
if pos(column0.FieldName+' ASC ,',strSort)>0 then strSort:=StringReplace(strSort,column0.FieldName+' ASC ,','',[rfReplaceAll]);
if pos(column0.FieldName+' DESC ,',strSort)>0 then strsort:=StringReplace(strSort,column0.FieldName+' DESC ,','',[rfReplaceAll]);
end
(grid0.DataSource.DataSet as tadotable).sort:=strSort+(column0.FieldName)+' ASC ,';

end;


if grid0.DataSource.DataSet is tadoquery then
begin
strSort:=(grid0.DataSource.DataSet as tadoquery).sort;
if pos(column0.FieldName+' ASC ,',strSort)>0 then strSort:=StringReplace(strSort,column0.FieldName+' ASC ,','',[rfReplaceAll]);
if pos(column0.FieldName+' DESC ,',strSort)>0 then strsort:=StringReplace(strSort,column0.FieldName+' DESC ,','',[rfReplaceAll]);
(grid0.DataSource.DataSet as tadoquery).sort:=strSort+(column0.FieldName)+' ASC ,';
end;
COLUMN0.Title.Font.Color:=clblue;
end;

function get_inicsxx(xmdh:string;strvalue:string='';sectionname:string='GLOBAL'):string;
var IniF:TiniFile;i:string;
begin
result:=strValue;
if (xmdh='') then exit;
TRY
IniF:=TiniFile.Create(ConfigFilename);
result:=Inif.readstring(sectionname,xmdh,strValue);
FINALLY
IniF.free;
END;

END;

function set_inicsxx(xmdh:string;strvalue:string='';sectionname:string='GLOBAL'):boolean;
var IniF:TiniFile;i:string;
var f:tfilestream;
begin
result:=false;
{IF NOt fileexists(configfilename) then
begin
f:=Tfilestream.Create(configfilename,fmCreate);
f.Write(sectionname,length(sectionname));
f.Free;
end;
}
if (xmdh='') then exit;
TRY
IniF:=TiniFile.Create(ConfigFilename);
Inif.writestring(sectionname,xmdh,strvalue);
RESULT:=TRUE;
FINALLY
IniF.free;
END;

END;

procedure setImeName(imeName:string);
var i:integer;
begin
for i:=0 to  application.componentcount-1 do
if application.Components[i] is tcustomform then
setImeName(application.Components[i],imeName);
end;

procedure setImeName(owner0:Tcomponent;imeName:string);
var i:integer;
begin
for i:=0 to  owner0.componentcount-1 do
begin
if getPropInfo(owner0.components[i],'IMENAME')<>nil then
SetPropValue(owner0.components[i],'IMENAME',imeName);
end;

end;


function getDatabySql(sql:string):string;
begin
try
Dm.qSearch.close;
Dm.qSearch.SQL.text:=sql;
Dm.qSearch.open;
result:=Dm.qSearch.fields[0].AsString;
except
result:='';
end;
end;

function execSql(sql:string):string;
begin
try
Dm.qSearch.close;
Dm.qSearch.SQL.text:=sql;
Dm.qSearch.open;
result:=Dm.qSearch.fields[0].AsString
except on e:exception do
result:=e.message;
end;
end;


procedure TDm.DataModuleCreate(Sender: TObject);
var s1:string;
begin
configfilename:=getcurrentdir+'\'+configfilename;
currImeName:='紫光拼音输入法';
s1:=get_inicsxx('IMENAME','');

if s1='' THEN
begin
if screen.Imes.IndexOf(currImeName)<0 then
currImeName:=screen.defaultime;
Set_inicsxx('IMENAME',currImeName);
end

else
begin
if screen.Imes.IndexOf(s1)<0 then
begin
currImeName:=screen.defaultime;
Set_inicsxx('IMENAME',currImeName);
end
else
currImeName:=s1;
end;

end;



end.