RTFormwork/public10/ThreeFun/Fun/U_RTFun1024.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

2039 lines
62 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_RTFun;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DBGrids, DB, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView, ADODB, StrUtils, Midas,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxTimeEdit,
cxTreeView, cxGrid, cxDBLookupComboBox, cxCalendar, cxCurrencyEdit,
cxGridExportLink, ExtCtrls, Buttons, DBClient, RTComboBox, cxDropDownEdit,
cxGridBandedTableView, cxGridDBBandedTableView, cxRichEdit, cxButtonEdit,
IniFiles, WinSock, IdHTTP;
type
TA = class(TComponent)
public
S: string;
end;
procedure GetFileInfo(mFile: string; var mfileSize: integer; var CreationTime: tdatetime; var WriteTime: tdatetime);
function SGetServerDate(ADOQueryTmp: TADOQuery): TdateTime; // 取服务器日期
function SGetServerDateTime(ADOQueryTmp: TADOQuery): TdateTime; // 取服务器日期时间
function SGetFilters(TMPanel: TPanel; EquTag, LikeTag: Integer): string;
// 拼接查询条件
procedure SDofilter(ADOQry: TADOQuery; FilterStr: string); // 执行过滤
procedure SCreateCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet);
// 创建CDS列名
procedure SInitCDSData(fromADO: TADOQuery; toCDS: TclientDataSet); // CDS赋值
// 给 RadioGroup1赋值
procedure SInitRadioGroupBySql(ADOQueryTmp: TADOQuery; rg: TRadioGroup; emptyFlag: Boolean; mSql: string);
// 给TComboBox赋值
procedure SInitComBoxBySql(ADOQueryTmp: TADOQuery; cb: TComboBox; emptyFlag: Boolean; mSql: string);
// 给TcxGriddbColumn中的TComboBox赋值
procedure SInitCxGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGriddbColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
// 给TcxGridDBBandedColumn中的TComboBox赋值
procedure SInitCxBandGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGridDBBandedColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
function RoundFloat(f: double; i: Integer): double; // 四舍五入取指定位小数
// **************** CDS快捷赋值 *****************//
procedure CopyAddRowCDS(CDS_Sub: TclientDataSet); // 复制增行CDS
procedure CopyAddRowCDS2(CDS_1, CDS_2: TclientDataSet); // 复制增行CDS
procedure CopyAddRow(Tv1: TcxGridDBTableView; CDS_Sub: TclientDataSet);
// TcxGridDBTableView复制增行。groupformat标记值
procedure CopyAddRowBand(Tv1: TcxGridDBBandedTableView; CDS_Sub: TclientDataSet); // TcxGridDBBandedTableView复制增行。groupformat标记值
procedure OneKeyPost(Tv1: TcxGridDBTableView; CDS_Sub: TclientDataSet);
// 一键替换粘贴 TcxGridDBTableView
procedure OneKeyPostBand(Tv1: TcxGridDBBandedTableView; CDS_Sub: TclientDataSet); // 一键替换粘贴 TcxGridDBBandedTableView
// **************** CDS快捷赋值 *****************//
function GetLSNo(ADOQueryTmp: TADOQuery; // 取主键
var mMaxNo: string; mFlag: string; mTable: string; mlen: Integer; mtype: Integer = 0): Boolean;
// **************** 保存格式 *****************//
procedure ReadCxGrid(fileName: string; cxGrid: TcxGridDBTableView; filePack: string = '公用');
procedure ReadCxBandedGrid(fileName: string; cxGrid: TcxGridDBBandedTableView; filePack: string = '公用');
procedure WriteCxGrid(fileName: string; cxGrid: TcxGridDBTableView; filePack: string = '公用');
procedure WriteCxBandedGrid(fileName: string; cxGrid: TcxGridDBBandedTableView; filePack: string = '公用');
// **************** 保存格式 *****************//
function ReadINIFileStr(ininame, TypeName: string; ValueName, ValueMR: string): string; // 读取文件
// **************** 下载文件 *****************//
function CovFileDate(Fd: _FileTime): TdateTime;
procedure UpdateFileTime(fileName: string; CreationTime, LastAccessTime, LastWriteTime: TdateTime);
procedure GetFileEditTime(mFile: string; var editTime: TdateTime);
function ExportFtErpFile(mFileName: string; ADORead: TADOQuery): Boolean;
// **************** 下载文件 *****************//
procedure TcxGridToExcel(mFileName: string; gridName: TcxGrid); // 导出界面
procedure SClearData(mParent: TWinControl; FTag: Integer); // 清空容器中控件的内容
// **************** 界面初始化 *****************//
procedure SCSHDataCDS(CDS_Main: TclientDataSet; mParent: TWinControl; FTag: Integer); // 初始化容器空间的内容
procedure SCSHData(ADOQueryTmp: TADOQuery; mParent: TWinControl; FTag: Integer);
procedure SSetWinData(ADOQueryTmp: TADOQuery; mParent: TWinControl);
// **************** 界面初始化 *****************//
// **************** 界面数据保存 *****************//
procedure RTSetsavedata(ADOQueryCmd: TADOQuery; MyTable: string;
// 保存TWinControl数据
Myparent: TWinControl; MyTag: Integer);
function RTSetSaveDataCDS(ADOQueryCmd: TADOQuery; Tv1: TcxGridDBTableView;
// 保存TcxGridDBTableView数据
CDS_Sub: TclientDataSet; MyTable: string; MyTag: Integer): Boolean;
function RTSetSaveDataCDSBand(ADOQueryCmd: TADOQuery; Tv1: TcxGridDBBandedTableView; // 保存TcxGridDBBandedTableView数据
CDS_Sub: TclientDataSet; MyTable: string; MyTag: Integer): Boolean;
// **************** 界面数据保存 *****************//
procedure SelOKNo(CDS_MainSel: TclientDataSet; FSel: Boolean); // 全选/全弃
procedure SelOKNoFiler(Tv1: TcxGridDBTableView; FSel: Boolean);
function FormatTitle(S: string): string; { 将字符串中的半角替换成全角字符 }
// 调用DLL文件
procedure InitDllEvt(FromFile: string; FormID: Integer; Para: string; FormType: Integer; Title: string; Def1: string; Def2: string; Def3: string; Def4: string; Def5: string; Def6: string; Def7: string; Def8: string; Def9: string; Def10: string);
// **************** 访问网页 *****************//
procedure GetHTTP(FUrl: string);
function Utf8Encode(const WS: WideString): UTF8String;
// **************** 访问网页 *****************//
//清除搜索框
procedure clearControl(Myparent: TWinControl; MyTag: integer);
//清除或隐藏搜索框
procedure ClearOrHideControls(TMPanel: TPanel; HintValue: string; IsClear: Boolean; IsHide: Boolean);
//将表格内容填入搜索框
procedure AssignmentControls(TMPanel: TPanel; TMClientDataset: TclientDataSet; Hintvalue: string);
// **************** 师爷写的 *****************//
function WriteCloseWin(AdoCmd: TADOQuery; mCaption: string; FormID: Integer; mDllName: string): Boolean;
procedure selectDataRow(Sender: TcxCustomGridTableView; mKeyField: string);
// **************** 师爷写的 *****************//
type
TMyF = function(App: TApplication; // 主应用程序 (对Delphi而言)
FormH: HWND; // 创建窗口的父窗口句柄 (对PB而言)
FormID: Integer; // 要调用dll中功能窗体的Id号; 如果只有一个功能窗口FormID默认为0
Language: Integer; // 0=Delphi; 1=PB
WinStyle: Integer; // 0=子窗口; 1普通窗口 (PB中都为普通窗口)
UID: PWideChar; // 用户Id
UName: PWideChar; // 用户名
Para: PWideChar; Title: PWideChar; Defstr1: PWideChar; Defstr2: PWideChar; Defstr3: PWideChar; Defstr4: PWideChar; Defstr5: PWideChar; Defstr6: PWideChar; Defstr7: PWideChar; Defstr8: PWideChar; Defstr9: PWideChar; Defstr10: PWideChar; Datalink: PWideChar): HWND; stdcall;
var
TP: FARPROC;
Tf: TMyF;
implementation
uses
U_DataLink;
///////////////////////////////////////////////////////
//将表格内容填入搜索框
///////////////////////////////////////////////////////
procedure AssignmentControls(TMPanel: TPanel; TMClientDataset: TclientDataSet; Hintvalue: string);
var
i: integer;
begin
with TMPanel do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TEdit then
begin
if Trim(TEdit(Controls[i]).Hint) = Hintvalue then
begin
TEdit(Controls[i]).Text := Trim(TMClientDataset.FieldByName(TEdit(Controls[i]).Name).AsString);
end;
end;
if Controls[i] is TComboBox then
begin
if Trim(TEdit(Controls[i]).Hint) = Hintvalue then
begin
TComboBox(Controls[i]).ItemIndex := TComboBox(Controls[i]).Items.IndexOf(Trim(TMClientDataset.FieldByName(TComboBox(Controls[i]).Name).AsString));
end;
end;
end;
end;
end;
///////////////////////////////////////////////////////
//清除或者隐藏搜索框
///////////////////////////////////////////////////////
procedure ClearOrHideControls(TMPanel: TPanel; HintValue: string; IsClear: Boolean; IsHide: Boolean);
var
i: Integer;
begin
with TMPanel do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Hint = HintValue then
begin
TCheckBox(Controls[i]).Visible := IsHide;
end;
end;
if Controls[i] is TLabel then
begin
if TLabel(Controls[i]).Hint = HintValue then
begin
TLabel(Controls[i]).Visible := IsHide;
end;
end;
if Controls[i] is TComboBox then
begin
if TComboBox(Controls[i]).Hint = HintValue then
begin
TComboBox(Controls[i]).Visible := IsHide;
if IsClear then
TComboBox(Controls[i]).ItemIndex := -1;
end;
end;
if Controls[i] is TEdit then
begin
if Trim(TEdit(Controls[i]).Hint) = HintValue then
begin
TEdit(Controls[i]).Visible := IsHide;
if IsClear then
TEdit(Controls[i]).Text := '';
end;
end;
if Controls[i] is TBtnEditA then
begin
if Trim(TEdit(Controls[i]).Hint) = HintValue then
begin
TEdit(Controls[i]).Visible := IsHide;
if IsClear then
TEdit(Controls[i]).Text := '';
end;
end;
end;
end;
end;
///////////////////////////////////////////////////////
//清除搜索框
///////////////////////////////////////////////////////
procedure clearControl(Myparent: TWinControl; MyTag: integer);
var
i: Integer;
MCode: string;
begin
with Myparent do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i].Tag = MyTag then
begin
if Controls[i] is TEdit then
begin
TEdit(Controls[i]).Text := '';
end;
if Controls[i] is TMemo then
begin
TMemo(Controls[i]).Lines.Text := '';
end;
if Controls[i] is TcxCurrencyEdit then
begin
TcxCurrencyEdit(Controls[i]).Text := '';
end;
if Controls[i] is TComboBox then
begin
TComboBox(Controls[i]).ItemIndex := 0;
end;
if Controls[i] is TDateTimePicker then
begin
TDateTimePicker(Controls[i]).Date := date();
end;
end;
end;
end;
end;
/// //////////////////////////////////////////////////
// 函数功能:初始化窗口数据
/// //////////////////////////////////////////////////
procedure SSetWinData(ADOQueryTmp: TADOQuery; mParent: TWinControl);
var
i, idx: Integer;
mfield: string;
ma: TA;
begin
with ADOQueryTmp do
begin
if isEmpty then
exit;
with mParent do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TLabel then
continue;
if Controls[i].Tag >= 999 then
continue;
mfield := Controls[i].Name;
/// ////////////////////////
// EDIT
if Controls[i] is TEdit then
begin
{ if Trim(Controls[i].Hint)='数值' then
continue
else }
if Trim(fieldByName(mfield).AsString) <> '' then
TEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TRichEdit then
begin
{ if Trim(Controls[i].Hint)='数值' then
continue
else }
if Trim(fieldByName(mfield).AsString) <> '' then
TRichEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end // ftcombobox
else if Controls[i] is TRTComboBox then
begin
if Controls[i].Tag = 99 then
begin
idx := TRTComboBox(Controls[i]).Items.IndexOf(Trim(fieldByName(mfield).AsString));
TComboBox(Controls[i]).ItemIndex := idx;
end
else
begin
idx := TRTComboBox(Controls[i]).IndexOfItem2(Trim(fieldByName(mfield).AsString));
TComboBox(Controls[i]).ItemIndex := idx;
end;
end // combobox
else if Controls[i] is TComboBox then
begin
if TComboBox(Controls[i]).Items.Count > 0 then
begin
// idx:=getCombIdx(TComboBox(Controls[i]),i,trim(fieldByName(mfield).AsString));
idx := TComboBox(Controls[i]).Items.IndexOf(Trim(fieldByName(mfield).AsString));
end
else
idx := -1;
TComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TBtnEditA then
begin
if TBtnEditA(Controls[i]).Tag = 1 then
begin
TBtnEditA(Controls[i]).TxtCode := Trim(fieldByName(mfield).AsString);
TBtnEditA(Controls[i]).Text := Trim(fieldByName(mfield + 'Name').AsString);
end
else
begin
TBtnEditA(Controls[i]).TxtCode := Trim(fieldByName(mfield).AsString);
TBtnEditA(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end;
end
else if Controls[i] is TBtnEditC then
begin
TBtnEditC(Controls[i]).TxtCode := Trim(fieldByName(mfield).AsString);
TBtnEditC(Controls[i]).Text := Trim(fieldByName(mfield + 'Name').AsString);
end
else if Controls[i] is TDateTimePicker then
begin
if isEmpty or fieldByName(mfield).IsNull then
begin
if TDateTimePicker(Controls[i]).Checked then
TDateTimePicker(Controls[i]).Date := strToDate('1990-01-01');
end
else
TDateTimePicker(Controls[i]).Date := fieldByName(mfield).AsDateTime;
end
else if Controls[i] is Tmemo then
begin
Tmemo(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TcxRichEdit then
begin
TcxRichEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TcxDateEdit then
begin
if not isEmpty and not fieldByName(mfield).IsNull then
TcxDateEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcxTimeEdit then
begin
if not isEmpty and (fieldByName(mfield).AsString <> '') then
TcxTimeEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcxCurrencyEdit then
begin
TcxCurrencyEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcheckBox then
begin
TcheckBox(Controls[i]).Checked := fieldByName(mfield).asBoolean;
end;
end; // end for
end; // end with
end; // end for with
end;
function ReadINIFileStr(ininame, TypeName: string; ValueName, ValueMR: string): string;
var
programIni: Tinifile; // 配置文件名
fileName, ValueZS: string;
begin
fileName := ExtractFilePath(Paramstr(0)) + ininame;
programIni := Tinifile.create(fileName);
ValueZS := programIni.ReadString(TypeName, ValueName, ValueMR);
Result := ValueZS;
programIni.Free;
end;
function WriteCloseWin(AdoCmd: TADOQuery; mCaption: string; FormID: Integer; mDllName: string): Boolean;
begin
Result := false;
try
DServerDate := SGetServerDateTime(AdoCmd);
with AdoCmd do
begin
close;
sql.Clear;
sql.Add('select *');
sql.Add('from SY_CloseFormInfo');
sql.Add('where UserId=' + quotedStr(DCode));
sql.Add('and formCaption=' + quotedStr(mCaption));
Open;
if Recordcount > 0 then
begin
edit;
end
else
begin
append;
fieldByName('UserId').Value := DCode;
fieldByName('formCaption').Value := mCaption;
fieldByName('formId').Value := FormID;
fieldByName('dllfileName').Value := mDllName;
end;
fieldByName('filltime').Value := DServerDate;
post;
end;
Result := true;
except
application.MessageBox('写关闭信息时发生错误!', '提示信息', 0);
end;
end;
procedure SCSHData(ADOQueryTmp: TADOQuery; mParent: TWinControl; FTag: Integer);
var
i, idx: Integer;
mfield, mfieldCode: string;
ma: TA;
begin
with ADOQueryTmp do
begin
if isEmpty then
exit;
with mParent do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TLabel then
continue;
if Controls[i].Tag <> FTag then
continue;
mfield := Controls[i].Name;
/// ////////////////////////
// EDIT
if Controls[i] is TEdit then
begin
if Trim(fieldByName(mfield).AsString) <> '' then
TEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end // ftcombobox
else if Controls[i] is TRTComboBox then
begin
idx := TRTComboBox(Controls[i]).IndexOfItem2(Trim(fieldByName(mfield).AsString));
TComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TRichEdit then
begin
if Trim(fieldByName(mfield).AsString) <> '' then
TRichEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TcxRichEdit then
begin
if Trim(fieldByName(mfield).AsString) <> '' then
TcxRichEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TComboBox then
begin
if TComboBox(Controls[i]).Items.Count > 0 then
begin
idx := TComboBox(Controls[i]).Items.IndexOf(Trim(fieldByName(mfield).AsString));
end
else
idx := -1;
TComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TBtnEditA then
begin
if Trim(TBtnEditA(Controls[i]).Hint) <> '' then
begin
TBtnEditA(TBtnEditA(Controls[i])).TxtCode := Trim(fieldByName(mfield).AsString);
TBtnEditA(Controls[i]).Text := Trim(fieldByName(Trim(TBtnEditA(Controls[i]).Hint)).AsString);
end
else
begin
TBtnEditA(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end;
end
else if Controls[i] is TBtnEditC then
begin
TBtnEditC(TBtnEditA(Controls[i])).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TDateTimePicker then
begin
if Trim(fieldByName(mfield).AsString) = '' then
begin
TDateTimePicker(Controls[i]).Checked := false;
end
else
TDateTimePicker(Controls[i]).DateTime := fieldByName(mfield).AsDateTime;
end
else if Controls[i] is Tmemo then
begin
Tmemo(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TcxDateEdit then
begin
if not isEmpty and not fieldByName(mfield).IsNull then
TcxDateEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcxTimeEdit then
begin
if not isEmpty and (fieldByName(mfield).AsString <> '') then
TcxTimeEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcxCurrencyEdit then
begin
TcxCurrencyEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcheckBox then
begin
TcheckBox(Controls[i]).Checked := fieldByName(mfield).asBoolean;
end
else if Controls[i] is TcxButtonEdit then
begin
TcxButtonEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
if TcxButtonEdit(Controls[i]).ParentShowHint = false then
begin
mfieldCode := Trim(Copy(mfield, 1, Length(mfield) - 4));
TcxButtonEdit(Controls[i]).Hint := Trim(fieldByName(mfieldCode).AsString);
end;
end;
end; // end for
end; // end with
end; // end for with
end;
function Utf8Encode(const WS: WideString): UTF8String;
var
L: Integer;
Temp: UTF8String;
begin
Result := '';
if WS = '' then
exit;
SetLength(Temp, Length(WS) * 3);
// SetLength includes space for null terminator
L := UnicodeToUtf8(PAnsiChar(Temp), Length(Temp) + 1, PWideChar(WS), Length(WS));
if L > 0 then
SetLength(Temp, L - 1)
else
Temp := '';
Result := Temp;
end;
procedure GetFileInfo(mFile: string; var mfileSize: Integer; var CreationTime: TdateTime; var WriteTime: TdateTime);
var
vSearchRec: TSearchRec;
begin
FindFirst(mFile, faAnyFile, vSearchRec);
mfileSize := vSearchRec.Size;
CreationTime := CovFileDate(vSearchRec.FindData.ftCreationTime); // 创建时间
// vSearchRec.FindData.ftLastAccessTime//访问时间
WriteTime := CovFileDate(vSearchRec.FindData.ftLastWriteTime); // 修改时间
FindClose(vSearchRec);
end;
procedure GetFileEditTime(mFile: string; var editTime: TdateTime);
var
vSearchRec: TSearchRec;
begin
FindFirst(mFile, faAnyFile, vSearchRec);
// mfileSize:=vSearchRec.Size;
// CreationTime:=CovFileDate(vSearchRec.FindData.ftCreationTime);//创建时间
// vSearchRec.FindData.ftLastAccessTime//访问时间
editTime := CovFileDate(vSearchRec.FindData.ftLastWriteTime); // 修改时间
FindClose(vSearchRec);
end;
function CovFileDate(Fd: _FileTime): TdateTime;
var
Tct: _SystemTime;
Temp: _FileTime;
begin
FileTimeToLocalFileTime(Fd, Temp);
FileTimeToSystemTime(Temp, Tct);
CovFileDate := SystemTimeToDateTime(Tct);
end;
procedure UpdateFileTime(fileName: string; CreationTime, LastAccessTime, LastWriteTime: TdateTime);
var
FileHnd: Integer;
SysTime: TSystemTime;
tTzi: TTimezoneInformation;
FCreationTime, FLastAccessTime, FLastWriteTime: TFileTime;
begin
GetTimezoneInformation(tTzi);
CreationTime := CreationTime + tTzi.Bias / 1440;
DateTimeToSystemTime(CreationTime, SysTime);
SystemTimeToFileTime(SysTime, FCreationTime);
// LastAccessTime := LastAccessTime + Ttzi.Bias/1440;
// DateTimeToSystemTime(LastAccessTime,SysTime);
// SystemTimeToFileTime(SysTime,FLastAccessTime);
LastWriteTime := LastWriteTime + tTzi.Bias / 1440;
DateTimeToSystemTime(LastWriteTime, SysTime);
SystemTimeToFileTime(SysTime, FLastWriteTime);
try
FileHnd := FileOpen(fileName, fmOpenWrite or fmShareDenyNone);
SetFileTime(FileHnd, @FCreationTime, nil, @FLastWriteTime);
finally
FileClose(FileHnd);
end;
end;
/// ////////////////////////////////////////////////////
// 函数功能:从服务器下载文件;
/// ////////////////////////////////////////////////////
function ExportFtErpFile(mFileName: string; ADORead: TADOQuery): Boolean;
var
Stream: TMemoryStream;
ff: TADOBlobstream;
mfileSize: Integer;
mCreationTime: TdateTime;
mWriteTime: TdateTime;
IsFileHas: Boolean;
mChildPath: string;
mFilePath: string;
begin
try
Result := false;
mChildPath := '';
/// ////////////////////////////////////////////
// 获取文件下载的子路径
with ADORead do
begin
close;
sql.Clear;
sql.Add('select FilePath ');
sql.Add('from RT_FileUpdate');
sql.Add('where FileName=' + quotedStr(mFileName));
Open;
if Recordcount > 0 then
begin
// if not fieldByName('valid').AsBoolean then exit;
if Trim(fieldByName('FilePath').AsString) <> '' then
mChildPath := Trim(fieldByName('FilePath').AsString) + '\';
end;
end;
// 如果产品存在
mFilePath := ExtractFilePath(Paramstr(0)) + mChildPath;
IsFileHas := FileExists(mFilePath + mFileName);
if IsFileHas then
begin
/// ///////////////////////
// 获取文件信息
GetFileInfo(mFilePath + mFileName, mfileSize, mCreationTime, mWriteTime);
end;
/// ///////////////////////////////////////
// 存在文件
if IsFileHas then
begin
with ADORead do
begin
close;
sql.Clear;
sql.Add('select count(FileName) as cnt ');
sql.Add('from RT_FileUpdate');
sql.Add('where FileName=' + quotedStr(mFileName));
// sql.Add('and fileEditDate>'''+formatDateTime('yyyy-MM-dd hh:mm',mWriteTime)+'''');
sql.Add(' and DATEDIFF(minute,' + quotedStr(formatDateTime('yyyy-MM-dd hh:mm', mWriteTime)) + ',fileEditDate)>0');
Open;
// 是否存在新的文件
if fieldByName('cnt').AsInteger > 0 then
begin
close;
sql.Clear;
sql.Add('select * ');
sql.Add('from RT_FileUpdate');
sql.Add('where FileName=' + quotedStr(mFileName));
Open;
ff := TADOBlobstream.create(fieldByName('Files') as TblobField, bmRead);
end
else
begin
exit;
end;
if Trim(fieldByName('FilePath').AsString) <> '' then
mChildPath := Trim(fieldByName('FilePath').AsString) + '\';
end;
end /// ///////////////////////////////////
// 不存在
else
begin
with ADORead do
begin
close;
sql.Clear;
sql.Add('select * ');
sql.Add('from RT_FileUpdate');
sql.Add('where FileName=' + quotedStr(mFileName));
Open;
if Recordcount > 0 then
begin
ff := TADOBlobstream.create(fieldByName('Files') as TblobField, bmRead);
end
else
begin
exit;
end;
if Trim(fieldByName('FilePath').AsString) <> '' then
mChildPath := Trim(fieldByName('FilePath').AsString) + '\';
end;
end;
if ff <> nil then
begin
try
mFileName := Trim(ADORead.fieldByName('FileName').AsString);
if not DirectoryExists(ExtractFileDir(mFilePath + mFileName)) then
ForceDirectories(ExtractFileDir(mFilePath + mFileName));
Stream := TMemoryStream.create;
// OleContainer1.SaveToStream(Stream);
// ADOQuery1FileContent.SaveToFile('tmp'); //数据存入临时文件
// OleContainer1.LoadFromFile('tmp'); //从临时文件中读取OLE对象
ff.SaveToStream(Stream);
// OleContainer1.SaveToFile(ExtractFilePath(Paramstr(0))+mfielName)
Stream.SaveToFile(mFilePath + mFileName); // +'\tmpFile\'
// OleContainer1.SaveToFile('tmp');
finally
Stream.Free;
end;
end;
UpdateFileTime(mFilePath + mFileName, ADORead.fieldByName('FileCreateDate').AsDateTime, ADORead.fieldByName('FileEditDate').AsDateTime, ADORead.fieldByName('FileEditDate').AsDateTime);
Result := true;
except
application.MessageBox(PWideChar('读取文件' + mFileName + '失败!'), '提示信息', 0);
end;
end;
/// /////////////////////////////////////////////////////
procedure GetHTTP(FUrl: string);
var
IdHTTP: TIdHTTP;
ResponseStream: TStringStream; // 返回信息
ResponseStr: string;
begin
// 创建IDHTTP控件
IdHTTP := TIdHTTP.create(nil);
IdHTTP.HTTPOptions := IdHTTP.HTTPOptions + [hoKeepOrigProtocol];
// TStringStream对象用于保存响应信息
ResponseStream := TStringStream.create('');
try
try
IdHTTP.Get(FUrl, ResponseStream); // 请求地址
except
on e: Exception do
begin
ShowMessage(e.Message);
end;
end;
// 获取网页返回的信息
ResponseStr := ResponseStream.DataString;
// 网页中的存在中文时需要进行UTF8解码
ResponseStr := UTF8Decode(ResponseStr);
// ShowMessage(ResponseStr);
finally
IdHTTP.Free;
ResponseStream.Free;
end;
end;
function RoundFloat(f: double; i: Integer): double;
var
S: string;
ef: Extended;
begin
if f = 0 then
begin
Result := 0;
exit;
end;
S := '#.' + StringOfChar('0', i);
if S = '#.' then
S := '#';
ef := StrToFloat(FloatToStr(f)); // 防止浮点运算的误差
Result := StrToFloat(FormatFloat(S, ef));
end;
procedure InitDllEvt(FromFile: string; FormID: Integer; Para: string; FormType: Integer; Title: string; Def1: string; Def2: string; Def3: string; Def4: string; Def5: string; Def6: string; Def7: string; Def8: string; Def9: string; Def10: string);
var
Th: HMODULE;
begin
Th := LoadLibrary(PWideChar(FromFile));
if Th > 0 then
begin
TP := GetProcAddress(Th, 'GetDllForm');
if TP <> nil then
begin
Tf := TMyF(TP);
Tf(application, 0, FormID, 0, FormType, PWideChar(DCode), PWideChar(DName), PWideChar(Para), PWideChar(Title), PWideChar(Def1), PWideChar(Def2), PWideChar(Def3), PWideChar(Def4), PWideChar(Def5), PWideChar(Def6), PWideChar(Def7), PWideChar(Def8), PWideChar(Def9), PWideChar(Def10), PWideChar(DConString));
end;
end
else
begin
application.MessageBox(PWideChar('打不开文件' + FromFile + ''), '错误', MB_ICONERROR);
end;
end;
function RTSetSaveDataCDS(ADOQueryCmd: TADOQuery; Tv1: TcxGridDBTableView; CDS_Sub: TclientDataSet; MyTable: string; MyTag: Integer): Boolean;
var
i: Integer;
begin
try
Result := false;
for i := 0 to Tv1.ColumnCount - 1 do
begin
if Tv1.Columns[i].Tag = MyTag then
begin
// if Tv1.Columns[i].Visible = false then
// continue;
if Trim(Tv1.Columns[i].DataBinding.FilterFieldName) = '' then
continue;
begin
if Trim(CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).AsString) <> '' then
begin
ADOQueryCmd.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value;
end
else
begin
if Trim(Tv1.Columns[i].Summary.GroupFooterFormat) = '0' then
begin
ADOQueryCmd.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := 0;
end
else
begin
ADOQueryCmd.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := null;
end;
end;
end;
end;
end;
Result := true;
except
Result := false;
application.MessageBox('设置Cds保存信息失败!', '提示', 0);
end;
end;
function RTSetSaveDataCDSBand(ADOQueryCmd: TADOQuery; Tv1: TcxGridDBBandedTableView; CDS_Sub: TclientDataSet; MyTable: string; MyTag: Integer): Boolean;
var
i: Integer;
begin
try
Result := false;
for i := 0 to Tv1.ColumnCount - 1 do
begin
if Tv1.Columns[i].Tag = MyTag then
begin
if Tv1.Columns[i].Visible = false then
continue;
if Trim(Tv1.Columns[i].DataBinding.FilterFieldName) = '' then
continue;
begin
if Trim(CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).AsString) <> '' then
begin
ADOQueryCmd.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value;
end
else
begin
if Trim(Tv1.Columns[i].Summary.GroupFooterFormat) <> '' then
ADOQueryCmd.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := 0
else
ADOQueryCmd.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := null;
end;
end;
end;
end;
Result := true;
except
Result := false;
application.MessageBox('设置Cds保存信息失败!', '提示', 0);
end;
end;
/// ////////////////////////服务器日期//////////////////////////////////////
// function SGetServerDate(ADOQueryTmp:TADOQuery):TdateTime;
// begin
// try
// with ADOQueryTmp do
// begin
// close;
// sql.Clear;
// sql.Add('select getDate()as dt');
// open;
// result:=StrToDate(formatdatetime('yyyy-MM-dd',fieldByName('dt').AsDatetime));
// close;
// SQL.Clear;
// end;
// except
// application.MessageBox('获取当前日期发生错误!','提示信息',0);
// end;
//
// end;
/// ////////////////////////服务器日期//////////////////////////////////////
function SGetServerDate(ADOQueryTmp: TADOQuery): TdateTime;
begin
with FormatSettings do
begin
ShortDateFormat := 'yyyy-mm-dd';
LongDateFormat := 'yyyy-mm-dd';
ShortTimeFormat := 'hh:nn:ss';
LongTimeFormat := 'hh:nn:ss';
DateSeparator := '-';
TimeSeparator := ':';
end;
try
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select getDate()as dt');
Open;
Result := strToDate(formatDateTime('yyyy-MM-dd', fieldByName('dt').AsDateTime));
close;
sql.Clear;
end;
except
application.MessageBox('获取当前日期发生错误!', '提示信息', 0);
end;
end;
function SGetServerDateTime(ADOQueryTmp: TADOQuery): TdateTime;
begin
with FormatSettings do
begin
ShortDateFormat := 'yyyy-mm-dd';
LongDateFormat := 'yyyy-mm-dd';
ShortTimeFormat := 'hh:nn:ss';
LongTimeFormat := 'hh:nn:ss';
DateSeparator := '-';
TimeSeparator := ':';
end;
try
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select getDate()as dt');
Open;
Result := fieldByName('dt').AsDateTime;
close;
sql.Clear;
end;
except
application.MessageBox('获取当前日期发生错误!', '提示信息', 0);
end;
end;
procedure RTSetsavedata(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: Integer);
var
i: Integer;
begin
with Myparent do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i].Tag = MyTag then
begin
if Controls[i] is TBtnEditA then
begin
ADOQueryCmd.fieldByName(TBtnEditA(Controls[i]).Name).Value := Trim(TBtnEditA(Controls[i]).Text);
if Trim(TBtnEditA(Controls[i]).Hint) <> '' then
begin
if Pos('/', Trim(TBtnEditA(Controls[i]).Hint)) > 0 then
continue;
ADOQueryCmd.fieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value := Trim(TBtnEditA(Controls[i]).TxtCode);
end;
end
else if Controls[i] is TBtnEditC then
begin
ADOQueryCmd.fieldByName(TBtnEditC(Controls[i]).Name).Value := Trim(TBtnEditC(Controls[i]).Text);
if Trim(TBtnEditC(Controls[i]).Hint) <> '' then
begin
if Pos('/', Trim(TBtnEditC(Controls[i]).Hint)) > 0 then
continue;
ADOQueryCmd.fieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value := Trim(TBtnEditC(Controls[i]).TxtCode);
end;
end
else if Controls[i] is TEdit then
begin
if Trim(TEdit(Controls[i]).Text) <> '' then
ADOQueryCmd.fieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Text)
else
begin
if Trim(TEdit(Controls[i]).Hint) <> '' then
ADOQueryCmd.fieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Hint)
else
ADOQueryCmd.fieldByName(Controls[i].Name).Value := null;
end;
end
else if Controls[i] is TRichEdit then
begin
ADOQueryCmd.fieldByName(Controls[i].Name).Value := TRichEdit(Controls[i]).Text;
end
else if Controls[i] is Tmemo then
begin
ADOQueryCmd.fieldByName(Controls[i].Name).Value := Tmemo(Controls[i]).Text;
end
else if Controls[i] is TRTComboBox then
begin
if (TRTComboBox(Controls[i]).Text) <> '' then
ADOQueryCmd.fieldByName(Controls[i].Name).Value := Trim(TRTComboBox(Controls[i]).Item2);
end
else if Controls[i] is TComboBox then
begin
ADOQueryCmd.fieldByName(Controls[i].Name).Value := Trim(TComboBox(Controls[i]).Text);
end
else if Controls[i] is TDateTimePicker then
begin
if TDateTimePicker(Controls[i]).ShowCheckbox then
begin
if TDateTimePicker(Controls[i]).Checked then
ADOQueryCmd.fieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime
else
ADOQueryCmd.fieldByName(Controls[i].Name).Value := null;
end
else
ADOQueryCmd.fieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime;
end
else if Controls[i] is TcxTimeEdit then
begin
ADOQueryCmd.fieldByName(Controls[i].Name).Value := Trim(TcxTimeEdit(Controls[i]).Text);
end;
end;
end;
end;
end;
procedure SClearData(mParent: TWinControl; FTag: Integer);
var
i, idx: Integer;
begin
with mParent do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TLabel then
continue;
if Controls[i].Tag <> FTag then
continue;
if Controls[i] is TEdit then
begin
TEdit(Controls[i]).Text := '';
end
else if Controls[i] is TRichEdit then
begin
TRichEdit(Controls[i]).Text := '';
end
else if Controls[i] is Tmemo then
begin
Tmemo(Controls[i]).Text := '';
end
else if Controls[i] is TDateTimePicker then
begin
if TDateTimePicker(Controls[i]).ShowCheckbox = true then
begin
TDateTimePicker(Controls[i]).Checked := false;
end;
end
else if Controls[i] is TcxRichEdit then
begin
TcxRichEdit(Controls[i]).Text := '';
end
else if Controls[i] is TBtnEditC then
begin
TBtnEditC(Controls[i]).Text := '';
TBtnEditC(Controls[i]).TxtCode := '';
end
else if Controls[i] is TBtnEditA then
begin
TBtnEditA(Controls[i]).Text := '';
TBtnEditA(Controls[i]).TxtCode := '';
end
else if Controls[i] is TComboBox then
begin
idx := -1;
TComboBox(Controls[i]).ItemIndex := idx;
end
end;
end;
end;
procedure SCSHDataCDS(CDS_Main: TclientDataSet; mParent: TWinControl; FTag: Integer);
var
i, idx: Integer;
mfield, mfieldCode: string;
ma: TA;
begin
with CDS_Main do
begin
if isEmpty then
exit;
with mParent do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TLabel then
continue;
if Controls[i].Tag <> FTag then
continue;
mfield := Controls[i].Name;
/// ////////////////////////
// EDIT
if Controls[i] is TEdit then
begin
if Trim(fieldByName(mfield).AsString) <> '' then
TEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end // ftcombobox
else if Controls[i] is TRTComboBox then
begin
idx := TRTComboBox(Controls[i]).IndexOfItem2(Trim(fieldByName(mfield).AsString));
TComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TRichEdit then
begin
if Trim(fieldByName(mfield).AsString) <> '' then
TRichEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TcxRichEdit then
begin
if Trim(fieldByName(mfield).AsString) <> '' then
TcxRichEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end // combobox
else if Controls[i] is TComboBox then
begin
if TComboBox(Controls[i]).Items.Count > 0 then
begin
idx := TComboBox(Controls[i]).Items.IndexOf(Trim(fieldByName(mfield).AsString));
end
else
idx := -1;
TComboBox(Controls[i]).ItemIndex := idx;
end
else if Controls[i] is TBtnEditA then
begin
TBtnEditA(Controls[i]).TxtCode := Trim(fieldByName(mfield).AsString);
if Trim(TBtnEditA(Controls[i]).Hint) <> '' then
TBtnEditA(Controls[i]).Text := Trim(fieldByName(Trim(TBtnEditA(Controls[i]).Hint)).AsString);
end
else if Controls[i] is TBtnEditC then
begin
TBtnEditC(Controls[i]).TxtCode := Trim(fieldByName(mfield).AsString);
if Trim(TBtnEditC(Controls[i]).Hint) <> '' then
TBtnEditC(Controls[i]).Text := Trim(fieldByName(Trim(TBtnEditC(Controls[i]).Hint)).AsString);
end
else if Controls[i] is TDateTimePicker then
begin
if Trim(fieldByName(mfield).AsString) = '' then
begin
TDateTimePicker(Controls[i]).Checked := false;
end
else
TDateTimePicker(Controls[i]).DateTime := fieldByName(mfield).AsDateTime;
end
else if Controls[i] is Tmemo then
begin
Tmemo(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
end
else if Controls[i] is TcxDateEdit then
begin
if not isEmpty and not fieldByName(mfield).IsNull then
TcxDateEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcxTimeEdit then
begin
if not isEmpty and (fieldByName(mfield).AsString <> '') then
TcxTimeEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcxCurrencyEdit then
begin
TcxCurrencyEdit(Controls[i]).Text := fieldByName(mfield).AsString;
end
else if Controls[i] is TcheckBox then
begin
TcheckBox(Controls[i]).Checked := fieldByName(mfield).asBoolean;
end
else if Controls[i] is TcxButtonEdit then
begin
TcxButtonEdit(Controls[i]).Text := Trim(fieldByName(mfield).AsString);
if TcxButtonEdit(Controls[i]).ParentShowHint = false then
begin
mfieldCode := Trim(Copy(mfield, 1, Length(mfield) - 4));
TcxButtonEdit(Controls[i]).Hint := Trim(fieldByName(mfieldCode).AsString);
end;
end;
end; // end for
end; // end with
end; // end for with
end;
/// /////////////////////////////////////////
/// /************获取过滤条件***********/////
/// /////////////////////////////////////////
function SGetFilters(TMPanel: TPanel; EquTag, LikeTag: Integer): string;
var
i, j, k: Integer;
fsj, fsj1: string;
begin
Result := '';
with TMPanel do
begin
for i := 0 to ControlCount - 1 do
begin
if Controls[i] is TLabel then
continue;
if Controls[i] is TEdit then
begin
if Trim(TEdit(Controls[i]).Text) <> '' then
begin
if Controls[i].Tag = EquTag then
Result := Result + 'and ' + Controls[i].Name + '=' + quotedStr(Trim(TEdit(Controls[i]).Text))
else if Controls[i].Tag = LikeTag then
begin
j := Pos(' ', Trim(TEdit(Controls[i]).Text));
if j > 0 then
begin
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr('%' + Copy(Trim(TEdit(Controls[i]).Text), 1, j - 1) + '%');
fsj1 := Copy(Trim(TEdit(Controls[i]).Text), j + 1, Length(Trim(TEdit(Controls[i]).Text)));
while Trim(fsj1) <> '' do
begin
j := Pos(' ', Trim(fsj1));
if j > 0 then
begin
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr('%' + Copy(Trim(fsj1), 1, j - 1) + '%');
fsj1 := Copy(Trim(fsj1), j + 1, Length(Trim(fsj1)));
end
else
begin
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr('%' + Trim(fsj1) + '%');
fsj1 := '';
end;
end;
end
else
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr('%' + Trim(TEdit(Controls[i]).Text) + '%');
end;
end;
end
else if Controls[i] is TBtnEditA then
begin
if Trim(TBtnEditA(Controls[i]).Text) <> '' then
begin
if Controls[i].Tag = EquTag then
Result := Result + 'and ' + Controls[i].Name + '=' + quotedStr(Trim(TBtnEditA(Controls[i]).TxtCode))
else if Controls[i].Tag = LikeTag then
Result := Result + 'and ' + Controls[i].Name + 'Name' + ' like ' + quotedStr('%' + Trim(TBtnEditA(Controls[i]).Text) + '%')
else if Controls[i].Tag = 99 then
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr(Trim(TBtnEditA(Controls[i]).TxtCode) + '%');
end;
end
else if Controls[i] is TBtnEditC then
begin
if Trim(TBtnEditC(Controls[i]).TxtCode) <> '' then
begin
if Controls[i].Tag = EquTag then
Result := Result + 'and ' + Controls[i].Name + '=' + quotedStr(Trim(TBtnEditC(Controls[i]).TxtCode))
else if Controls[i].Tag = LikeTag then
Result := Result + 'and ' + Controls[i].Name + 'Name' + ' like ' + quotedStr('%' + Trim(TBtnEditC(Controls[i]).Text) + '%');
end;
end
else if Controls[i] is TRTComboBox then
begin
if Trim(TRTComboBox(Controls[i]).Text) <> '' then
if Controls[i].Tag = EquTag then
Result := Result + 'and ' + Controls[i].Name + '=' + quotedStr(Trim(TRTComboBox(Controls[i]).Item2))
else if Controls[i].Tag = LikeTag then
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr('%' + Trim(TRTComboBox(Controls[i]).Item2) + '%');
end
else if Controls[i] is TComboBox then
begin
if Trim(TComboBox(Controls[i]).Text) <> '' then
if Controls[i].Tag = EquTag then
Result := Result + 'and ' + Controls[i].Name + '=' + quotedStr(Trim(TComboBox(Controls[i]).Text))
else if Controls[i].Tag = LikeTag then
Result := Result + 'and ' + Controls[i].Name + ' like ' + quotedStr('%' + Trim(TComboBox(Controls[i]).Text) + '%');
end;
end;
end;
if Trim(Result) <> '' then
Result := Trim(RightStr(Result, Length(Result) - 4));
end;
/// /////////////////////////////////////////////////////////
// 公用过滤函数
/// /////////////////////////////////////////////////////////
procedure SDofilter(ADOQry: TADOQuery; FilterStr: string);
begin
try
ADOQry.DisableControls;
with ADOQry do
begin
if Trim(FilterStr) = '' then
begin
Filtered := false;
end
else
begin
Filtered := false;
Filter := FilterStr;
Filtered := true;
end;
end;
finally
ADOQry.EnableControls;
end;
end;
procedure SCreateCDS(SADOQry: TADOQuery; mClientDataset: TclientDataSet);
var
i: Integer;
mfieldName: string;
mSize: Integer;
begin
mfieldName := '';
mClientDataset.FieldDefs.Clear;
with SADOQry do
begin
for i := 0 to fieldCount - 1 do //
begin
if (Fields[i].DataType = ftString) and (Fields[i].Size = 0) then
begin
mSize := 1;
end
else
mSize := Fields[i].Size;
mfieldName := Trim(Fields[i].FieldName);
mClientDataset.FieldDefs.Add(mfieldName, Fields[i].DataType, mSize);
end;
end;
mClientDataset.FieldDefs.Add('Sflag', ftString, 1);
mClientDataset.FieldDefs.Add('Sindex', ftInteger, 0);
mClientDataset.FieldDefs.Add('Ssel', ftBoolean, 0);
mClientDataset.FieldDefs.Add('SDefNote', ftString, 10);
mClientDataset.FieldDefs.Add('XHNoTemp', ftFloat, 0);
mClientDataset.close;
mClientDataset.CreateDataSet;
end;
procedure SInitCDSData(fromADO: TADOQuery; toCDS: TclientDataSet);
var
i: Integer;
k: Integer;
begin
if fromADO.isEmpty then
exit;
fromADO.first;
k := 1;
try
toCDS.DisableControls;
toCDS.Filtered := false;
while not fromADO.Eof do
begin
with toCDS do
begin
append;
for i := 0 to fromADO.fieldCount - 1 do
begin
Fields[i].Value := fromADO.Fields[i].Value;
end;
fieldByName('Sflag').AsString := '1';
fieldByName('Sindex').Value := k;
fieldByName('Ssel').Value := false;
fieldByName('SDefNote').Value := '';
inc(k);
post;
end;
fromADO.Next;
end;
if not toCDS.isEmpty then
begin
toCDS.first;
end;
finally
toCDS.EnableControls;
end;
end;
procedure SInitRadioGroupBySql(ADOQueryTmp: TADOQuery; rg: TRadioGroup; emptyFlag: Boolean; mSql: string);
begin
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add(mSql);
Open;
if isEmpty then
begin
exit;
end;
rg.Items.Clear;
while not Eof do
begin
rg.Items.Add(Trim(fieldByName('Name').AsString));
Next;
end;
if not emptyFlag then
rg.Items.Add('');
if emptyFlag and (rg.Items.Count > 0) then
rg.ItemIndex := 0;
end;
end;
procedure SInitComBoxBySql(ADOQueryTmp: TADOQuery; cb: TComboBox; emptyFlag: Boolean; mSql: string);
begin
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add(mSql);
Open;
if isEmpty then
begin
// plication.MessageBox(PWideChar(showMsg),'',0);
exit;
end;
cb.Clear;
while not Eof do
begin
cb.Items.Add(Trim(fieldByName('Name').AsString));
Next;
end;
if not emptyFlag then
cb.Items.Add('');
if emptyFlag and (cb.Items.Count > 0) then
cb.ItemIndex := 0;
end;
end;
procedure SInitCxGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGriddbColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
var
A: TA;
begin
(c3.Properties as TcxComboBoxProperties).Items.Clear;
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add(FSql);
Open;
if isEmpty then
begin
// Application.MessageBox(PWideChar('未找到:'+shmeg),'',0);
exit;
end;
while not Eof do
begin
A := TA.create(Nil);
A.S := Trim(fieldByName('Code').AsString);
if PState = 1 then
(c3.Properties as TcxComboBoxProperties).Items.AddObject(Trim(fieldByName('name').AsString), TObject(A))
else if PState = 0 then
begin
(c3.Properties as TcxComboBoxProperties).Items.Add(Trim(fieldByName('name').AsString));
end;
Next;
end;
if not IsNull then
begin
(c3.Properties as TcxComboBoxProperties).Items.Add('');
end;
end;
end;
procedure SInitCxBandGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGridDBBandedColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string);
var
A: TA;
begin
(c3.Properties as TcxComboBoxProperties).Items.Clear;
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add(FSql);
Open;
if isEmpty then
begin
application.MessageBox(PWideChar('未找到:' + Shmeg), '', 0);
exit;
end;
while not Eof do
begin
A := TA.create(Nil);
A.S := Trim(fieldByName('Code').AsString);
if PState = 1 then
(c3.Properties as TcxComboBoxProperties).Items.AddObject(Trim(fieldByName('name').AsString), TObject(A))
else if PState = 0 then
begin
(c3.Properties as TcxComboBoxProperties).Items.Add(Trim(fieldByName('name').AsString));
end;
Next;
end;
if not IsNull then
begin
(c3.Properties as TcxComboBoxProperties).Items.Add('');
end;
end;
end;
// 复制增行
procedure CopyAddRow(Tv1: TcxGridDBTableView; CDS_Sub: TclientDataSet);
var
AA: array[0..50] of string;
i, j: Integer;
begin
if CDS_Sub.isEmpty then
begin
CDS_Sub.append;
CDS_Sub.post;
exit;
end;
for i := 0 to Tv1.ColumnCount - 1 do
begin
AA[i] := Trim(CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).AsString);
end;
with CDS_Sub do
begin
append;
for i := 0 to Tv1.ColumnCount - 1 do
begin
if AA[i] <> '' then
begin
CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := AA[i];
end;
end;
post;
end;
end;
procedure CopyAddRowBand(Tv1: TcxGridDBBandedTableView; CDS_Sub: TclientDataSet);
var
AA: array[0..300] of string;
i, j: Integer;
begin
if CDS_Sub.isEmpty then
begin
CDS_Sub.append;
CDS_Sub.post;
exit;
end;
for i := 0 to Tv1.ColumnCount - 1 do
begin
AA[i] := Trim(CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).AsString);
end;
with CDS_Sub do
begin
append;
for i := 0 to Tv1.ColumnCount - 1 do
begin
if AA[i] <> '' then
begin
CDS_Sub.fieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := AA[i];
end;
end;
post;
end;
end;
// 复制增行
procedure CopyAddRowCDS(CDS_Sub: TclientDataSet);
var
AA: array[0..300] of string;
i, j: Integer;
begin
if CDS_Sub.isEmpty then
exit;
for i := 0 to CDS_Sub.fieldCount - 1 do
begin
AA[i] := Trim(CDS_Sub.fieldByName(CDS_Sub.Fields[i].FieldName).AsString);
end;
with CDS_Sub do
begin
append;
for i := 0 to CDS_Sub.fieldCount - 1 do
begin
if AA[i] <> '' then
begin
CDS_Sub.fieldByName(CDS_Sub.Fields[i].FieldName).Value := AA[i];
end;
end;
post;
end;
end;
// 复制增行
procedure CopyAddRowCDS2(CDS_1, CDS_2: TclientDataSet);
var
i: Integer;
begin
if CDS_1.isEmpty then
exit;
with CDS_2 do
begin
append;
for i := 0 to CDS_1.fieldCount - 1 do
begin
if CDS_1.Fields[i].FieldName <> 'XHNoTemp' then
CDS_2.fieldByName(CDS_1.Fields[i].FieldName).Value := Trim(CDS_1.fieldByName(CDS_1.Fields[i].FieldName).AsString);
end;
post;
end;
end;
procedure OneKeyPost(Tv1: TcxGridDBTableView; CDS_Sub: TclientDataSet);
var
FValue, FFValue, FColumn, FFColumn: string;
begin
// FColumn:=tv1.Columns[Tv1.Controller.FocusedColumnIndex].DataBinding.FieldName;
// FFColumn:=Tv1.Columns[Tv1.Controller.FocusedColumnIndex].Summary.GroupFormat;
FColumn := Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName;
FFColumn := Tv1.Controller.FocusedColumn.Summary.GroupFormat;
FValue := Trim(CDS_Sub.fieldByName(FColumn).AsString);
if Trim(FFColumn) <> '' then
begin
FFValue := Trim(CDS_Sub.fieldByName(FFColumn).AsString);
end;
with CDS_Sub do
begin
DisableControls;
first;
while not Eof do
begin
edit;
if FValue = '' then
begin
CDS_Sub.fieldByName(FColumn).Value := null;
end
else
begin
CDS_Sub.fieldByName(FColumn).Value := FValue;
end;
if Trim(FFColumn) <> '' then
begin
if FFValue = '' then
begin
CDS_Sub.fieldByName(FFColumn).Value := null;
end
else
begin
CDS_Sub.fieldByName(FFColumn).Value := FFValue;
end;
end;
post;
Next;
end;
EnableControls;
end;
end;
procedure OneKeyPostBand(Tv1: TcxGridDBBandedTableView; CDS_Sub: TclientDataSet);
var
FValue, FFValue, FColumn, FFColumn: string;
begin
// FColumn:=tv1.Columns[Tv1.Controller.FocusedColumnIndex].DataBinding.FieldName;
// FFColumn:=Tv1.Columns[Tv1.Controller.FocusedColumnIndex].Summary.GroupFormat;
FColumn := Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName;
FFColumn := Tv1.Controller.FocusedColumn.Summary.GroupFormat;
FValue := Trim(CDS_Sub.fieldByName(FColumn).AsString);
if Trim(FFColumn) <> '' then
begin
FFValue := Trim(CDS_Sub.fieldByName(FFColumn).AsString);
end;
with CDS_Sub do
begin
DisableControls;
first;
while not Eof do
begin
edit;
if FValue = '' then
begin
CDS_Sub.fieldByName(FColumn).Value := null;
end
else
begin
CDS_Sub.fieldByName(FColumn).Value := FValue;
end;
if Trim(FFColumn) <> '' then
begin
if FFValue = '' then
begin
CDS_Sub.fieldByName(FFColumn).Value := null;
end
else
begin
CDS_Sub.fieldByName(FFColumn).Value := FFValue;
end;
end;
post;
Next;
end;
EnableControls;
end;
end;
/// ////////////////////////////////////////////////
// 函数功能:取流水号
// mFlag:前缀mTable:表名
// mlen:流水号长度; mtype:是否带日期 1带 0 不带
/// ////////////////////////////////////////////////
function GetLSNo(ADOQueryTmp: TADOQuery; var mMaxNo: string; mFlag: string; mTable: string; mlen: Integer; mtype: Integer = 0): Boolean;
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('exec Get_SY_MaxBH ');
sql.Add(' ' + quotedStr(mFlag));
sql.Add(',' + quotedStr(mTable));
sql.Add(',' + intTostr(mlen));
sql.Add(',' + intTostr(mtype));
// ShowMessage(SQL.Text);
Open;
if Recordcount > 0 then
begin
mMaxNo := Trim(fieldByName('MaxBH').AsString);
if mMaxNo <> '' then
Result := true
else
Result := false;
end
else
begin
Result := false;
end;
end;
if not Result then
application.MessageBox(PWideChar('无法生成流水号(' + mFlag + ')'), '提示信息', MB_ICONINFORMATION);
except
Result := false;
application.MessageBox(PWideChar('无法生成流水号(' + mFlag + ')'), '提示信息', MB_ICONINFORMATION);
end;
end;
procedure ReadCxGrid(fileName: string; cxGrid: TcxGridDBTableView; filePack: string = '公用');
var
mFileName: string;
begin
mFileName := ExtractFilePath(application.ExeName) + 'Layout\' + filePack + '\' + Trim(fileName) + '.dbg';
// 从布局文件中恢复
if FileExists(mFileName) then
cxGrid.RestoreFromIniFile(mFileName, false, false);
end;
/// ////////////////////////////////////////////////////////////
// 函数功能从文件中读取cxGridCol设置
// fileName 推荐为窗口的caption名字caption名字
/// ////////////////////////////////////////////////////////////
procedure ReadCxBandedGrid(fileName: string; cxGrid: TcxGridDBBandedTableView; filePack: string = '公用');
var
mFileName: string;
begin
mFileName := ExtractFilePath(application.ExeName) + 'Layout\' + filePack + '\' + Trim(fileName) + '.dbg';
// 从布局文件中恢复
if FileExists(mFileName) then
cxGrid.RestoreFromIniFile(mFileName);
end;
/// ////////////////////////////////////////////////////////////
// 函数功能写cxGridCol设置到.dbg文件中
// 默认推荐为窗口的caption名字
/// ////////////////////////////////////////////////////////////
procedure WriteCxGrid(fileName: string; cxGrid: TcxGridDBTableView; filePack: string = '公用');
var
mFileName: string;
begin
mFileName := ExtractFilePath(application.ExeName) + 'Layout\' + filePack + '\' + Trim(fileName) + '.dbg';
if not DirectoryExists(ExtractFileDir(mFileName)) then
CreateDir(ExtractFileDir(mFileName));
// 保存为布局文件
cxGrid.StoreToIniFile(mFileName);
end;
/// ////////////////////////////////////////////////////////////
// 函数功能写cxGridCol设置到.dbg文件中
// 默认推荐为窗口的caption名字
/// ////////////////////////////////////////////////////////////
procedure WriteCxBandedGrid(fileName: string; cxGrid: TcxGridDBBandedTableView; filePack: string = '公用');
var
mFileName: string;
begin
mFileName := ExtractFilePath(application.ExeName) + 'Layout\' + filePack + '\' + Trim(fileName) + '.dbg';
if not DirectoryExists(ExtractFileDir(mFileName)) then
CreateDir(ExtractFileDir(mFileName));
// 保存为布局文件
cxGrid.StoreToIniFile(mFileName);
end;
procedure TcxGridToExcel(mFileName: string; gridName: TcxGrid);
var
saveDialog: TSaveDialog;
begin
try
saveDialog := TSaveDialog.create(nil);
saveDialog.Filter := 'xls(*.xls)|*.xls|全部(*.*)|*.*';
saveDialog.Options := [ofOverwritePrompt];
saveDialog.fileName := mFileName;
if saveDialog.Execute then
if Assigned(gridName) then
begin
try
ExportGridToExcel(saveDialog.fileName, gridName);
except
application.MessageBox('创建失败,源文件可能处于编辑状态!', '提示信息', 0);
exit;
end;
application.MessageBox('成功导出!', '提示信息', 0);
end
else
application.MessageBox('导出失败!', '提示信息', 0);
finally
saveDialog.Free;
end;
end;
procedure SelOKNo(CDS_MainSel: TclientDataSet; FSel: Boolean);
begin
if CDS_MainSel.isEmpty then
exit;
CDS_MainSel.DisableControls;
with CDS_MainSel do
begin
first;
while not Eof do
begin
if fieldByName('SSel').asBoolean = not FSel then
begin
edit;
fieldByName('SSel').Value := FSel;
post;
end;
Next;
end;
end;
CDS_MainSel.EnableControls;
end;
procedure SelOKNoFiler(Tv1: TcxGridDBTableView; FSel: Boolean);
var
i: integer;
begin
Screen.Cursor := crHourGlass;
Tv1.BeginUpdate();
Tv1.DataController.GotoFirst;
for i := 0 to Tv1.DataController.FilteredRecordCount - 1 do
begin
Tv1.DataController.GetItemByFieldName('ssel').EditValue := FSel;
Tv1.DataController.GotoNext;
end;
Screen.Cursor := crDefault;
Tv1.EndUpdate;
end;
function FormatTitle(S: string): string;
{ 将字符串中的半角替换成全角字符 }
var
OldStr, NewStr: AnsiString;
i: Integer;
const
SiStr = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ`1234567890-=\~!#$%^&()_+|[]{};'':",./<>?';
DoStr = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ`1234567890-=\~!#$%^&()_+|[]{};':",。/<>?';
begin
for i := 1 to 95 do
begin
OldStr := Copy(SiStr, i, 1);
NewStr := Copy(DoStr, 2 * i - 1, 2);
S := StringReplace(S, OldStr, NewStr, [rfReplaceAll]);
end;
S := Trim(S);
Result := S;
end;
////////////////////////////
procedure selectDataRow(Sender: TcxCustomGridTableView; mKeyField: string);
var
idx, i: integer;
mvalue: string;
begin
if TcxGridDbTableView(Sender).GetColumnByFieldName('ssel') = nil then
exit;
if TcxGridDbTableView(Sender).GetColumnByFieldName(mKeyField) = nil then
exit;
idx := TcxGridDbTableView(Sender).GetColumnByFieldName(mKeyField).Index;
try
TcxGridDbTableView(Sender).BeginUpdate();
TcxGridDbTableView(Sender).DataController.DataSet.DisableControls;
TcxGridDbTableView(Sender).DataController.DataSet.First;
while not TcxGridDbTableView(Sender).DataController.DataSet.eof do
begin
if TcxGridDbTableView(Sender).DataController.GetItemByFieldName('ssel').EditValue = true then
begin
TcxGridDbTableView(Sender).DataController.DataSet.Edit;
TcxGridDbTableView(Sender).DataController.DataSet.FieldByName('ssel').value := false;
TcxGridDbTableView(Sender).DataController.DataSet.Post();
end;
TcxGridDbTableView(Sender).DataController.DataSet.next;
end;
/////////////////////
for i := 0 to TcxGridDbTableView(Sender).DataController.GetSelectedCount - 1 do
begin
mvalue := TcxGridDbTableView(Sender).DataController.GetValue(TcxGridDbTableView(Sender).DataController.GetSelectedRowIndex(i), idx);
if TcxGridDbTableView(Sender).DataController.DataSet.Locate(mKeyField, mvalue, []) then
begin
TcxGridDbTableView(Sender).DataController.DataSet.Edit;
TcxGridDbTableView(Sender).DataController.DataSet.FieldByName('ssel').value := true;
//ShowMessage();
TcxGridDbTableView(Sender).DataController.DataSet.Post;
end;
end;
finally
TcxGridDbTableView(Sender).DataController.DataSet.EnableControls;
TcxGridDbTableView(Sender).EndUpdate;
end;
end;
end.