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.