{common frame functoins--------------------------------------------------------}
{资源处理代码}
procedure LoadJpegFromRes(const image: TImage; resName: string); stdcall; external 'resource.dll';
procedure LoadIconFromRes(const icon: TIcon; resName: string); stdcall; external 'resource.dll';
function G_MessageBox(text: string; flags: longint=MB_OK or MB_ICONINFORMATION;
caption: string=''): integer; //信息提示框
function G_GetControlByName(parent: TWinControl; componentName: string): TControl; //通过控件名称获取控件
function G_FormatDT(DateTime: TDateTime; Format: string='yyyy-mm-dd'): string; //格式化日期时间
function G_FormatSqlDt(DbType: TDBType; DateTime: TDateTime;
format: string='yyyy-mm-dd'): string; //格式化数据库日期时间
function G_FormatSqlDtEx(DbType: TDBType; fieldName: string; dataset: TDataSet;
format: string='yyyy-mm-dd'): string; //格式化数据库日期时间
function G_CharSqlIndex(DbType: TDbType; strCheck,strMatch: string): string; //处理字符串是否包含关系SQL
function G_ValidateValue(const Sender: TObject; tips: string): boolean; //控件录入一些值校验
procedure G_SeperateString(value: string; const list: TStrings; dot: string=' ¦'); //分离字符串
function G_GetChineseString(chinese: string): string; //获取汉字对应英文字母
function G_GetLocalHostName(): string; //获取本机名称
function G_GetLocalHostIp(): string; //获取本机IP地址
function G_GetSystemDisplay(var mode: TDevMode): boolean; //获取当前显示
function G_SetSystemDisplay(newMode: TDevMode): Boolean; //动态设置屏幕分辨率
procedure G_RestoreWindow(hWnd: THandle); //动态设置屏幕分辨率
{common db functions ----------------------------------------------------------}
procedure G_SetDbParam(value: TDbParam; fileName: string); //设置数据库参数
function G_GetDbParam(var value: TDbParam; fileName: string): boolean; //获取数据库参数
procedure G_CloseDB(const adocnn: TADOConnection); //关闭数据库联接
function G_ConnectDB(const adocnn: TADOConnection; dbParam: TDbParam): boolean; //建立数据库联接
function G_RunSql(const adocmd: TADOCommand; strSql: string): boolean; //执行SQL命令
function G_BeginTran(const adocnn: TADOConnection): boolean; //启动事务
function G_CommitTran(const adocnn: TADOConnection): boolean; //提交事务
function G_RollTran(const adocnn: TADOConnection): boolean; //回滚事务
procedure G_FreeDS(DataSet: TDataSet);
function G_CreateDS(const adocnn: TADOConnection; strSql: string): TADODataSet; //创建记录集
procedure G_CloseDS(const DataSet: TDataSet); //关闭数据集
function G_BuildDS(const DataSet: TADODataSet; strSql: string): integer; //打开记录集
function G_BuildCDS(id,ip,userId,pwd,strSql,dsp: string; sckcnn: TSocketConnection;
const dataset: TClientDataSet): integer; //生成服务端记录集
function G_GetFieldValue(const DataSet: TDataSet; fieldName: string): Variant; //获取记录
function G_GetFieldValueEx(const field: TField): Variant; //获取TField值
function G_FormatFieldSql(dbType: TDbType; const field: TField): string; //格式化TField值SQL
procedure G_SetFieldValue(const DataSet: TDataSet; fieldName: string; value: Variant); //设置记录值
procedure G_SetDataSetLabel(const DataSet: TDataSet; dicFields: TDicFieldList); //设置记录集显示标签
procedure G_ClonseRecord(srcDataSet,dstDataSet: TDataSet); //克隆当前记录
function G_PostRecordToDb(dbType: TDBType; const adocmd: TADOCommand;
const dsData,dsField: TDataSet; tbName, delKeys: string;
operate: TOperate; delBeforeAppend: boolean): boolean; //把记录集的当前记录写入数据库
function G_PostDataSetToDb(dbType: TDBType; const adocmd: TADOCommand;
const dsData: TDataSet; tbName,delKeys: string;
operate: TOperate; delBeforeAppend: boolean): boolean; //数据集写入数据库
{function operations ----------------------------------------------------------}
function G_GetActionByName(const actionLst: TActionList; actionName: string): TAction; //根据功能名称,取出功能
procedure G_FreeFuncTree(tvFunc: TTreeView); //销毁树
procedure G_BuildFuncTree(tvFunc: TTreeView; funcs: TFuncLst; withLeaf: boolean; root: string=''); //生成树
procedure G_LoadResImage(const ImageList: TImageList; ress: TResLst); //载入功能资源
procedure G_BuildToolBar(toolBar: TToolBar; ActionLst: TActionList; sysFunc,usrFunc: TFuncLst); //生成 ToolBar 按钮
procedure G_BuildMainMenu(mainMenu: TMainMenu; ActionLst: TActionList; sysFuncs,usrFunc: TFuncLst); //生成系统菜单
{base information treeview ----------------------------------------------------}
procedure G_FreeBaseTree(const tvBase: TTreeView); //销毁基本信息树
procedure G_AddTreeNode(const tvBase: TTreeView; parent: TTreeNode; nodeData: TBaseNode); //增加一个节点
procedure G_DelTreeNode(const tvBase: TTreeView; node: TTreeNode); //删除指定节点
procedure G_SetTreeCheckBox(tvBase: TTreeView; button: TMouseButton; shift: TShiftState;X,Y: Integer);//设置树的CheckBox
procedure G_BuildBaseTree(const tvBase: TTreeView; DataSet: TDataSet; checkBox: boolean=false); //生成基本信息树
function G_GetNodeParentPath(const tvBase: TTreeView; node: TTreeNode): string; //获取某节点其父节点路径
function G_GetNodePath(const tvBase: TTreeView; node: TTreeNode): string; //获取节点路径
procedure G_SetSelectedNodeText(const tvBase: TTreeView; id,name: string); //设置已选节点内容
{数据库相关控件操作------------------------------------------------------------}
procedure G_BuildDBGridTitle(const DBGrid: TDBGrid; DicFields: TDicFieldList); //初始化 DBGrid 标题
procedure G_BuildDBGridEhTitle(const DBGridEh: TDBGridEh; DicFields: TDicFieldList); //初始化 DBGridEh 标题
procedure G_GetDBGridFields(const DBGrid: TDBGrid; var DicFields: TDicFieldList); //获取 DBGrid 字段信息
procedure G_GetDBGridEhFields(const DBGridEh: TDBGridEh; var DicFields: TDicFieldList); //获取 DBGridEh 字段信息
function G_GetDBGridColumn(const DBGrid: TDBGrid; FieldName: string): TColumn; //获取 DBGridEh 绑定字段表头
function G_GetDBGridEhColumn(const DBGridEh: TDBGridEh; FieldName: string): TColumnEh; //获取 DBGridEh 绑定字段表头
procedure G_BuildDBGridEhFooterField(const DBGridEh: TDBGridEh; footers: TDBGridEhFooters); //生成 DBGridEh 某列的页脚
procedure G_DataBind(const DataSource: TDataSource; Container: TWinControl); //邦定容器数据控件
{通用数据库操作无关函数--------------------------------------------------------}
function G_MessageBox(text: String; flags: longint=MB_OK or MB_ICONINFORMATION; caption: String=''): integer;
begin
if Caption = '' then
begin
Caption := Application.Title;
end;
Result := Application.MessageBox(PChar(Text),PChar(Caption),Flags);
end;
function G_GetControlByName(parent: TWinControl; componentName: string): TControl;
var
i: integer;
begin
result := nil;
for i:=0 to parent.ControlCount-1 do
begin
if LowerCase(parent.Controls[i].Name)=LowerCase(componentName) then
begin
result := parent.Controls[i];
break;
end;
end;
end;
function G_FormatDT(DateTime: TDateTime; Format: String='yyyy-mm-dd'): string;
begin
Result := FormatDateTime(format,DateTime);
end;
function G_FormatSqlDt(DbType: TDBType; DateTime: TDateTime; format: string='yyyy-mm-dd'): string;
begin
case DbType of
dbAccess: Result := '#'+G_FormatDT(DateTime,format)+'#';
dbSQL,
dbSybase: Result := ''''+G_FormatDT(DateTime,format)+'''';
end;
end;
function G_FormatSqlDtEx(DbType: TDBType; fieldName: string; dataset: TDataSet; format: string='yyyy-mm-dd'): string;
begin
if dataset[fieldName]=NULL then result := 'null'
else result := G_FormatSqlDt(DBType,G_GetFieldValue(dataset,fieldName),format);
end;
function G_CharSqlIndex(DbType: TDbType; strCheck,strMatch: string): string;
begin
case DbType of
dbAccess: Result := 'InStrRev('+strCheck+','+strMatch+')';
dbSQL,
dbSybase: Result := 'CharIndex('+strMatch+','+strCheck+')';
end;
end;
function G_ValidateValue(const Sender: TObject; tips: string): boolean;
begin
Result := TRUE;
if ((Sender is TEdit) and (TEdit(Sender).Text='')) then Result := FALSE;
if ((Sender is TDBEdit) and (TDBEdit(Sender).Text='')) then Result := FALSE;
if ((Sender is TComboBox) and (TComboBox(Sender).Text='')) then Result := FALSE;
if ((Sender is TDBComboBox) and (TDBComboBox(Sender).Text='')) then Result := FALSE;
if ((Sender is TMemo) and (TMemo(Sender).Text='')) then Result := FALSE;
if ((Sender is TDBMemo) and (TDBMemo(Sender).Text='')) then Result := FALSE;
if not Result then
begin
G_MessageBox(Tips, MB_ICONWARNING);
TWinControl(Sender).SetFocus;
end;
end;
procedure G_SeperateString(value: string; const list: TStrings; dot: string=' ¦');
var
nPos: Integer;
tmp: String;
begin
list.Clear;
while Length(Value)> 0 do
begin
nPos := Pos(Dot,Value);
if nPos> 0 then
begin
tmp := Copy(value,1,nPos-1);
if tmp <> '' then list.Add(tmp);
Delete(Value,1,nPos);
end
else begin
if Length(value)> 0 then
begin
list.Add(Value);
value := '';
end;
end;
end;
end;
function GetChineseIndexChar(hzChar: string): string;
var
index: WORD;
begin
index := WORD(hzChar[1]) shl 8 + WORD(hzChar[2]);
case index of
$B0A1..$B0C4 : Result := 'a';
$B0C5..$B2C0 : Result := 'b';
$B2C1..$B4ED : Result := 'c';
$B4EE..$B6E9 : Result := 'd';
$B6EA..$B7A1 : Result := 'e';
$B7A2..$B8C0 : Result := 'f';
$B8C1..$B9FD : Result := 'g';
$B9FE..$BBF6 : Result := 'h';
$BBF7..$BFA5 : Result := 'j';
$BFA6..$C0AB : Result := 'k';
$C0AC..$C2E7 : Result := 'l';
$C2E8..$C4C2 : Result := 'm';
$C4C3..$C5B5 : Result := 'n';
$C5B6..$C5BD : Result := 'o';
$C5BE..$C6D9 : Result := 'p';
$C6DA..$C8BA : Result := 'q';
$C8BB..$C8F5 : Result := 'r';
$C8F6..$CBF9 : Result := 's';
$CBFA..$CDD9 : Result := 't';
$CDDA..$CEF3 : Result := 'w';
$CEF4..$D1B8 : Result := 'x';
$D1B9..$D4D0 : Result := 'y';
$D4D1..$D7F9 : Result := 'z';
else
Result := #0;
end;
end;
function G_GetChineseString(chinese: string): string;
var
I: Integer;
PY: String;
sTmp: string;
begin
sTmp := '' ;
I := 1;
while I <= Length(chinese) do
begin
PY := Copy(Chinese, I , 1);
if PY > = Chr(128) then
begin
Inc(I);
PY := PY + Copy(Chinese, I , 1);
sTmp := sTmp + GetChineseIndexChar(PY);
end
else
sTmp := sTmp + PY;
Inc(I);
end;
Result := sTmp;
end;
function G_GetLocalHostName(): string;
var
wVersionRequested: WORD;
wsaData: TWSAData;
p: PHostEnt;
s: array[0..128] of char;
begin
result := '';
try
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
GetHostName(@s, 128);
p := GetHostByName(@s);
result := p^.h_Name;
WSACleanup;
except
end;
end;
function G_GetLocalHostIp(): string;
var
wVersionRequested: WORD;
wsaData: TWSAData;
p: PHostEnt;
s: array[0..128] of char;
begin
result := '';
try
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
GetHostName(@s, 128);
p := GetHostByName(@s);
result := inet_ntoa(PInAddr(p^.h_addr_list^)^);
WSACleanup();
except
end;
end;
function G_GetSystemDisplay(var mode: TDevMode): boolean;
begin
Result := EnumDisplaySettings(nil, Cardinal(-1), Mode);
end;
function G_SetSystemDisplay(newMode: TDevMode): boolean;
var
lpDevMode: TDeviceMode;
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
Result := ChangeDisplaySettings(newMode, CDS_UPDATEREGISTRY) = DISP_CHANGE_SUCCESSFUL;
end;
procedure G_RestoreWindow(hWnd: THandle);
begin
SetForegroundWindow(hWnd);
BringWindowToTop(hWnd);
ShowWindow(hWnd,SW_SHOWNORMAL);
end;
{数据库相关操作函数------------------------------------------------------------}
procedure G_SetDbParam(value: TDbParam; fileName: string);
var
pFile: file of TDbParam;
begin
try
AssignFile(pFile,fileName);
ReWrite(pFile);
Write(pFile,Value);
CloseFile(pFile);
except
end;
end;
function G_GetDbParam(var value: TDbParam; fileName: string): boolean;
var
pFile: file of TDbParam;
begin
Result := false;
if not FileExists(fileName) then Exit;
try
AssignFile(pFile,fileName);
Reset(pFile,fileName);
Read(pFile,value);
CloseFile(pFile);
Result := true;
except
end;
end;
procedure G_CloseDB(const adocnn: TADOConnection);
begin
if adocnn.Connected then adocnn.Close;
end;
function G_ConnectDB(const adocnn: TADOConnection; dbParam: TDbParam): boolean;
var
strConn: String;
begin
Result := FALSE;
if adocnn=nil then Exit;
case dbParam.dbType of
dbAccess: strConn:= 'Provider=Microsoft.Jet.OLEDB.4.0;'+
'Data Source='+DbParam.dbName+';'+
'User ID='+DbParam.dba+';'+
'Password='+DbParam.pwd;
dbSQL : strConn:= 'Provider=SQLOLEDB.1;'+
'Password='+DbParam.pwd+';'+
'User ID='+DbParam.dba+';'+
'Initial Catalog='+DbParam.dbName+';'+
'Data Source='+DbParam.host;
dbSybase: strConn:= '';
end;
try
G_CloseDB(adocnn);
adocnn.ConnectionString := strConn;
adocnn.Connected := TRUE;
Result := adocnn.Connected;
except
end;
end;
function G_RunSql(const adocmd: TADOCommand; strSql: string): boolean;
begin
try
adocmd.CommandType := cmdText;
adocmd.CommandText := strSql;
adocmd.Execute;
Result := TRUE;
except
Result := FALSE;
end;
end;
function G_BeginTran(const adocnn: TADOConnection): boolean;
begin
Result := FALSE;
try
if adocnn.InTransaction then
begin
adocnn.RollbackTrans;
Exit;
end;
adocnn.BeginTrans;
Result := TRUE;
except
end;
end;
function G_CommitTran(const adocnn: TADOConnection): boolean;
begin
Result := FALSE;
try
if not adocnn.InTransaction then Exit;
adocnn.CommitTrans;
Result := TRUE;
except
G_RollTran(adocnn);
end;
end;
function G_RollTran(const adocnn: TADOConnection): boolean;
begin
result := false;
try
if not adocnn.InTransaction then Exit;
adocnn.RollbackTrans;
result := true;
except
end;
end;
procedure G_FreeDS(DataSet: TDataSet);
begin
if DataSet.State <> dsBrowse then DataSet.Close;
DataSet.Free;
end;
function G_CreateDS(const adocnn: TADOConnection; strSql: string): TADODataSet;
begin
result := TADODataSet.Create(adocnn);
result.Connection := adocnn;
G_BuildDS(result,strSql);
end;
procedure G_CloseDS(const DataSet: TDataSet);
begin
if DataSet.State <> dsInactive then DataSet.Close;
end;
function G_BuildDS(const DataSet: TADODataSet; strSql: string): integer;
begin
try
G_CloseDS(DataSet);
DataSet.CommandType := cmdText;
DataSet.CommandText := strSQL;
DataSet.Open;
DataSet.Recordset.Properties['Update Criteria'].Value := AdCriteriaKey;
Result := DataSet.RecordCount;
except
Result := -1;
end;
end;
function G_BuildCDS(id,ip,userId,pwd,strSql,dsp: string; sckcnn: TSocketConnection;
const dataset: TClientDataSet): integer;
begin
try
if dataSet.State <> dsInactive then dataSet.Close;
dataSet.ProviderName := dsp;
result := sckcnn.AppServer.getdata(id,ip,userId,pwd,dsp,strSql);
if (Result> =0) then dataSet.Open;
except
result := -1;
end;
end;
function G_GetFieldValue(const DataSet: TDataSet; fieldName: string): Variant;
var
retValue: Variant;
begin
Result := Unassigned;
if DataSet.State=dsInactive then Exit;
retValue := DataSet[fieldName];
if retValue <> NULL then Result := retValue;
end;
function G_GetFieldValueEx(const field: TField): Variant;
var
retValue: Variant;
begin
Result := Unassigned;
retValue := field.Value;
if retValue <> NULL then Result := retValue;
end;
function G_FormatFieldSql(dbType: TDbType; const field: TField): string;
begin
case field.DataType of
ftString,
ftMemo,
ftWideString,
ftFixedChar: result := ''''+field.AsString+'''';
ftDate : result := G_FormatSqlDt(dbType,G_GetFieldValueEx(field));
ftTime : G_FormatSqlDt(dbType,G_GetFieldValueEx(field),'hh:nn:ss');
ftDateTime : result := G_FormatSqlDt(dbType,G_GetFieldValueEx(field),'yyyy-mm-dd hh:nn:ss');
ftAutoInc,
ftLargeint,
ftSmallint,
ftInteger,
ftWord: result := IntToStr(G_GetFieldValueEx(field));
ftFloat,
ftCurrency,
ftBCD : result := FloatToStr(G_GetFieldValueEx(field));
ftBoolean: if field.AsBoolean then result := '1'
else result := '0';
end;
end;
procedure G_SetFieldValue(const DataSet: TDataSet; fieldName: string; value: Variant);
begin
if (DataSet.FindField(fieldName) <> nil) and (DataSet.State <> dsInactive) then
begin
if DataSet.State=dsBrowse then DataSet.Edit;
DataSet[fieldName] := Value;
end;
end;
procedure G_SetDataSetLabel(const DataSet: TDataSet; dicFields: TDicFieldList);
var
i: integer;
field: TField;
begin
for i:=0 to dicFields.nFields-1 do
begin
field := DataSet.FindField(dicFields.fields[i].name);
if field <> nil then
begin
field.DisplayLabel := dicFields.fields[i].sName;
field.Tag := 1;
end;
end;
end;
procedure G_ClonseRecord(srcDataSet,dstDataSet: TDataSet);
var
i: integer;
begin
dstDataSet.Append;
for i:=0 to srcDataSet.FieldCount-1 do
begin
dstDataSet.Fields[i] := srcDataSet.Fields[i];
end;
dstDataSet.Post;
end;
//删除记录集中指定主键信息记录
function DelRecords(dbType: TDBType; const adocmd: TADOCommand; const dsData: TDataSet;
tbName,delKeys: string): boolean;
var
i: integer;
strSql: string;
fields: TStrings;
begin
fields := TStringList.Create;
G_SeperateString(delKeys,fields,',');
strSql := 'delete from '+tbName+' where ';
for i:=0 to fields.Count-1 do
begin
if i=fields.Count-1 then
strSql := strSql+fields[i]+'='+G_FormatFieldSql(dbType,dsData.FieldByName(fields[i]))
else
strSql := strSql+fields[i]+'='+G_FormatFieldSql(dbType,dsData.FieldByName(fields[i]))+' and ';
end;
result := G_RunSql(adocmd,strSql);
fields.Free;
end;
{参数说明：
dbType: 数据库类别，传入次参数，目的为了格式化SQL语句
adocmd: 用于执行SQL语句的 ADOCommand 对象
}
function G_PostRecordToDb(dbType: TDBType; const adocmd: TADOCommand;
const dsData,dsField: TDataSet; tbName, delKeys: string;
operate: TOperate; delBeforeAppend: boolean): boolean;
var
i: integer;
fields: TStrings;
strSql: string;
begin
result := false;
if (operate=opNew) and delBeforeAppend and (not DelRecords(dbType,adocmd,dsData,tbName,delKeys)) then exit;
case operate of
opNew : begin
strSql := 'insert into '+tbName+'(';
for i:=0 to dsField.FieldCount-1 do
begin
if i=dsField.FieldCount-1 then strSql := strSql+dsField.Fields[i].FieldName+') values('
else strSql := strSql+dsField.Fields[i].FieldName+',';
end;
for i:=0 to dsField.FieldCount-1 do
begin
if i=dsField.FieldCount-1 then strSql := strSql+G_FormatFieldSql(dbType,dsData.FieldByName(dsField.Fields[i].FieldName))+')'
else strSql := strSql+G_FormatFieldSql(dbType,dsData.FieldByName(dsField.Fields[i].FieldName))+',';
end;
end;
opModify: begin
strSql := 'update '+tbName+' set ';
for i:=0 to dsField.FieldCount-1 do
begin
if i=dsField.FieldCount-1 then
strSql := strSql+dsField.Fields[i].FieldName+'='+
G_FormatFieldSql(dbType,dsData.FieldByName(dsField.Fields[i].FieldName))+' where '
else
strSql := strSql+dsField.Fields[i].FieldName+'='+
G_FormatFieldSql(dbType,dsData.FieldByName(dsField.Fields[i].FieldName))+',';
end;
fields := TStringList.Create;
G_SeperateString(delKeys,fields,',');
for i:=0 to fields.Count-1 do
begin
if i=fields.Count-1 then
strSql := strSql+fields[i]+'='+G_FormatFieldSql(dbType,dsData.FieldByName(fields[i]))
else
strSql := strSql+fields[i]+'='+G_FormatFieldSql(dbType,dsData.FieldByName(fields[i]))+' and ';
end;
fields.free;
end;
end;
result := G_RunSql(adocmd,strSql);
end;
2515
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
