From 56ab7867a387e46d8b7498752b8dd560727d1ae6 Mon Sep 17 00:00:00 2001 From: "DESKTOP-E401PHE\\Administrator" Date: Mon, 20 Oct 2025 11:30:39 +0800 Subject: [PATCH] =?UTF-8?q?=E4=BF=AE=E6=94=B9=E4=B8=80=E7=A0=81=E9=80=9A?= =?UTF-8?q?=E7=9A=84=E4=B8=80=E4=BA=9B=E5=86=85=E5=AE=B9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Z99Dependency/ThreeFun/Fun/U_Fun.pas | 8696 +++++++++-------- .../ThreeFun/Fun/U_SelExportField.dfm | 2 +- .../ThreeFun/Fun/U_SelExportField.pas | 17 +- 云翔一码通/U_GetDllForm.pas | 92 +- 云翔一码通/U_YMTFHDataList.dfm | 14 +- 云翔一码通/U_YMTFHDataList.pas | 1 + 云翔一码通/U_YMTFHSQInPut.dfm | 145 +- 云翔一码通/U_YMTFHSQInPut2.dfm | 480 + 云翔一码通/U_YMTFHSQInPut2.pas | 586 ++ 云翔一码通/U_YMTFHSQList.dfm | 199 +- 云翔一码通/U_YMTFHSQList.pas | 93 +- 云翔一码通/U_YMTJGWCList.dfm | 19 +- 云翔一码通/U_YMTJGWCList.pas | 5 +- 云翔一码通/U_YMTRKInPut.dfm | 94 +- 云翔一码通/U_YMTRKInPut.pas | 549 +- 云翔一码通/U_YMTRKList.dfm | 388 +- 云翔一码通/U_YMTRKList.pas | 335 +- 云翔一码通/U_YMTStockList.dfm | 799 ++ 云翔一码通/U_YMTStockList.pas | 345 + 云翔一码通/U_YMTStockSel.dfm | 616 ++ 云翔一码通/U_YMTStockSel.pas | 259 + 云翔一码通/YXYMT.dof | 2 +- 云翔一码通/YXYMT.dpr | 7 +- 云翔一码通/superobject.pas | 7502 ++++++++++++++ 云翔一码通/util_utf8.pas | 85 + 云翔生产管理(MYSC.dll)/U_KuWeiList.dfm | 113 +- 云翔生产管理(MYSC.dll)/U_KuWeiList.pas | 205 +- 27 files changed, 16779 insertions(+), 4869 deletions(-) create mode 100644 云翔一码通/U_YMTFHSQInPut2.dfm create mode 100644 云翔一码通/U_YMTFHSQInPut2.pas create mode 100644 云翔一码通/U_YMTStockList.dfm create mode 100644 云翔一码通/U_YMTStockList.pas create mode 100644 云翔一码通/U_YMTStockSel.dfm create mode 100644 云翔一码通/U_YMTStockSel.pas create mode 100644 云翔一码通/superobject.pas create mode 100644 云翔一码通/util_utf8.pas diff --git a/Z99Dependency/ThreeFun/Fun/U_Fun.pas b/Z99Dependency/ThreeFun/Fun/U_Fun.pas index 663c4fd..12c4046 100644 --- a/Z99Dependency/ThreeFun/Fun/U_Fun.pas +++ b/Z99Dependency/ThreeFun/Fun/U_Fun.pas @@ -1,4291 +1,4415 @@ -unit U_Fun; - -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,FTComboBox,cxDropDownEdit,cxGridBandedTableView, - cxGridDBBandedTableView,cxRichEdit,cxButtonEdit,IniFiles,WinSock,dxCore,ActiveX; -//Function sendarp(ipaddr:ulong;temp:dword;ulmacaddr:pointer;ulmacaddrleng:pointer) : DWord; StdCall; External 'Iphlpapi.dll' Name 'SendARP'; -type - TA = class(TComponent) - public - S:string; -end; - - function SGetMaxId(AdoQueryTemp:TADOQuery;MyTable:string;MyField:string;Var MaxId:Integer):Boolean; - function SIsRepeated(AdoQueryTemp:TADOQuery;MyTable:string;MyField:string;MyCode:String):Boolean; - function SSetSaveDataCDS(AdoQueryCmd:TADOQuery;Tv1:TcxGridDBTableView; - CDS_Sub:TClientDataSet;MyTable:string;MyTag:Integer):Boolean; - function SSetSaveDataCDS10(AdoQueryCmd:TADOQuery;Tv1:TcxGridDBBandedTableView; - CDS_Sub:TClientDataSet;MyTable:string;MyTag:Integer):Boolean; - function SGetServerDate(ADOQueryTmp:TADOQuery):TdateTime; - procedure SSetsavedata(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); - procedure SSetWinData(ADOQueryTmp:TADOQuery;mParent:TWinControl); - function SDelData(ADOQueryCmd:TADOQuery;mDelStr:String):Boolean; - function SGetFilters(TMPanel:TPanel;EquTag,LikeTag:Integer):string; - function SGetFiltersHint(TMPanel:TPanel;EquTag,LikeTag:Integer):string; - procedure SDofilter(ADOQry:TADOQuery;FilterStr:string); - function SGetMaxNo(MyAdoQuery:TADOQuery;MyTable:string;MyField:string;MyFlag:string):String; - procedure SCreateCDS20(SADOQry:TADOQuery; mClientDataset:TclientDataSet ); - procedure SInitCDSData20(fromADO:TADOQuery;toCDS:TclientDataSet); - procedure SCreateCDSYS(SADOQry:TADOQuery; mClientDataset:TclientDataSet ); - procedure SInitCDSDataYS(fromADO:TADOQuery;toCDS:TclientDataSet); - procedure SInitFtComBoxBySql(ADOQueryTmp:TADOQuery; - cb: TFtComboBox;FlagType:string; - Boxtype:integer; - showMsg:string; - emptyFlag:Boolean; - mSql:string - ); - procedure SInitComBoxBySql(ADOQueryTmp:TADOQuery; - cb: TComboBox; - emptyFlag:Boolean; - mSql:string - ); - procedure SInitComBoxByCustCode(ADOQueryTmp:TADOQuery; - cb: TComboBox;FlagType:string; - Boxtype:integer; - showMsg:string; - emptyFlag:Boolean - ); - procedure SInitCxGridComboBoxByCustCode(ADOQueryTmp:TADOQuery;c3:TcxGriddbColumn; - FlagType:string;PState:Integer;IsNull:Boolean;Shmeg:string); - procedure SSetsavedata10(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); - procedure SSetWinData10(ADOQueryTmp:TADOQuery;mParent:TWinControl); - procedure SInitCxGridComboBoxBySql(ADOQueryTmp:TADOQuery;c3:TcxGriddbColumn;FSql:string; - PState:Integer;IsNull:Boolean;Shmeg:string); - function SSWR(s: real): real; //***** *****// - procedure SSetWinData20(ADOQueryTmp:TADOQuery;mParent:TWinControl); - procedure SSetWinData30(ADOQueryTmp:TADOQuery;mParent:TWinControl;FTag:Integer); - procedure SCSHData(ADOQueryTmp:TADOQuery;mParent:TWinControl;FTag:Integer); - procedure SSetsavedataNew(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); - function SGetServerDate10(ADOQueryTmp:TADOQuery):TDateTime; - function SGetServerDateTime(ADOQueryTmp:TADOQuery):TDateTime; - procedure SCreateCDSSel(SADOQry:TADOQuery; mClientDataset:TclientDataSet ); - procedure SInitCDSDataSel(fromADO:TADOQuery;toCDS:TclientDataSet); - procedure CopyAddRow(Tv1:TcxGridDBTableView;CDS_Sub:TClientDataSet); //Сgroupformatֵ - procedure CopyAddRowBand(Tv1:TcxGridDBBandedTableView;CDS_Sub:TClientDataSet); - procedure OneKeyPost(Tv1:TcxGridDBTableView;CDS_Sub:TClientDataSet); //һ滻ճ - procedure CopyAddRowCDS(CDS_Sub:TClientDataSet); - function SSetSaveDataCDSNew(AdoQueryCmd:TADOQuery;Tv1:TcxGridDBTableView; - CDS_Sub:TClientDataSet;MyTable:string;MyTag:Integer):Boolean; - function SGetFinds(TMPanel:TPanel;EquTag,LikeTag:Integer):string; - function SSetSaveDataCDSBandNew(AdoQueryCmd:TADOQuery;Tv1:TcxGridDBBandedTableView; - CDS_Sub:TClientDataSet;MyTable:string;MyTag:Integer):Boolean; - function GetLSNoHZ(ADOQueryTmp: TADOQuery; var mMaxNo: string; mFlag: string; mTable: string; mlen: integer; mtype: integer = 0; HZype: integer = 0): Boolean; - function GetLSNo(ADOQueryTmp:TADOQuery; - var mMaxNo:string; - mFlag:string; - mTable:string; - mlen:integer; - mtype:integer=0):Boolean; - - procedure SSetsaveSql(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); - 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=''); - procedure CreateGroupSummarry(tv1:TcxGridDBTableView); - procedure TcxGridToExcel(mfileName:string;gridName:TcxGrid); - procedure TcxGridToExcelEng(mfileName:string;gridName:TcxGrid); - function ReadINIFileStr(ininame,TypeName:string;ValueName,ValueMR:String):string; - procedure SClearData(mParent:TWinControl;FTag:Integer); - procedure SelExportData(FTv:TcxGridDBTableView;FAdoQry:TADOQuery;FTile:string); - procedure SDofilter10(cds_Main:TClientDataSet;FilterStr:string); - procedure SInitCxBandGridComboBoxBySql(ADOQueryTmp:TADOQuery;c3:TcxGridDBBandedColumn;FSql:string; - PState:Integer;IsNull:Boolean;Shmeg:string); - procedure ColumnView(AdoQueryTemp:TADOQuery;Tv1:TcxGridDBTableView;MKName10:string); - procedure ColumnSet(TV10:TcxGridDBTableView;MKName10:String); - procedure ColumnBandSet(TV10:TcxGridDBBandedTableView;MKName10:String); - procedure ColumnBandView(AdoQueryTemp:TADOQuery;Tv1:TcxGridDBBandedTableView;MKName10:string); - procedure SCSHDataWTag(ADOQueryTmp:TADOQuery;mParent:TWinControl); - procedure GetSWLDZ(IPStr:string); - procedure SCSHDataCDS(CDS_Main:TClientDataSet;mParent:TWinControl;FTag:Integer); - procedure SelPrintData(FTv:TcxGridDBTableView;FAdoQry:TADOQuery;FTitle:string - ;FLTitle:string;FRTile:string); - procedure SelPrintDataMore(FTv:TcxGridDBTableView;FAdoQry:TADOQuery;FTitle:string - ;FLTitle:string;FRTile:string;FKK:Integer;FiniName:string); - procedure SelExportDataBand(FTv:TcxGridDBBandedTableView;FAdoQry:TADOQuery;FTile:string); - procedure SSetsaveSqlNew(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); - procedure SCSHDataNew(ADOQueryTmp:TADOQuery;mParent:TWinControl;FTag:Integer); - function RTSetSaveDataCDS(AdoQueryCmd:TADOQuery;Tv1:TcxGridDBTableView; - CDS_Sub:TClientDataSet;MyTable:string;MyTag:Integer):Boolean; - function RTSetSaveDataCDSBand(AdoQueryCmd:TADOQuery;Tv1:TcxGridDBBandedTableView; - CDS_Sub:TClientDataSet;MyTable:string;MyTag:Integer):Boolean; - procedure SCreateCDSOnly(SADOQry:TADOQuery; mClientDataset:TclientDataSet ); - procedure SInitCDSDataOnly(fromADO:TADOQuery;toCDS:TclientDataSet); - procedure SelOKNo(CDS_MainSel:TClientDataSet;FSel:Boolean); - procedure SelOKNoAdo(CDS_MainSel:TADOQuery;FSel:Boolean); - function num2cengnum(strArabic:string):string; - function num2ceng(strArabic:string):string; - procedure RTSetsavedata(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); - procedure InitOrderColor(OrdMainId:string;Combox:TComboBox;FAdoQry:TADOQuery); - procedure InitBCGangNo(OrdSubId:string;Combox:TComboBox;FAdoQry:TADOQuery); - procedure InitRCGangNo(OrdSubId:string;Combox:TComboBox;FAdoQry:TADOQuery); - procedure DelCDS(ClientDataSet1:TClientDataSet;ADOCmd:TADOQuery;DelSql:string); - procedure SInitComBoxByTvColumns(cb:TComboBox; - Tv1:TcxGridDBTableView; - ColumnTag:Integer; - TowFlag:Boolean; - emptyFlag:Boolean); - procedure HJ(mClientDataset:TclientDataSet;Label1:TLabel;mfieldName:double); - function num2cengnumZS(strArabic:string):string; - - function CovFileDate(Fd:_FileTime):TDateTime; - procedure GetFileEditTime(mFile:string;var editTime:tdatetime); - procedure GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime); - function ExportFtErpFile(mFileName:string;ADORead:TADOQuery):boolean; - function ExportFtErpFile10(mFileName:string;ADORead:TADOQuery):boolean; - procedure UpdateFileTime(FileName:string; CreationTime, LastAccessTime, LastWriteTime:TDateTime); - - procedure ClearOrHideControls(TMPanel: TPanel; HintValue: string; IsClear: Boolean; IsHide: Boolean); - procedure AssignmentControls(TMPanel: TPanel; TMClientDataset: TclientDataSet; Hintvalue: string); - procedure IsVisibleTV(TMPanel: TPanel; MTV: TcxGridDBTableView; Hintvalue: string; IsVisible: Boolean); - function RoundFloat(f: double; i: integer): double; - -implementation -uses U_DataLink,U_SelExportField,U_ColumnSet,U_ColumnBandSet,U_SelPrintFieldNew; - - 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; - 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(pchar('ȡļ'+mfileName+'ʧ!'),'ʾϢ',0); - end; -end; -function ExportFtErpFile10(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:='report10\'; - 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(pchar('ȡļ'+mfileName+'ʧ!'),'ʾϢ',0); - end; -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; -//////////////////////////////////////////////////////// - // -/////////////////////////////////////////////////////// - -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 IsVisibleTV(TMPanel: TPanel; MTV: TcxGridDBTableView; Hintvalue: string; IsVisible: Boolean); -var - i, j: integer; -begin - - with TMPanel do - begin - for j := 0 to TMPanel.ControlCount - 1 do - begin - if TMPanel.Controls[j] is TEdit then - begin - if Trim(TEdit(TMPanel.Controls[j]).Hint) = Hintvalue then - begin - with MTV do - begin - for i := 0 to MTV.ColumnCount - 1 do - begin - if Trim(TEdit(TMPanel.Controls[j]).Name) = Trim(MTV.Columns[i].DataBinding.FieldName) then - begin - MTV.Columns[i].Visible := IsVisible; - Continue; - end; - end; - end; - end; - end; - if TMPanel.Controls[j] is TComboBox then - begin - if Trim(TComboBox(TMPanel.Controls[j]).Hint) = Hintvalue then - begin - with MTV do - begin - for i := 0 to MTV.ColumnCount - 1 do - begin - if Trim(TComboBox(TMPanel.Controls[j]).Name) = Trim(MTV.Columns[i].DataBinding.FieldName) then - begin - MTV.Columns[i].Visible := IsVisible; - Continue; - end; - end; - end; - end; - end; - end; - end; -end; -/////////////////////////////////////////////////////// - // -/////////////////////////////////////////////////////// - -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; - end; - end; -end; -function num2cengnumZS(strArabic:string):string; -var - p,i,j,x:integer; - s,Y:string; -begin - result := ''; - s := strarabic; - p := pos('.',strarabic); - if p = 0 then - begin - result := num2ceng(strarabic)+'Only'; - exit; - end - else - begin - i := length(s)-p;//Смλ - delete(strarabic,p,i+1);//ɾС - result := num2ceng(strarabic)+'DOLLORS'; - end; - Y:= copy(s,p,i+1); - result :=result +' '+num2ceng(Y)+' CENTS'; -end; - -procedure HJ(mClientDataset:TclientDataSet;Label1:TLabel;mfieldName:double); +unit U_Fun; + +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, FTComboBox, cxDropDownEdit, + cxGridBandedTableView, cxGridDBBandedTableView, cxRichEdit, cxButtonEdit, + IniFiles, WinSock, dxCore, ActiveX; +//Function sendarp(ipaddr:ulong;temp:dword;ulmacaddr:pointer;ulmacaddrleng:pointer) : DWord; StdCall; External 'Iphlpapi.dll' Name 'SendARP'; + +type + TA = class(TComponent) + public + S: string; + end; + +function SGetMaxId(AdoQueryTemp: TADOQuery; MyTable: string; MyField: string; var MaxId: Integer): Boolean; + +function SIsRepeated(AdoQueryTemp: TADOQuery; MyTable: string; MyField: string; MyCode: string): Boolean; + +function SSetSaveDataCDS(AdoQueryCmd: TADOQuery; Tv1: TcxGridDBTableView; CDS_Sub: TClientDataSet; MyTable: string; MyTag: Integer): Boolean; + +function SSetSaveDataCDS10(AdoQueryCmd: TADOQuery; Tv1: TcxGridDBBandedTableView; CDS_Sub: TClientDataSet; MyTable: string; MyTag: Integer): Boolean; + +function SGetServerDate(ADOQueryTmp: TADOQuery): TdateTime; + +procedure SSetsavedata(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); + +procedure SSetWinData(ADOQueryTmp: TADOQuery; mParent: TWinControl); + +function SDelData(ADOQueryCmd: TADOQuery; mDelStr: string): Boolean; + +function SGetFilters(TMPanel: TPanel; EquTag, LikeTag: Integer): string; + +function SGetFiltersHint(TMPanel: TPanel; EquTag, LikeTag: Integer): string; + +procedure SDofilter(ADOQry: TADOQuery; FilterStr: string); + +function SGetMaxNo(MyAdoQuery: TADOQuery; MyTable: string; MyField: string; MyFlag: string): string; + +procedure SCreateCDS20(SADOQry: TADOQuery; mClientDataset: TclientDataSet); + +procedure SInitCDSData20(fromADO: TADOQuery; toCDS: TclientDataSet); + +procedure SCreateCDSYS(SADOQry: TADOQuery; mClientDataset: TclientDataSet); + +procedure SInitCDSDataYS(fromADO: TADOQuery; toCDS: TclientDataSet); + +procedure SInitFtComBoxBySql(ADOQueryTmp: TADOQuery; cb: TFtComboBox; FlagType: string; Boxtype: integer; showMsg: string; emptyFlag: Boolean; mSql: string); + +procedure SInitComBoxBySql(ADOQueryTmp: TADOQuery; cb: TComboBox; emptyFlag: Boolean; mSql: string); + +procedure SInitComBoxByCustCode(ADOQueryTmp: TADOQuery; cb: TComboBox; FlagType: string; Boxtype: integer; showMsg: string; emptyFlag: Boolean); + +procedure SInitCxGridComboBoxByCustCode(ADOQueryTmp: TADOQuery; c3: TcxGriddbColumn; FlagType: string; PState: Integer; IsNull: Boolean; Shmeg: string); + +procedure SSetsavedata10(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); + +procedure SSetWinData10(ADOQueryTmp: TADOQuery; mParent: TWinControl); + +procedure SInitCxGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGriddbColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string); + +function SSWR(s: real): real; //***** *****// + +procedure SSetWinData20(ADOQueryTmp: TADOQuery; mParent: TWinControl); + +procedure SSetWinData30(ADOQueryTmp: TADOQuery; mParent: TWinControl; FTag: Integer); + +procedure SCSHData(ADOQueryTmp: TADOQuery; mParent: TWinControl; FTag: Integer); + +procedure SSetsavedataNew(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); + +function SGetServerDate10(ADOQueryTmp: TADOQuery): TDateTime; + +function SGetServerDateTime(ADOQueryTmp: TADOQuery): TDateTime; + +procedure SCreateCDSSel(SADOQry: TADOQuery; mClientDataset: TclientDataSet); + +procedure SInitCDSDataSel(fromADO: TADOQuery; toCDS: TclientDataSet); + +procedure CopyAddRow(Tv1: TcxGridDBTableView; CDS_Sub: TClientDataSet); //Сgroupformatֵ + +procedure CopyAddRowBand(Tv1: TcxGridDBBandedTableView; CDS_Sub: TClientDataSet); + +procedure OneKeyPost(Tv1: TcxGridDBTableView; CDS_Sub: TClientDataSet); //һ滻ճ + +procedure CopyAddRowCDS(CDS_Sub: TClientDataSet); + +function SSetSaveDataCDSNew(AdoQueryCmd: TADOQuery; Tv1: TcxGridDBTableView; CDS_Sub: TClientDataSet; MyTable: string; MyTag: Integer): Boolean; + +function SGetFinds(TMPanel: TPanel; EquTag, LikeTag: Integer): string; + +function SSetSaveDataCDSBandNew(AdoQueryCmd: TADOQuery; Tv1: TcxGridDBBandedTableView; CDS_Sub: TClientDataSet; MyTable: string; MyTag: Integer): Boolean; + +function GetLSNoHZ(ADOQueryTmp: TADOQuery; var mMaxNo: string; mFlag: string; mTable: string; mlen: integer; mtype: integer = 0; HZype: integer = 0): Boolean; + +function GetLSNo(ADOQueryTmp: TADOQuery; var mMaxNo: string; mFlag: string; mTable: string; mlen: integer; mtype: integer = 0): Boolean; + +procedure SSetsaveSql(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); + +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 = ''); + +procedure CreateGroupSummarry(tv1: TcxGridDBTableView); + +procedure TcxGridToExcel(mfileName: string; gridName: TcxGrid); + +procedure TcxGridToExcelEng(mfileName: string; gridName: TcxGrid); + +function ReadINIFileStr(ininame, TypeName: string; ValueName, ValueMR: string): string; + +procedure SClearData(mParent: TWinControl; FTag: Integer); + +procedure SelExportData(FTv: TcxGridDBTableView; FAdoQry: TADOQuery; FTile: string); + +procedure SDofilter10(cds_Main: TClientDataSet; FilterStr: string); + +procedure SInitCxBandGridComboBoxBySql(ADOQueryTmp: TADOQuery; c3: TcxGridDBBandedColumn; FSql: string; PState: Integer; IsNull: Boolean; Shmeg: string); + +procedure ColumnView(AdoQueryTemp: TADOQuery; Tv1: TcxGridDBTableView; MKName10: string); + +procedure ColumnSet(TV10: TcxGridDBTableView; MKName10: string); + +procedure ColumnBandSet(TV10: TcxGridDBBandedTableView; MKName10: string); + +procedure ColumnBandView(AdoQueryTemp: TADOQuery; Tv1: TcxGridDBBandedTableView; MKName10: string); + +procedure SCSHDataWTag(ADOQueryTmp: TADOQuery; mParent: TWinControl); + +procedure GetSWLDZ(IPStr: string); + +procedure SCSHDataCDS(CDS_Main: TClientDataSet; mParent: TWinControl; FTag: Integer); + +procedure SelPrintData(FTv: TcxGridDBTableView; FAdoQry: TADOQuery; FTitle: string; FLTitle: string; FRTile: string); + +procedure SelPrintDataMore(FTv: TcxGridDBTableView; FAdoQry: TADOQuery; FTitle: string; FLTitle: string; FRTile: string; FKK: Integer; FiniName: string); + +procedure SelExportDataBand(FTv: TcxGridDBBandedTableView; FAdoQry: TADOQuery; FTile: string); + +procedure SSetsaveSqlNew(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); + +procedure SCSHDataNew(ADOQueryTmp: TADOQuery; mParent: TWinControl; FTag: Integer); + +function RTSetSaveDataCDS(AdoQueryCmd: TADOQuery; Tv1: TcxGridDBTableView; CDS_Sub: TClientDataSet; MyTable: string; MyTag: Integer): Boolean; + +function RTSetSaveDataCDSBand(AdoQueryCmd: TADOQuery; Tv1: TcxGridDBBandedTableView; CDS_Sub: TClientDataSet; MyTable: string; MyTag: Integer): Boolean; + +procedure SCreateCDSOnly(SADOQry: TADOQuery; mClientDataset: TclientDataSet); + +procedure SInitCDSDataOnly(fromADO: TADOQuery; toCDS: TclientDataSet); + +procedure SelOKNo(CDS_MainSel: TClientDataSet; FSel: Boolean); + +procedure SelOKNoAdo(CDS_MainSel: TADOQuery; FSel: Boolean); + +function num2cengnum(strArabic: string): string; + +function num2ceng(strArabic: string): string; + +procedure RTSetsavedata(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); + +procedure InitOrderColor(OrdMainId: string; Combox: TComboBox; FAdoQry: TADOQuery); + +procedure InitBCGangNo(OrdSubId: string; Combox: TComboBox; FAdoQry: TADOQuery); + +procedure InitRCGangNo(OrdSubId: string; Combox: TComboBox; FAdoQry: TADOQuery); + +procedure DelCDS(ClientDataSet1: TClientDataSet; ADOCmd: TADOQuery; DelSql: string); + +procedure SInitComBoxByTvColumns(cb: TComboBox; Tv1: TcxGridDBTableView; ColumnTag: Integer; TowFlag: Boolean; emptyFlag: Boolean); + +procedure HJ(mClientDataset: TclientDataSet; Label1: TLabel; mfieldName: double); + +function num2cengnumZS(strArabic: string): string; + +function CovFileDate(Fd: _FileTime): TDateTime; + +procedure GetFileEditTime(mFile: string; var editTime: tdatetime); + +procedure GetFileInfo(mFile: string; var mfileSize: integer; var CreationTime: tdatetime; var WriteTime: tdatetime); + +function ExportFtErpFile(mFileName: string; ADORead: TADOQuery): boolean; + +function ExportFtErpFile10(mFileName: string; ADORead: TADOQuery): boolean; + +procedure UpdateFileTime(FileName: string; CreationTime, LastAccessTime, LastWriteTime: TDateTime); + +procedure ClearOrHideControls(TMPanel: TPanel; HintValue: string; IsClear: Boolean; IsHide: Boolean); + +procedure AssignmentControls(TMPanel: TPanel; TMClientDataset: TclientDataSet; Hintvalue: string); + +procedure IsVisibleTV(TMPanel: TPanel; MTV: TcxGridDBTableView; Hintvalue: string; IsVisible: Boolean); + +function RoundFloat(f: double; i: integer): double; + +implementation + +uses + U_DataLink, U_SelExportField, U_ColumnSet, U_ColumnBandSet, U_SelPrintFieldNew; + +function RoundFloat(f: double; i: integer): double; +var + s: string; + ef: Extended; begin - if mClientDataset.IsEmpty then exit; + 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; + +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(pchar('ȡļ' + mFileName + 'ʧ!'), 'ʾϢ', 0); + end; +end; + +function ExportFtErpFile10(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 := 'report10\'; + 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(pchar('ȡļ' + mFileName + 'ʧ!'), 'ʾϢ', 0); + end; +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; +//////////////////////////////////////////////////////// + // +/////////////////////////////////////////////////////// + +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 IsVisibleTV(TMPanel: TPanel; MTV: TcxGridDBTableView; Hintvalue: string; IsVisible: Boolean); +var + i, j: integer; +begin + + with TMPanel do + begin + for j := 0 to TMPanel.ControlCount - 1 do + begin + if TMPanel.Controls[j] is TEdit then + begin + if Trim(TEdit(TMPanel.Controls[j]).Hint) = Hintvalue then + begin + with MTV do + begin + for i := 0 to MTV.ColumnCount - 1 do + begin + if Trim(TEdit(TMPanel.Controls[j]).Name) = Trim(MTV.Columns[i].DataBinding.FieldName) then + begin + MTV.Columns[i].Visible := IsVisible; + Continue; + end; + end; + end; + end; + end; + if TMPanel.Controls[j] is TComboBox then + begin + if Trim(TComboBox(TMPanel.Controls[j]).Hint) = Hintvalue then + begin + with MTV do + begin + for i := 0 to MTV.ColumnCount - 1 do + begin + if Trim(TComboBox(TMPanel.Controls[j]).Name) = Trim(MTV.Columns[i].DataBinding.FieldName) then + begin + MTV.Columns[i].Visible := IsVisible; + Continue; + end; + end; + end; + end; + end; + end; + end; +end; +/////////////////////////////////////////////////////// + // +/////////////////////////////////////////////////////// + +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; + end; + end; +end; + +function num2cengnumZS(strArabic: string): string; +var + p, i, j, x: integer; + s, Y: string; +begin + result := ''; + s := strArabic; + p := pos('.', strArabic); + if p = 0 then + begin + result := num2ceng(strArabic) + 'Only'; + exit; + end + else + begin + i := length(s) - p; //Смλ + delete(strArabic, p, i + 1); //ɾС + result := num2ceng(strArabic) + 'DOLLORS'; + end; + Y := copy(s, p, i + 1); + result := result + ' ' + num2ceng(Y) + ' CENTS'; +end; + +procedure HJ(mClientDataset: TclientDataSet; Label1: TLabel; mfieldName: double); +begin + if mClientDataset.IsEmpty then + exit; with mClientDataset do begin - if fieldbyname('Ssel').AsBoolean=true then - Label1.Caption:=currtostr(strtoCurr(Label1.Caption)+mfieldName) + if fieldbyname('Ssel').AsBoolean = true then + Label1.Caption := currtostr(strtoCurr(Label1.Caption) + mfieldName) else - Label1.Caption:=currtostr(strtoCurr(Label1.Caption)-mfieldName); + Label1.Caption := currtostr(strtoCurr(Label1.Caption) - mfieldName); end; -end; - -///////////////////ȡIntֵֶ/////////////////////////////////////// -function SGetMaxId(AdoQueryTemp:TADOQuery;MyTable:string;MyField:string;Var MaxId:Integer):Boolean; -begin - try - with AdoQueryTemp do - begin - Close; - SQL.Clear; - SQL.Add('select Max('+MyField+')+1 MaxId from '+MyTable); - Open; - end; - with AdoQueryTemp do - begin - if (Trim(FieldByName('MaxId').AsString)='') or - (Trim(FieldByName('MaxId').AsString)=NULL) then - MaxId:=1 - else - MaxId:=(fieldbyname('MaxId').AsInteger); - Close; - SQL.Clear; - end; - Result:=True; - except - Result:=False; - Application.MessageBox('ȡֵʧܣ','ʾ',0); - end; -end; -procedure InitBCGangNo(OrdSubId:string;Combox:TComboBox;FAdoQry:TADOQuery); -var - fsj:string; -begin - fsj:='select distinct(AOrdDefStr1) Code from JYOrder_Sub_AnPai '+ - ' where Subid='''+Trim(OrdSubId)+''''; - with FAdoQry do - begin - Close; - sql.Clear; - sql.Add(fsj); - Open; - end; - Combox.Clear; - with FAdoQry do - begin - First; - while not Eof do - begin - Combox.Items.Add(Trim(FAdoQry.fieldbyname('Code').AsString)); - Next; - end; - end; - Combox.Items.Add(''); -end; -procedure InitRCGangNo(OrdSubId:string;Combox:TComboBox;FAdoQry:TADOQuery); -var - fsj:string; -begin - fsj:='select distinct(gangno) Code from JYOrder_Sub_AnPai '+ - ' where Subid='''+Trim(OrdSubId)+''''; - with FAdoQry do - begin - Close; - sql.Clear; - sql.Add(fsj); - Open; - end; - Combox.Clear; - with FAdoQry do - begin - First; - while not Eof do - begin - Combox.Items.Add(Trim(FAdoQry.fieldbyname('Code').AsString)); - Next; - end; - end; - Combox.Items.Add(''); -end; -procedure InitOrderColor(OrdMainId:string;Combox:TComboBox;FAdoQry:TADOQuery); -var - fsj:string; -begin - fsj:='select distinct(PRTColor) Code from JYOrder_Sub '+ - ' where Mainid='''+Trim(OrdMainId)+''''; - with FAdoQry do - begin - Close; - sql.Clear; - sql.Add(fsj); - Open; - end; - Combox.Clear; - with FAdoQry do - begin - First; - while not Eof do - begin - Combox.Items.Add(Trim(FAdoQry.fieldbyname('Code').AsString)); - Next; - end; - end; - Combox.Items.Add(''); -end; -////Զӡ -procedure SelPrintData(FTv:TcxGridDBTableView;FAdoQry:TADOQuery;FTitle:string - ;FLTitle:string;FRTile:string); -var - i,j,k,KK:Integer; - fsj:string; - FOrder,fcolumnName:string; -begin - {if FAdoQry.IsEmpty then Exit; - try - frmSelPrintFieldNew:=TfrmSelPrintFieldNew.Create(Application); - with frmSelPrintFieldNew do - begin - with frmSelPrintFieldNew.PrnGrid do - begin - PrnGrid.Columns.Clear; - frmSelPrintFieldNew.IniName:=FTitle; - for i:=0 to FTv.ColumnCount-1 do - begin - if FTv.Columns[i].Visible=True then - begin - PrnGrid.Columns.Add; - j:=PrnGrid.Columns.Count-1; - PrnGrid.Columns[j].Title.Caption:=FTv.Columns[i].Caption; - PrnGrid.Columns[j].FieldName:=FTv.Columns[i].DataBinding.FieldName; - PrnGrid.Columns[j].Width:=FTv.Columns[i].Width; - if FTv.Columns[i].SortOrder=soAscending then - begin - FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' '; - end else - if FTv.Columns[i].SortOrder=soDescending then - begin - FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' DESC'; - end; - end; - end; - end; - FAdoQry.Sort:=FOrder; - frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.TitleMemo.Add(FTitle); - frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.LeftMemo.Add(FLTitle); - frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.RightMemo.Add(FRTile); - SCreatecds20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); - SInitCDSData20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); - if FTv.OptionsView.Footer=True then - begin - if FTv.DataController.Summary.FooterSummaryItems.Count>0 then - begin - frmSelPrintFieldNew.ClientDataSet1.Append; - //frmSelPrintFieldNew.ClientDataSet1.FieldByName('Sindex').Value:=frmSelPrintFieldNew.ClientDataSet1.RecNo+1; - frmSelPrintFieldNew.ClientDataSet1.Post; - KK:=0; - for i:=0 to FTv.ColumnCount-1 do - begin - if FTv.Columns[i].Visible=False then Continue; - - fcolumnName:=FTv.Columns[i].Name; - if FTv.Columns[i].Summary.FooterKind<>sknone then - begin - for k:=0 to FTv.DataController.Summary.FooterSummaryItems.Count-1 do - begin - if TcxGridDBTableSummaryItem(FTv.DataController.Summary.FooterSummaryItems.Items[k]).Column.Name=fcolumnName then - begin - frmSelPrintFieldNew.ClientDataSet1.edit; - frmSelPrintFieldNew.ClientDataSet1.FieldByName(FTv.Columns[i].DataBinding.FieldName).Value:= - FTv.DataController.Summary.FooterSummaryValues[k]; - frmSelPrintFieldNew.ClientDataSet1.Post; - end; - end; - end; - end; - end; - end; - if ShowModal=1 then - begin - - end; - end; - - finally - frmSelPrintFieldNew.Free; - end; } -end; -////Զӡ -procedure SelPrintDataMore(FTv:TcxGridDBTableView;FAdoQry:TADOQuery;FTitle:string - ;FLTitle:string;FRTile:string;FKK:Integer;FiniName:string); -var - i,j,k,KK:Integer; - fsj:string; - FOrder,fcolumnName:string; -begin - {if FAdoQry.IsEmpty then Exit; - try - frmSelPrintFieldNew:=TfrmSelPrintFieldNew.Create(Application); - with frmSelPrintFieldNew do - begin - with frmSelPrintFieldNew.PrnGrid do - begin - PrnGrid.Columns.Clear; - frmSelPrintFieldNew.IniName:=FiniName; - for i:=0 to FTv.ColumnCount-1 do - begin - if FTv.Columns[i].Visible=True then - begin - PrnGrid.Columns.Add; - j:=PrnGrid.Columns.Count-1; - PrnGrid.Columns[j].Title.Caption:=FTv.Columns[i].Caption; - PrnGrid.Columns[j].FieldName:=FTv.Columns[i].DataBinding.FieldName; - PrnGrid.Columns[j].Width:=FTv.Columns[i].Width; - if FTv.Columns[i].SortOrder=soAscending then - begin - FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' '; - end else - if FTv.Columns[i].SortOrder=soDescending then - begin - FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' DESC'; - end; - end; - end; - end; - FAdoQry.Sort:=FOrder; - frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.TitleMemo.Add(FTitle); - frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.LeftMemo.Add(FLTitle); - frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.RightMemo.Add(FRTile); - - SCreatecds20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); - SInitCDSData20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); - if FTv.OptionsView.Footer=True then - begin - if FTv.DataController.Summary.FooterSummaryItems.Count>0 then - begin - frmSelPrintFieldNew.ClientDataSet1.Append; - - frmSelPrintFieldNew.ClientDataSet1.Post; - KK:=0; - for i:=0 to FTv.ColumnCount-1 do - begin - - - fcolumnName:=FTv.Columns[i].Name; - if FTv.Columns[i].Summary.FooterKind<>sknone then - begin - if KK=0 then - begin - frmSelPrintFieldNew.ClientDataSet1.edit; - frmSelPrintFieldNew.ClientDataSet1.FieldByName(FTv.Columns[i-FKK].DataBinding.FilterFieldName).Value:='Total'; - frmSelPrintFieldNew.ClientDataSet1.Post; - KK:=99; - end; - for k:=0 to FTv.DataController.Summary.FooterSummaryItems.Count-1 do - begin - if TcxGridDBTableSummaryItem(FTv.DataController.Summary.FooterSummaryItems.Items[k]).Column.Name=fcolumnName then - begin - frmSelPrintFieldNew.ClientDataSet1.edit; - frmSelPrintFieldNew.ClientDataSet1.FieldByName(FTv.Columns[i].DataBinding.FieldName).Value:= - FTv.DataController.Summary.FooterSummaryValues[k]; - frmSelPrintFieldNew.ClientDataSet1.Post; - end; - end; - end; - end; - end; - end; - if ShowModal=1 then - begin - - end; - end; - - finally - frmSelPrintFieldNew.Free; - end;} -end; -///////////////////////жϱǷظ/////////////////////////////////// -function SIsRepeated(AdoQueryTemp:TADOQuery;MyTable:string;MyField:string;MyCode:String):Boolean; -begin - try - Result:=False; - with AdoQueryTemp do - begin - Close; - SQL.Clear; - SQL.Add('select * from '+MyTable+' where '+MyField+'='''+Trim(MyCode)+''''); - Open; - if IsEmpty then Result:=True; - Close; - SQL.Clear; - end; - except - Result:=False; - Application.MessageBox('ֶ','ʾ',0); - end; -end; -////////////////////ClientDataSetıϢ///////////////////////////// -function SSetSaveDataCDS(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 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; - - end; - end; - Result:=True; - except - Result:=False; - Application.MessageBox('CdsϢʧ!','ʾ',0); - end; -end; -////////////////////ClientDataSetıϢ///////////////////////////// -function SSetSaveDataCDSNew(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=True then - begin - if Trim(Tv1.Columns[i].Summary.GroupFooterFormat)<>'1' then - 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 - AdoQueryCmd.FieldByName(Tv1.Columns[i].DataBinding.FieldName).Value:=null; - end}; - end; - if Trim(Tv1.Columns[i].Summary.GroupFormat)<>'' then - begin - if Trim(CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).AsString)<>'' then - begin - AdoQueryCmd.FieldByName(Tv1.Columns[i].Summary.GroupFormat).Value:= - CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).Value; - 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 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 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 - - 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:=Trim(Tv1.Columns[i].Summary.GroupFooterFormat); - end; - - end; - - end; - end; - Result:=True; - except - Result:=False; - Application.MessageBox('CdsϢʧ!','ʾ',0); - end; -end; - -function SSetSaveDataCDSBandNew(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 Trim(Tv1.Columns[i].Summary.GroupFooterFormat)<>'1' then - 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; - end; - if Trim(Tv1.Columns[i].Summary.GroupFormat)<>'' then - begin - if Trim(CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).AsString)<>'' then - begin - AdoQueryCmd.FieldByName(Tv1.Columns[i].Summary.GroupFormat).Value:= - CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).Value; - end; - end; - - - end; - end; - Result:=True; - except - Result:=False; - Application.MessageBox('CdsϢʧ!','ʾ',0); - end; -end; -////////////////////ClientDataSetıϢ///////////////////////////// -function SSetSaveDataCDS10(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 Trim(CDS_Sub.fieldbyname(Tv1.Columns[i].DataBinding.FieldName).AsString)<>'' then - AdoQueryCmd.FieldByName(Tv1.Columns[i].DataBinding.FieldName).Value:= - CDS_Sub.fieldbyname(Tv1.Columns[i].DataBinding.FieldName).Value; - 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 SGetServerDateTime(ADOQueryTmp:TADOQuery):TdateTime; -begin - 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; -function SGetServerDate10(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; - -///////////////////////////////////////////////////// -//ʱֶθֵ -///////////////////////////////////////////////////// -procedure SSetsavedata(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 TEdit then - begin - if Trim(TEdit(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TEdit(Controls[i]).Text); - 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 TcxRichEdit then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TcxRichEdit(Controls[i]).Text; - end else - if Controls[i] is TMemo then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TMemo(Controls[i]).Text; - end; - if Controls[i] is TFTComboBox then - begin - if (TFTComboBox(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TFTComboBox(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 TCheckBox then - begin - if TCheckBox(Controls[i]).Checked=True then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=1 - else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=0; - 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; - end else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TDateTimePicker(Controls[i]).DateTime; - end else - if Controls[i] is TBtnEditA then - begin - if TBtnEditA(Controls[i]).Hint='' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditA(Controls[i]).Text) - else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditA(Controls[i]).TxtCode); - end else - if Controls[i] is TBtnEditC then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditC(Controls[i]).TxtCode); - 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 SSetsavedataNew(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 TEdit then - begin - if Trim(TEdit(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TEdit(Controls[i]).Text); - 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; - if Controls[i] is TFTComboBox then - begin - if (TFTComboBox(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TFTComboBox(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; - end else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TDateTimePicker(Controls[i]).DateTime; - end else - if Controls[i] is TBtnEditA then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditA(Controls[i]).TxtCode); - if (TBtnEditA(Controls[i]).Hint<>'') and (TBtnEditA(Controls[i]).ParentCtl3D=True) then - ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value:=Trim(TBtnEditA(Controls[i]).Text); - end else - if Controls[i] is TBtnEditC then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditC(Controls[i]).TxtCode); - //if (TBtnEditC(Controls[i]).Hint<>'') and (TBtnEditC(Controls[i]).ParentCtl3D=True)then - //ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value:=Trim(TBtnEditC(Controls[i]).Text); - 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 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 TEdit then - begin - if Trim(TEdit(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TEdit(Controls[i]).Text); - 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; - if Controls[i] is TFTComboBox then - begin - if (TFTComboBox(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TFTComboBox(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; - end else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TDateTimePicker(Controls[i]).DateTime; - end else - if Controls[i] is TBtnEditA then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditA(Controls[i]).Text); - if (TBtnEditA(Controls[i]).Hint<>'') then - ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value:=Trim(TBtnEditA(Controls[i]).TxtCode); - end else - if Controls[i] is TBtnEditC then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditC(Controls[i]).Text); - if (TBtnEditC(Controls[i]).Hint<>'') then - ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value:=Trim(TBtnEditC(Controls[i]).TxtCode); - 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 SSetsaveSql(ADOQueryCmd:TADOQuery;MyTable:string; - 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 - if Trim(TEdit(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TEdit(Controls[i]).Text) - else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Null; - 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 TcxRichEdit then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TcxRichEdit(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 TFTComboBox then - begin - if (TFTComboBox(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TFTComboBox(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; - end else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TDateTimePicker(Controls[i]).DateTime; - end else - if Controls[i] is TBtnEditA then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditA(Controls[i]).TxtCode); - if (TBtnEditA(Controls[i]).Hint<>'') and (TBtnEditA(Controls[i]).ParentCtl3D=True) then - ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value:=Trim(TBtnEditA(Controls[i]).Text); - end else - if Controls[i] is TBtnEditC then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditC(Controls[i]).TxtCode); - //if (TBtnEditC(Controls[i]).Hint<>'') and (TBtnEditC(Controls[i]).ParentCtl3D=True)then - //ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value:=Trim(TBtnEditC(Controls[i]).Text); - end else - if Controls[i] is TcxTimeEdit then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TcxTimeEdit(Controls[i]).Text); - end else - if Controls[i] is TcxButtonEdit then - begin - if (TcxButtonEdit(Controls[i]).BeepOnEnter=True) or (TcxButtonEdit(Controls[i]).ParentShowHint=True) then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TcxButtonEdit(Controls[i]).Text); - if TcxButtonEdit(Controls[i]).ParentShowHint=False then - begin - MCode:=Copy(Trim(Controls[i].Name),1,Length(Trim(Controls[i].Name))-4); - ADOQueryCmd.FieldByName(MCode).Value:=Trim(TcxButtonEdit(Controls[i]).Hint); - end; - end; - end; - end; - end; -end; -procedure SSetsaveSqlNew(ADOQueryCmd:TADOQuery;MyTable:string; - 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 - if Trim(TEdit(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TEdit(Controls[i]).Text) - else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Null; - 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 TCheckBox then - begin - if TCheckBox(Controls[i]).Checked=True then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=1 - else - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=0; - end else - if Controls[i] is TcxRichEdit then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=TcxRichEdit(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 TFTComboBox then - begin - if (TFTComboBox(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TFTComboBox(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 TBtnEditA then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditA(Controls[i]).Text); - if (TBtnEditA(Controls[i]).Hint<>'') then - ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value:=Trim(TBtnEditA(Controls[i]).TxtCode); - end else - if Controls[i] is TBtnEditC then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TBtnEditC(Controls[i]).Text); - if (TBtnEditC(Controls[i]).Hint<>'') then - begin - if Pos('/',TBtnEditC(Controls[i]).Hint)>0 then - begin - - end else - ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value:=Trim(TBtnEditC(Controls[i]).TxtCode); - end; - end else - if Controls[i] is TcxTimeEdit then - begin - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TcxTimeEdit(Controls[i]).Text); - end else - if Controls[i] is TcxButtonEdit then - begin - if (TcxButtonEdit(Controls[i]).BeepOnEnter=True) or (TcxButtonEdit(Controls[i]).ParentShowHint=True) then - ADOQueryCmd.FieldByName(Controls[i].Name).Value:=Trim(TcxButtonEdit(Controls[i]).Text); - if TcxButtonEdit(Controls[i]).ParentShowHint=False then - begin - MCode:=Copy(Trim(Controls[i].Name),1,Length(Trim(Controls[i].Name))-4); - ADOQueryCmd.FieldByName(MCode).Value:=Trim(TcxButtonEdit(Controls[i]).Hint); - end; - end; - end; - end; - end; -end; -procedure SSetsavedata10(ADOQueryCmd:TADOQuery;MyTable:string; - Myparent:TWinControl;MyTag:integer); -var - i:Integer; - FFName:string; -begin - with Myparent do - begin - for i:=0 to ControlCount-1 do - begin - FFName:=Trim(Copy(Controls[i].Name,1,(Length(Controls[i].Name)-1))); - if Controls[i].Tag=MyTag then - begin - if Controls[i] is TEdit then - begin - if Trim(TEdit(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(FFName).Value:=Trim(TEdit(Controls[i]).Text); - end else - if Controls[i] is TRichEdit then - begin - ADOQueryCmd.FieldByName(FFName).Value:=TRichEdit(Controls[i]).Text; - end else - if Controls[i] is TMemo then - begin - ADOQueryCmd.FieldByName(FFName).Value:=TMemo(Controls[i]).Text; - end; - if Controls[i] is TFTComboBox then - begin - if (TFTComboBox(Controls[i]).Text)<>'' then - ADOQueryCmd.FieldByName(FFName).Value:=Trim(TFTComboBox(Controls[i]).Item2); - end else - if Controls[i] is TComboBox then - begin - ADOQueryCmd.FieldByName(FFName).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(FFName).Value:=TDateTimePicker(Controls[i]).DateTime; - end else - ADOQueryCmd.FieldByName(FFName).Value:=TDateTimePicker(Controls[i]).DateTime; - end else - if Controls[i] is TBtnEditA then - begin - ADOQueryCmd.FieldByName(FFName).Value:=Trim(TBtnEditA(Controls[i]).TxtCode); - end else - if Controls[i] is TBtnEditC then - begin - ADOQueryCmd.FieldByName(FFName).Value:=Trim(TBtnEditC(Controls[i]).TxtCode); - 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 TFTComboBox then - begin - if Controls[i].Tag =99 then - begin - idx:=TftComboBox(Controls[i]).Items.IndexOf(trim(fieldByName(mfield).AsString)); - TComboBox(Controls[i]).ItemIndex:=idx; - end - else - begin - idx:=TftComboBox(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; -procedure SInitComBoxByTvColumns(cb:TComboBox; - Tv1:TcxGridDBTableView; - ColumnTag:Integer; - TowFlag:Boolean; - emptyFlag:Boolean); -var - A:TA; - i:Integer; -begin - cb.Items.Clear ; - for i:=0 to Tv1.ColumnCount-1 do - begin - if Tv1.Columns[i].Tag=ColumnTag then - begin - if TowFlag=False then - begin - cb.Items.Add(trim(Tv1.Columns[i].Caption)); - end else - begin - A:=TA.Create(Nil); - A.s:=Trim(Tv1.Columns[i].DataBinding.FieldName); - cb.Items.AddObject(Trim(Tv1.Columns[i].Caption),TObject(A)); - end; - end; - end; - if emptyFlag=False then cb.Items.Add(''); - if cb.Items.Count >0 then cb.ItemIndex :=0; -end; -procedure SSetWinData30(ADOQueryTmp:TADOQuery;mParent:TWinControl;FTag:Integer); -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<>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 TFTComboBox then - begin - idx:=TftComboBox(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 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]).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 TRichEdit then - begin - TRichEdit(Controls[i]).Text:=fieldbyname(mfield).AsString; - end; - end; // end for - end; // end with - end; //end for with - -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 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 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 TFTComboBox then - begin - idx:=TftComboBox(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; -procedure SCSHDataNew(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) - else - TEdit(Controls[i]).Text:=''; - end - //ftcombobox - else if Controls[i] is TFTComboBox then - begin - idx:=TftComboBox(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]).Text := trim(fieldByName(mfield).AsString); - if Trim(TBtnEditA(Controls[i]).Hint)<>'' then - TBtnEditA(Controls[i]).TxtCode:= trim(fieldByName(Trim(TBtnEditA(Controls[i]).Hint)).AsString); - end else if Controls[i] is TBtnEditC then - begin - TBtnEditC(Controls[i]).Text := trim(fieldByName(mfield).AsString); - if Trim(TBtnEditC(Controls[i]).Hint)<>'' then - begin - if Pos('/',TBtnEditC(Controls[i]).Hint)>0 then - begin - - end else - TBtnEditC(Controls[i]).TxtCode:= trim(fieldByName(Trim(TBtnEditC(Controls[i]).Hint)).AsString); - end; - 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 - if FieldByName(mfield).Value=null then - TcheckBox(Controls[i]).Checked:=False - else - 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; -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 TFTComboBox then - begin - idx:=TftComboBox(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; -procedure SCSHDataWTag(ADOQueryTmp:TADOQuery;mParent:TWinControl); -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 TFTComboBox then - begin - idx:=TftComboBox(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; - -procedure SSetWinData10(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:=Copy(Trim(Controls[i].Name),1,(Length(Trim(Controls[i].Name))-1)); - mfield:=Trim(Controls[i].Name); - 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 TFTComboBox then - begin - if Controls[i].Tag =99 then - begin - idx:=TftComboBox(Controls[i]).Items.IndexOf(trim(fieldByName(mfield).AsString)); - TComboBox(Controls[i]).ItemIndex:=idx; - end - else - begin - idx:=TftComboBox(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:=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 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 TcxLookupComboBox then - begin - TcxLookupComboBox(Controls[i]).EditValue:=fieldByName(mfield).AsString; - TcxLookupComboBox(Controls[i]).EditingText:=fieldByName(mfield+'name').AsString; - end}; - end; // end for - end; // end with - end; //end for with - -end; -procedure SSetWinData20(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:=Copy(Trim(Controls[i].Name),1,(Length(Trim(Controls[i].Name))-1)); - //mfield:=Trim(Controls[i].Name); - 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 TFTComboBox then - begin - if Controls[i].Tag =99 then - begin - idx:=TftComboBox(Controls[i]).Items.IndexOf(trim(fieldByName(mfield).AsString)); - TComboBox(Controls[i]).ItemIndex:=idx; - end - else - begin - idx:=TftComboBox(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:=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 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 TcxLookupComboBox then - begin - TcxLookupComboBox(Controls[i]).EditValue:=fieldByName(mfield).AsString; - TcxLookupComboBox(Controls[i]).EditingText:=fieldByName(mfield+'name').AsString; - end}; - end; // end for - end; // end with - end; //end for with - -end; - -////////////////////////////////////////////// -//////ܣSQLɾ -////////////////////////////////////////////// -function SDelData(ADOQueryCmd:TADOQuery;mDelStr:String):Boolean; -begin - try - result:=False; - with ADOQueryCmd do - begin - Close; - SQL.Clear; - SQL.Add(mDelStr); - ExecSQL; - end; - result:=True; - except - result:=False; - Application.MessageBox('ɾʧܣ','ʾ',0); - end; -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)+'%') - else if Controls[i].Tag=88 then - Result:=Result+'and '+Controls[i].Name+' like '+QuotedStr(Trim(TBtnEditA(Controls[i]).Text)+'%'); - 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 TFTComboBox then - begin - if Trim(TFTComboBox(Controls[i]).Text)<>'' then - if Controls[i].Tag=EquTag then - Result:=Result+'and '+Controls[i].Name+'='+QuotedStr(Trim(TFTComboBox(Controls[i]).Item2)) - else if Controls[i].Tag=LikeTag then - Result:=Result+'and '+Controls[i].Name+' like '+QuotedStr('%'+Trim(TFTComboBox(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(RightBStr(Result,Length(Result)-4)); -end; - -function SGetFiltersHint(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].Hint+'='+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].Hint+' 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].Hint+' 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].Hint+' like '+QuotedStr('%'+Trim(fsj1)+'%'); - fsj1:=''; - end; - end; - end else - Result:=Result+'and '+Controls[i].Hint+' like '+QuotedStr('%'+Trim(TEdit(Controls[i]).Text)+'%'); - end; - end; - end; - end; - end; - if Trim(Result)<>'' then - Result:=Trim(RightBStr(Result,Length(Result)-4)); -end; - -function SGetFinds(TMPanel:TPanel;EquTag,LikeTag:Integer):string; -var - i:Integer; -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 - Result:=Result+'and '+Controls[i].Name+' like '+QuotedStr('%'+Trim(TEdit(Controls[i]).Text)+'%'); - 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)+'%'); - 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 TFTComboBox then - begin - if Trim(TFTComboBox(Controls[i]).Text)<>'' then - if Controls[i].Tag=EquTag then - Result:=Result+'and '+Controls[i].Name+'='+QuotedStr(Trim(TFTComboBox(Controls[i]).Item2)) - else if Controls[i].Tag=LikeTag then - Result:=Result+'and '+Controls[i].Name+' like '+QuotedStr('%'+Trim(TFTComboBox(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; -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 SDofilter10(cds_Main:TClientDataSet;FilterStr:string); -begin - try - cds_Main.DisableControls; - with cds_Main do - begin - if Trim(FilterStr)='' then - begin - Filtered:=False; - end else - begin - Filtered:=False; - Filter:=FilterStr; - Filtered:=True; - end; - end; - finally - cds_Main.EnableControls; - end; -end; -function SGetMaxNo(MyAdoQuery:TADOQuery;MyTable:string;MyField:string;MyFlag:string):String; -var - fsj:string; - i:Integer; -begin - try - result:=''; - fsj:=Trim(Formatdatetime('yyyyMMdd',Now)); - i:=Length(Trim(MyFlag)); - with MyAdoQuery do - begin - Close; - SQL.Clear; - sql.Add('select Max('+MyField+') MaxNo from '+MyTable); - SQL.Add('where '+MyField+' like '+QuotedStr('%'+fsj+'%')); - Open; - end; - with MyAdoQuery do - begin - if Trim(fieldbyname('MaxNo').AsString)='' then - begin - Result:=Trim(MyFlag)+Trim(Formatdatetime('yyyyMMdd',Now))+'1001'; - Exit; - end; - end; - {fsj:=Trim(MyAdoQuery.fieldbyname('MaxNo').AsString); - - - with MyAdoQuery1 do - begin - Close; - SQL.Clear; - SQL.Add('select Max('+MyField+') MaxNo from '+MyTable); - SQL.Add('where '+MyField+' like '+QuotedStr('%'+copy(fsj,3,8)+'%')); - Open; - ShowMessage(copy(fsj,3,8)); - if Trim(fieldbyname('MaxNo').AsString)='' then - begin - Result:=Trim(MyFlag)+Trim(Formatdatetime('yyyyMMdd',Now))+'1001'; - Exit; - end; - end;} - fsj:=Trim(MyAdoQuery.fieldbyname('MaxNo').AsString); - result:=Trim(MyFlag)+Trim(Formatdatetime('yyyyMMdd',Now))+IntToStr(StrtoInt(Copy(fsj,i+9,Length(fsj)-i-8))+1); - - except - Result:=''; - Application.MessageBox(PChar('ֶȡֵMaxNo󣬲鿴<'+Trim(MyTable)+'>ֶ<'+MyField+'>'),'ʾ',0); - end; -end; -procedure SCreateCDS20(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.Close; - mClientDataset.CreateDataSet; -end; -procedure SCreateCDSYS(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.Close; - mClientDataset.CreateDataSet; -end; -procedure SCreateCDSOnly(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.Close; - mClientDataset.CreateDataSet; -end; -procedure SInitCDSData20(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 SInitCDSDataYS(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; - inc(k); - Post; - end; - fromADO.Next; - end; - if not toCDS.IsEmpty then - begin - toCDS.First ; - end; - finally - toCDS.EnableControls; - end; -end; -procedure SInitCDSDataOnly(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; - inc(k); - Post; - end; - fromADO.Next; - end; - if not toCDS.IsEmpty then - begin - toCDS.First ; - end; - finally - toCDS.EnableControls; - end; -end; -procedure SInitFtComBoxBySql(ADOQueryTmp:TADOQuery; - cb: TFtComboBox;FlagType:string; - Boxtype:integer; - showMsg:string; - emptyFlag:Boolean; - mSql:string - ); -begin - with ADOQueryTmp do - begin - close; - sql.clear; - sql.Add(mSql); - Open; - if isEmpty then - begin - application.MessageBox(pChar(showMsg),'',0); - exit; - end; - cb.Clear; - while not EOF do - begin - if Boxtype=0 then - begin - cb.Items.Add(trim(fieldByName('Name').AsString)); - end - else - begin - cb.AddItem2(trim(fieldByName('Name').AsString),nil,trim(fieldByName('code').AsString)); - end; - next; - end; - - if not emptyFlag then - cb.Items.Add(''); - - if emptyFlag and (cb.Items.Count >0) then - cb.ItemIndex :=0; - end; -end; -procedure SInitComBoxBySql(ADOQueryTmp:TADOQuery; - cb: TComboBox; - emptyFlag:Boolean; - mSql:string - ); -begin - cb.Clear; - with ADOQueryTmp do - begin - close; - sql.clear; - sql.Add(mSql); - Open; - if isEmpty then - begin - exit; - end; - 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; -////////////////////////////////////////////// - //Իcomboxе - //XC_CustCodeȡ - //Boxtype:0; ţ1; -////////////////////////////////////////////// -procedure SInitComBoxByCustCode(ADOQueryTmp:TADOQuery; - cb: TComboBox;FlagType:string; - Boxtype:integer; - showMsg:string; - emptyFlag:Boolean - ); -var - A:TA; -begin - cb.Items.Clear ; - with ADOQueryTmp do - begin - close; - sql.clear; - sql.Add('exec P_Get_XC_Custcode'); - sql.Add(quotedStr(trim(flagType))); - Open; - if isEmpty then - begin - application.MessageBox(pChar('ͻϢάģδҵ'+showMsg),'',0); - exit; - end; - - while not EOF do - begin - if Boxtype=0 then - begin - cb.Items.Add(trim(fieldByName('name').AsString)); - end - else - begin - A := TA.Create(Nil); - A.s:= trim(fieldByName('code').AsString); - cb.Items.AddObject(trim(fieldByName('name').AsString),TObject(a)); - end; - next; - end; - - if not emptyFlag then - cb.Items.Add(''); - - if emptyFlag and (cb.Items.Count >0) then - cb.ItemIndex :=0; - end; -end; -procedure SInitCxGridComboBoxByCustCode(ADOQueryTmp:TADOQuery;c3:TcxGriddbColumn; - FlagType: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(' select * from XC_CustCode '+ - ' where Flag='''+trim(FlagType)+''' '+ - ' order by orderno '); - Open; - if isEmpty then - begin - Application.MessageBox(PChar('ͻϢάģδҵ:'+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 - (c3.Properties as TcxComboBoxProperties).Items.Add(''); - 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(PChar('δҵ:'+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(PChar('δҵ:'+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; - - -/////////////////////////////////////////////////// -//***** ***** // -///////////////////////////////////////////////// -function SSWR(s: real): real; -var - r1, r2: real; - s1, s2: string; -begin - r1:= int(s); - r2:= frac(s); - s1:= copy(floattostr(r1), 1, length(floattostr(r1))); - if length(floattostr(r2)) >= 5 then - begin - if strtoint(copy((floattostr(r2)), 5, 1)) >= 5 then - if strtoint(copy((floattostr(r2)), 4, 1)) = 9 then - if strtoint(copy((floattostr(r2)), 3, 1)) = 9 then - begin - s1:= inttostr(strtoint(s1) + 1); - s2:= ''; - end - else - S2:= inttostr(strtoint(copy((floattostr(r2)), 3, 1)) + 1) - else - if copy((floattostr(r2)), 3, 1) = '0' then - S2:= '0' + inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) - else - s2:= inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) - else - s2:= copy(floattostr(r2), 3, 2); - end - else - s2:= copy(floattostr(r2), 3, 2); - result := strtofloat(s1 + '.' + s2); -end; - -procedure SInitCDSDataSel(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; - inc(k); - Post; - end; - fromADO.Next; - end; - if not toCDS.IsEmpty then - begin - toCDS.First ; - end; - finally - toCDS.EnableControls; - end; -end; - -procedure SCreateCDSSel(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.Close; - mClientDataset.CreateDataSet; -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..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 CopyAddRowCDS(CDS_Sub:TClientDataSet); -var - AA:array[0..1000] 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 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; - - -/////////////////////////////////////////////////// -//ܣȡˮ -//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(Pchar('޷ˮ('+mflag+')'),'ʾϢ',MB_ICONINFORMATION); - - Except - result:=false; - application.MessageBox(Pchar('޷ˮ('+mflag+')'),'ʾϢ',MB_ICONINFORMATION); - - end; -end; -/////////////////////////////////////////////////// -//ܣȡˮ -//mFlag:ǰ׺mTable: -//mlen:ˮų; -//mtype:Ƿ 1 0 -//HZype 0 ȡţ1ȡţ2ȡ,3ȡ,4ȡ -/////////////////////////////////////////////////// -function GetLSNoHZ(ADOQueryTmp: TADOQuery; var mMaxNo: string; mFlag: string; mTable: string; mlen: integer; mtype: integer = 0; HZype: integer = 0): Boolean; -begin - try - with ADOQueryTmp do - begin - Close; - sql.Clear; - sql.Add('exec Get_SY_MaxBH_HZ '); - sql.Add(' ' + quotedStr(mFlag)); - sql.Add(',' + quotedStr(mTable)); - sql.Add(',' + intTostr(mlen)); - sql.Add(',' + intTostr(mtype)); - sql.Add(',' + intTostr(HZype)); - // 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(Pchar('޷ɻˮ(' + mFlag + ')'), 'ʾϢ', MB_ICONINFORMATION); - - except - result := false; - application.MessageBox(Pchar('޷ɻˮ(' + 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); - CreateGroupSummarry(cxgrid); -end; -/////////////////////////////////////////////////////////////// - //ܣļжȡcxGridCol - //fileName ƼΪڵcaptioncaption -/////////////////////////////////////////////////////////////// -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 CreateGroupSummarry(tv1:TcxGridDBTableView); -var - csg : TcxDataSummaryGroup; - csglink : TcxDataSummaryGroupItemLink; - csgItem : TcxDataSummaryItem; - i:integer; - mFieldName:string; -begin - /// - with tv1.DataController.Summary do - begin - try - csg := DataController.Summary.SummaryGroups.Add; // - - csg.Links.Clear; - for i:= 0 to tv1.ColumnCount -1 do - begin - if not tv1.Columns[i].Visible then continue; - mFieldName:=tv1.Columns[i].DataBinding.FieldName; - - if tv1.Columns[i].Summary.FooterKind=skSum then - begin - // (tv1.DataController.DataSet.Fields[i] as TNumericField).DisplayFormat := '#,0.00;-#,0.00;#'; - //tv1.Columns[i].Summary.FooterFormat:='0.0'; - //tv1.Columns[i].Summary.FooterKind := skSum; - - //Group RowϵĻͬʱʹʱֻһЧ - //зϵĻ - - csgitem := csg.SummaryItems.Add; - csgitem.ItemLink := tv1.Columns[i]; //ֶ1 - csgitem.Position :=spGroup; - csgitem.Kind := skSum; - csgItem.Format := trim(tv1.Columns[i].Caption) +'С=#,0.0'; - - tv1.Columns[i].Summary.GroupFooterKind := skSum; - tv1.Columns[i].Summary.GroupFooterFormat := '#,0.00'; - - end - else if tv1.Columns[i].Summary.FooterKind=skCount then - begin - // (tv1.DataController.DataSet.Fields[i] as TNumericField).DisplayFormat := '#,0.00;-#,0.00;#'; - //tv1.Columns[i].Summary.FooterFormat:='0.0'; - tv1.Columns[i].Summary.FooterKind := skCount; - - tv1.Columns[i].Summary.GroupFooterKind := skCount; - - //tv1.Columns[i].Summary.GroupFooterFormat := '#,0.00'; - //Group RowϵĻͬʱʹʱֻһЧ - //зϵĻ - csgitem := csg.SummaryItems.Add; - csgitem.ItemLink := tv1.Columns[i]; //ֶ1 - csgitem.Kind := skCount; - //csgItem.Format := 'С=#,0.0'; - - end - else - begin - csglink := csg.Links.Add; - csglink.ItemLink := tv1.Columns[i]; //ֶ - //вܵжп飬뽫Щм뵽 - //SummaryGroupItemLinkУûмӵʱ - //ֵʾ - end; - - end; - finally - end; - end; - -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 TcxGridToExcelEng(mfileName:string;gridName:TcxGrid); -var - saveDialog:TSaveDialog; -begin - try - saveDialog:=TSaveDialog.Create(nil); - saveDialog.Filter:='xls(*.xls)|*.xls|ALL(*.*)|*.*'; - saveDialog.Options:=[ofOverwritePrompt]; - saveDialog.FileName:=mfileName; - if saveDialog.Execute then - if Assigned(gridName) then - begin - try - - ExportGridToExcel(saveDialog.FileName,gridName); - except - application.MessageBox('The source file may be in edit mode!','Prompt message',0); - exit; - end; - application.MessageBox('Export success!','Prompt message',0); - end - else - application.MessageBox('Export failure!','Prompt message',0); - finally - saveDialog.Free; - end; -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; - -procedure SelExportData(FTv:TcxGridDBTableView;FAdoQry:TADOQuery;FTile:string); -var - i,j:Integer; - fsj:string; -begin - if FAdoQry.IsEmpty then Exit; - try - frmSelExportField:=TfrmSelExportField.Create(Application); - with frmSelExportField do - begin - with frmSelExportField.ExpGrid do - begin - // ExpGrid.Columns.Clear; - ExpGrid.ClearItems; - frmSelExportField.IniName:=FTile; - {if FTv.OptionsView.Footer=true then - begin - ExpGrid.OptionsView.Footer:=True; - end else - begin - ExpGrid.OptionsView.Footer:=False; - end; } - ExpGrid.OptionsView.Footer:=FTv.OptionsView.Footer; - for i:=0 to FTv.ColumnCount-1 do - begin - //if FTv.Columns[i].Visible=True then - begin - ExpGrid.CreateColumn; - j:=ExpGrid.ColumnCount-1; - ExpGrid.Columns[j].Caption:=FTv.Columns[i].Caption; - ExpGrid.Columns[i].Visible:=FTv.Columns[i].Visible; - ExpGrid.Columns[j].DataBinding.FieldName:=FTv.Columns[i].DataBinding.FieldName; - ExpGrid.Columns[j].Width:=FTv.Columns[i].Width; - ExpGrid.Columns[i].Summary.FooterKind:=FTv.Columns[i].Summary.FooterKind; - - end; - end; - end; - ExportDataSource.DataSet:=FAdoQry; - FAdoQry.Open; - if ShowModal=1 then - begin - - end; - end; - frmSelExportField.Free; - except - - end; -end; -procedure SelExportDataBand(FTv:TcxGridDBBandedTableView;FAdoQry:TADOQuery;FTile:string); -var - i,j:Integer; - fsj:string; -begin - if FAdoQry.IsEmpty then Exit; - try - frmSelExportField:=TfrmSelExportField.Create(Application); - with frmSelExportField do - begin - with frmSelExportField.ExpGrid do - begin - // ExpGrid.Columns.Clear; - ExpGrid.ClearItems; - frmSelExportField.IniName:=FTile; - {if FTv.OptionsView.Footer=true then - begin - ExpGrid.OptionsView.Footer:=True; - end else - begin - ExpGrid.OptionsView.Footer:=False; - end; } - ExpGrid.OptionsView.Footer:=FTv.OptionsView.Footer; - for i:=0 to FTv.ColumnCount-1 do - begin - if FTv.Columns[i].Visible=True then - begin - ExpGrid.CreateColumn; - j:=ExpGrid.ColumnCount-1; - ExpGrid.Columns[j].Caption:=FTv.Columns[i].Caption; - ExpGrid.Columns[j].DataBinding.FieldName:=FTv.Columns[i].DataBinding.FieldName; - ExpGrid.Columns[j].Width:=FTv.Columns[i].Width; - ExpGrid.Columns[i].Summary.FooterKind:=FTv.Columns[i].Summary.FooterKind; - - end; - end; - end; - ExportDataSource.DataSet:=FAdoQry; - FAdoQry.Open; - if ShowModal=1 then - begin - - end; - end; - frmSelExportField.Free; - except - - end; -end; -procedure ColumnView(AdoQueryTemp:TADOQuery;Tv1:TcxGridDBTableView;MKName10:string); -begin - with ADOQueryTemp do - begin - Close; - sql.Clear; - sql.Add('select * from Table_Column where CxTabName='''+Trim(MKName10)+''' and Owner='''+Trim(DCode)+''''); - sql.Add(' and TCNotVisble=1 '); - open; - end; - if ADOQueryTemp.IsEmpty=False then - begin - with ADOQueryTemp do - begin - First; - while not eof do - begin - - TV1.GetColumnByFieldName(ADOQueryTemp.fieldbyname('ColName').AsString).Visible:=False; - TV1.GetColumnByFieldName(ADOQueryTemp.fieldbyname('ColName').AsString).Hidden:=True; - Next; - end; - end; - end; -end; -procedure ColumnBandView(AdoQueryTemp:TADOQuery;Tv1:TcxGridDBBandedTableView;MKName10:string); -var - fsj:string; -begin - with ADOQueryTemp do - begin - Close; - sql.Clear; - sql.Add('select * from Table_Column where CxTabName='''+Trim(MKName10)+''' and Owner='''+Trim(DCode)+''''); - sql.Add(' and TCNotVisble=1 '); - open; - end; - if ADOQueryTemp.IsEmpty=False then - begin - with ADOQueryTemp do - begin - First; - while not eof do - begin - fsj:=Trim(ADOQueryTemp.fieldbyname('ColName').AsString); - // Tv1.Controller.ge - Tv1.GetColumnByFieldName(fsj).Visible:=False; - Tv1.GetColumnByFieldName(fsj).Hidden:=True; - Next; - end; - end; - end; -end; -procedure ColumnSet(TV10:TcxGridDBTableView;MKName10:String); -var - i:Integer; -begin - try - frmColumnSet:=TfrmColumnSet.Create(Application); - with frmColumnSet do - begin - ADOQuery2.DisableControls; - with ADOQuery2 do - begin - Close; - sql.Clear; - sql.Add('select * from Table_Column where 1<>1'); - Open; - end; - SCreateCDS20(ADOQuery2,ClientDataSet2); - SInitCDSData20(ADOQuery2,ClientDataSet2); - ADOQuery2.EnableControls; - MKName:=MKName10; - for i:=0 to TV10.ColumnCount-1 do - begin - with ClientDataSet2 do - begin - Append; - FieldByName('CxTabName').Value:=MKName; - FieldByName('CxColName').Value:=Trim(TV10.Columns[i].Caption); - FieldByName('ColName').Value:=Trim(TV10.Columns[i].DataBinding.FieldName); - Post; - end; - end; - if ShowModal=1 then - begin - - end; - end; - finally - frmColumnSet.Free; - end; -end; -procedure ColumnBandSet(TV10:TcxGridDBBandedTableView;MKName10:String); -var - i:Integer; -begin - try - frmColumnBandSet:=TfrmColumnBandSet.Create(Application); - with frmColumnBandSet do - begin - ADOQuery2.DisableControls; - with ADOQuery2 do - begin - Close; - sql.Clear; - sql.Add('select * from Table_Column where 1<>1'); - Open; - end; - SCreateCDS20(ADOQuery2,ClientDataSet2); - SInitCDSData20(ADOQuery2,ClientDataSet2); - ADOQuery2.EnableControls; - MKName:=MKName10; - for i:=0 to TV10.ColumnCount-1 do - begin - with ClientDataSet2 do - begin - Append; - FieldByName('CxTabName').Value:=Trim(TV10.Bands[TV10.Columns[i].Position.BandIndex].Caption); - FieldByName('CxColName').Value:=Trim(TV10.Columns[i].Caption); - FieldByName('ColName').Value:=Trim(TV10.Columns[i].DataBinding.FieldName); - FieldByName('OrderNo').Value:=i; - Post; - end; - end; - ADOQuery5.DisableControls; - with ADOQuery5 do - begin - Close; - sql.Clear; - sql.Add('select * from Table_Name where 1<>1'); - Open; - end; - SCreateCDS20(ADOQuery5,CDSName); - SInitCDSData20(ADOQuery5,CDSName); - ADOQuery2.EnableControls; - MKName:=MKName10; - for i:=0 to TV10.Bands.Count-1 do - begin - with CDSName do - begin - Append; - FieldByName('CxTabName').Value:=Trim(TV10.Bands[i].Caption); - FieldByName('OrderNo').Value:=i; - Post; - end; - end; - if ShowModal=1 then - begin - - end; - end; - finally - frmColumnBandSet.Free; - end; -end; - -procedure GetSWLDZ(IPStr:string); -var - myip:ulong; - mymac:array[0..5] of byte; - mymaclength:ulong; - r:integer; -begin - {myip:=inet_addr(PChar(Trim(IPStr))); - mymaclength:=length(mymac); - r:=sendarp(myip,0,@mymac,@mymaclength); - IpCall:=r; - IpWLDZStr:=format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]);} -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 SelOKNoAdo(CDS_MainSel:TADOQuery;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; -function num2ceng(strArabic:string):string;//СתӢ -const - sw:array[2..9]of string=('twenty','thirty','forty','fifty','sixty','seventy','eighty','ninety'); - gw:array[1..19] of string=('one','two','three','four','five','six','seven','eight','nine','ten','eleven','twelve','thirteen','fourteen','fifteen','sixteen','seventeen','eighteen','nineteen'); - exp:array[1..4] of string=('','thousand','million','billion'); -var - t,j,glb,t1 :integer; - ts:string; - function readu1000(ss:string):string; - var - t,code:integer; - begin - result := ''; - while ss[1]='0' do - begin - delete(ss,1,1); - if length(ss)=0 then exit;//ȫ0 - end; - if length(ss)=3 then - begin - appendstr(result,gw[ord(ss[1])-ord('0')]); - //appendstr(result,' hundred '); - appendstr(result,' hundred '); - delete(ss,1,1); - end; - while ss[1]='0' do - begin - delete(ss,1,1); - if length(ss)=0 then exit; - end; - if length(ss)<>0 then - if result <> '' then appendstr(result,'and '); - if (glb = 1) and (t1<>1) then //λʱ3λ - if result='' then appendstr(result,'and '); - begin - val(ss,t,code); - if t<20 then result :=result+gw[t] - else if t mod 10=0 then result:=result+sw[t div 10] - else - //result := result+sw[trunc(t/10)]+'-'+gw[t mod 10]; - result := result+sw[trunc(t/10)]+' '+gw[t mod 10]; - end; - end; -begin - result :=''; - t := pos('.',strArabic); - if t=0 then t:=length(strArabic)+1; - while (t mod 3<>1)do - begin - t:=t+1; - strArabic:='0'+ strArabic; - end; - t1:=(t-1) div 3; - for glb:=t1 downto 1 do - begin - ts:=''; - for j:=1 to 3 do - begin - ts:=ts+ strArabic[1]; - delete(strArabic,1,1); - end; - result := result + readu1000(ts); - if ts<>'000' then result := result+' '+exp[glb]+' '; - end; - if length(strArabic)<>0 then - begin - delete(strArabic,1,1); - appendstr(result,'and '); - result :=result + readu1000(strArabic); - end; -end; -function num2cengnum(strArabic:string):string; -const - gw:array[1..10] of string =('0','one','two','three','four','five','six','seven','eight','nine'); -var - p,i,j,x:integer; - s:string; -begin - result := ''; - s := strarabic; - p := pos('.',strarabic); - if p = 0 then - begin - result := num2ceng(strarabic)+'Only'; - exit; - end - else - begin - i := length(s)-p;//Смλ - delete(strarabic,p,i+1);//ɾС - result := num2ceng(strarabic)+'Point'; - end; - for x:=1 to i do //תС - begin - j:= strtoint(copy(s,p+x,1)); - case j of - 0: result := result +' '+gw[1]; - 1: result := result +' '+gw[2]; - 2: result := result +' '+gw[3]; - 3: result := result +' '+gw[4]; - 4: result := result +' '+gw[5]; - 5: result := result +' '+gw[6]; - 6: result := result +' '+gw[7]; - 7: result := result +' '+gw[8]; - 8: result := result +' '+gw[9]; - 9: result := result +' '+gw[10]; - end; - end; -end; -procedure DelCDS(ClientDataSet1:TClientDataSet;ADOCmd:TADOQuery;DelSql:string); -begin - if ClientDataSet1.IsEmpty then Exit; - if Trim(ClientDataSet1.fieldbyname('ZSID').AsString)<>'' then - begin - if Application.MessageBox('ȷҪɾ','ʾ',32+4)<>IDYES then Exit; - with ADOCmd do - begin - Close; - SQL.Clear; - sql.Add(DelSql); - ExecSQL; - end; - end; - ClientDataSet1.Delete; -end; - -end. - +end; + +///////////////////ȡIntֵֶ/////////////////////////////////////// +function SGetMaxId(AdoQueryTemp: TADOQuery; MyTable: string; MyField: string; var MaxId: Integer): Boolean; +begin + try + with AdoQueryTemp do + begin + Close; + SQL.Clear; + SQL.Add('select Max(' + MyField + ')+1 MaxId from ' + MyTable); + Open; + end; + with AdoQueryTemp do + begin + if (Trim(FieldByName('MaxId').AsString) = '') or (Trim(FieldByName('MaxId').AsString) = NULL) then + MaxId := 1 + else + MaxId := (fieldbyname('MaxId').AsInteger); + Close; + SQL.Clear; + end; + Result := True; + except + Result := False; + Application.MessageBox('ȡֵʧܣ', 'ʾ', 0); + end; +end; + +procedure InitBCGangNo(OrdSubId: string; Combox: TComboBox; FAdoQry: TADOQuery); +var + fsj: string; +begin + fsj := 'select distinct(AOrdDefStr1) Code from JYOrder_Sub_AnPai ' + ' where Subid=''' + Trim(OrdSubId) + ''''; + with FAdoQry do + begin + Close; + sql.Clear; + sql.Add(fsj); + Open; + end; + Combox.Clear; + with FAdoQry do + begin + First; + while not Eof do + begin + Combox.Items.Add(Trim(FAdoQry.fieldbyname('Code').AsString)); + Next; + end; + end; + Combox.Items.Add(''); +end; + +procedure InitRCGangNo(OrdSubId: string; Combox: TComboBox; FAdoQry: TADOQuery); +var + fsj: string; +begin + fsj := 'select distinct(gangno) Code from JYOrder_Sub_AnPai ' + ' where Subid=''' + Trim(OrdSubId) + ''''; + with FAdoQry do + begin + Close; + sql.Clear; + sql.Add(fsj); + Open; + end; + Combox.Clear; + with FAdoQry do + begin + First; + while not Eof do + begin + Combox.Items.Add(Trim(FAdoQry.fieldbyname('Code').AsString)); + Next; + end; + end; + Combox.Items.Add(''); +end; + +procedure InitOrderColor(OrdMainId: string; Combox: TComboBox; FAdoQry: TADOQuery); +var + fsj: string; +begin + fsj := 'select distinct(PRTColor) Code from JYOrder_Sub ' + ' where Mainid=''' + Trim(OrdMainId) + ''''; + with FAdoQry do + begin + Close; + sql.Clear; + sql.Add(fsj); + Open; + end; + Combox.Clear; + with FAdoQry do + begin + First; + while not Eof do + begin + Combox.Items.Add(Trim(FAdoQry.fieldbyname('Code').AsString)); + Next; + end; + end; + Combox.Items.Add(''); +end; +////Զӡ + +procedure SelPrintData(FTv: TcxGridDBTableView; FAdoQry: TADOQuery; FTitle: string; FLTitle: string; FRTile: string); +var + i, j, k, KK: Integer; + fsj: string; + FOrder, fcolumnName: string; +begin + {if FAdoQry.IsEmpty then Exit; + try + frmSelPrintFieldNew:=TfrmSelPrintFieldNew.Create(Application); + with frmSelPrintFieldNew do + begin + with frmSelPrintFieldNew.PrnGrid do + begin + PrnGrid.Columns.Clear; + frmSelPrintFieldNew.IniName:=FTitle; + for i:=0 to FTv.ColumnCount-1 do + begin + if FTv.Columns[i].Visible=True then + begin + PrnGrid.Columns.Add; + j:=PrnGrid.Columns.Count-1; + PrnGrid.Columns[j].Title.Caption:=FTv.Columns[i].Caption; + PrnGrid.Columns[j].FieldName:=FTv.Columns[i].DataBinding.FieldName; + PrnGrid.Columns[j].Width:=FTv.Columns[i].Width; + if FTv.Columns[i].SortOrder=soAscending then + begin + FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' '; + end else + if FTv.Columns[i].SortOrder=soDescending then + begin + FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' DESC'; + end; + end; + end; + end; + FAdoQry.Sort:=FOrder; + frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.TitleMemo.Add(FTitle); + frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.LeftMemo.Add(FLTitle); + frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.RightMemo.Add(FRTile); + SCreatecds20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); + SInitCDSData20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); + if FTv.OptionsView.Footer=True then + begin + if FTv.DataController.Summary.FooterSummaryItems.Count>0 then + begin + frmSelPrintFieldNew.ClientDataSet1.Append; + //frmSelPrintFieldNew.ClientDataSet1.FieldByName('Sindex').Value:=frmSelPrintFieldNew.ClientDataSet1.RecNo+1; + frmSelPrintFieldNew.ClientDataSet1.Post; + KK:=0; + for i:=0 to FTv.ColumnCount-1 do + begin + if FTv.Columns[i].Visible=False then Continue; + + fcolumnName:=FTv.Columns[i].Name; + if FTv.Columns[i].Summary.FooterKind<>sknone then + begin + for k:=0 to FTv.DataController.Summary.FooterSummaryItems.Count-1 do + begin + if TcxGridDBTableSummaryItem(FTv.DataController.Summary.FooterSummaryItems.Items[k]).Column.Name=fcolumnName then + begin + frmSelPrintFieldNew.ClientDataSet1.edit; + frmSelPrintFieldNew.ClientDataSet1.FieldByName(FTv.Columns[i].DataBinding.FieldName).Value:= + FTv.DataController.Summary.FooterSummaryValues[k]; + frmSelPrintFieldNew.ClientDataSet1.Post; + end; + end; + end; + end; + end; + end; + if ShowModal=1 then + begin + + end; + end; + + finally + frmSelPrintFieldNew.Free; + end; } +end; +////Զӡ + +procedure SelPrintDataMore(FTv: TcxGridDBTableView; FAdoQry: TADOQuery; FTitle: string; FLTitle: string; FRTile: string; FKK: Integer; FiniName: string); +var + i, j, k, KK: Integer; + fsj: string; + FOrder, fcolumnName: string; +begin + {if FAdoQry.IsEmpty then Exit; + try + frmSelPrintFieldNew:=TfrmSelPrintFieldNew.Create(Application); + with frmSelPrintFieldNew do + begin + with frmSelPrintFieldNew.PrnGrid do + begin + PrnGrid.Columns.Clear; + frmSelPrintFieldNew.IniName:=FiniName; + for i:=0 to FTv.ColumnCount-1 do + begin + if FTv.Columns[i].Visible=True then + begin + PrnGrid.Columns.Add; + j:=PrnGrid.Columns.Count-1; + PrnGrid.Columns[j].Title.Caption:=FTv.Columns[i].Caption; + PrnGrid.Columns[j].FieldName:=FTv.Columns[i].DataBinding.FieldName; + PrnGrid.Columns[j].Width:=FTv.Columns[i].Width; + if FTv.Columns[i].SortOrder=soAscending then + begin + FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' '; + end else + if FTv.Columns[i].SortOrder=soDescending then + begin + FOrder:=' '+FTv.Columns[i].DataBinding.FieldName+' DESC'; + end; + end; + end; + end; + FAdoQry.Sort:=FOrder; + frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.TitleMemo.Add(FTitle); + frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.LeftMemo.Add(FLTitle); + frmSelPrintFieldNew.RMPrintDBGrid1.PageCaptionMsg.CaptionMsg.RightMemo.Add(FRTile); + + SCreatecds20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); + SInitCDSData20(FAdoQry,frmSelPrintFieldNew.ClientDataSet1); + if FTv.OptionsView.Footer=True then + begin + if FTv.DataController.Summary.FooterSummaryItems.Count>0 then + begin + frmSelPrintFieldNew.ClientDataSet1.Append; + + frmSelPrintFieldNew.ClientDataSet1.Post; + KK:=0; + for i:=0 to FTv.ColumnCount-1 do + begin + + + fcolumnName:=FTv.Columns[i].Name; + if FTv.Columns[i].Summary.FooterKind<>sknone then + begin + if KK=0 then + begin + frmSelPrintFieldNew.ClientDataSet1.edit; + frmSelPrintFieldNew.ClientDataSet1.FieldByName(FTv.Columns[i-FKK].DataBinding.FilterFieldName).Value:='Total'; + frmSelPrintFieldNew.ClientDataSet1.Post; + KK:=99; + end; + for k:=0 to FTv.DataController.Summary.FooterSummaryItems.Count-1 do + begin + if TcxGridDBTableSummaryItem(FTv.DataController.Summary.FooterSummaryItems.Items[k]).Column.Name=fcolumnName then + begin + frmSelPrintFieldNew.ClientDataSet1.edit; + frmSelPrintFieldNew.ClientDataSet1.FieldByName(FTv.Columns[i].DataBinding.FieldName).Value:= + FTv.DataController.Summary.FooterSummaryValues[k]; + frmSelPrintFieldNew.ClientDataSet1.Post; + end; + end; + end; + end; + end; + end; + if ShowModal=1 then + begin + + end; + end; + + finally + frmSelPrintFieldNew.Free; + end;} +end; +///////////////////////жϱǷظ/////////////////////////////////// + +function SIsRepeated(AdoQueryTemp: TADOQuery; MyTable: string; MyField: string; MyCode: string): Boolean; +begin + try + Result := False; + with AdoQueryTemp do + begin + Close; + SQL.Clear; + SQL.Add('select * from ' + MyTable + ' where ' + MyField + '=''' + Trim(MyCode) + ''''); + Open; + if IsEmpty then + Result := True; + Close; + SQL.Clear; + end; + except + Result := False; + Application.MessageBox('ֶ', 'ʾ', 0); + end; +end; +////////////////////ClientDataSetıϢ///////////////////////////// + +function SSetSaveDataCDS(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 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; + + end; + end; + Result := True; + except + Result := False; + Application.MessageBox('CdsϢʧ!', 'ʾ', 0); + end; +end; +////////////////////ClientDataSetıϢ///////////////////////////// + +function SSetSaveDataCDSNew(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 = True then + begin + if Trim(Tv1.Columns[i].Summary.GroupFooterFormat) <> '1' then + 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 + AdoQueryCmd.FieldByName(Tv1.Columns[i].DataBinding.FieldName).Value:=null; + end}; + end; + if Trim(Tv1.Columns[i].Summary.GroupFormat) <> '' then + begin + if Trim(CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).AsString) <> '' then + begin + AdoQueryCmd.FieldByName(Tv1.Columns[i].Summary.GroupFormat).Value := CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).Value; + 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 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 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 + + 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 := Trim(Tv1.Columns[i].Summary.GroupFooterFormat); + end; + + end; + + end; + end; + Result := True; + except + Result := False; + Application.MessageBox('CdsϢʧ!', 'ʾ', 0); + end; +end; + +function SSetSaveDataCDSBandNew(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 Trim(Tv1.Columns[i].Summary.GroupFooterFormat) <> '1' then + 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; + end; + if Trim(Tv1.Columns[i].Summary.GroupFormat) <> '' then + begin + if Trim(CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).AsString) <> '' then + begin + AdoQueryCmd.FieldByName(Tv1.Columns[i].Summary.GroupFormat).Value := CDS_Sub.fieldbyname(Tv1.Columns[i].Summary.GroupFormat).Value; + end; + end; + + end; + end; + Result := True; + except + Result := False; + Application.MessageBox('CdsϢʧ!', 'ʾ', 0); + end; +end; +////////////////////ClientDataSetıϢ///////////////////////////// + +function SSetSaveDataCDS10(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 Trim(CDS_Sub.fieldbyname(Tv1.Columns[i].DataBinding.FieldName).AsString) <> '' then + AdoQueryCmd.FieldByName(Tv1.Columns[i].DataBinding.FieldName).Value := CDS_Sub.fieldbyname(Tv1.Columns[i].DataBinding.FieldName).Value; + 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 SGetServerDateTime(ADOQueryTmp: TADOQuery): TdateTime; +begin + 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; + +function SGetServerDate10(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; + +///////////////////////////////////////////////////// +//ʱֶθֵ +///////////////////////////////////////////////////// +procedure SSetsavedata(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 TEdit then + begin + if Trim(TEdit(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Text); + 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 TcxRichEdit then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TcxRichEdit(Controls[i]).Text; + end + else if Controls[i] is TMemo then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TMemo(Controls[i]).Text; + end; + if Controls[i] is TFTComboBox then + begin + if (TFTComboBox(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TFTComboBox(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 TCheckBox then + begin + if TCheckBox(Controls[i]).Checked = True then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := 1 + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := 0; + 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; + end + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime; + end + else if Controls[i] is TBtnEditA then + begin + if TBtnEditA(Controls[i]).Hint = '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditA(Controls[i]).Text) + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditA(Controls[i]).TxtCode); + end + else if Controls[i] is TBtnEditC then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditC(Controls[i]).TxtCode); + 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 SSetsavedataNew(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 TEdit then + begin + if Trim(TEdit(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Text); + 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; + if Controls[i] is TFTComboBox then + begin + if (TFTComboBox(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TFTComboBox(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; + end + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime; + end + else if Controls[i] is TBtnEditA then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditA(Controls[i]).TxtCode); + if (TBtnEditA(Controls[i]).Hint <> '') and (TBtnEditA(Controls[i]).ParentCtl3D = True) then + ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value := Trim(TBtnEditA(Controls[i]).Text); + end + else if Controls[i] is TBtnEditC then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditC(Controls[i]).TxtCode); + //if (TBtnEditC(Controls[i]).Hint<>'') and (TBtnEditC(Controls[i]).ParentCtl3D=True)then + //ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value:=Trim(TBtnEditC(Controls[i]).Text); + 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 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 TEdit then + begin + if Trim(TEdit(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Text); + 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; + if Controls[i] is TFTComboBox then + begin + if (TFTComboBox(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TFTComboBox(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; + end + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime; + end + else if Controls[i] is TBtnEditA then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditA(Controls[i]).Text); + if (TBtnEditA(Controls[i]).Hint <> '') then + ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value := Trim(TBtnEditA(Controls[i]).TxtCode); + end + else if Controls[i] is TBtnEditC then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditC(Controls[i]).Text); + if (TBtnEditC(Controls[i]).Hint <> '') then + ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value := Trim(TBtnEditC(Controls[i]).TxtCode); + 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 SSetsaveSql(ADOQueryCmd: TADOQuery; MyTable: string; 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 + if Trim(TEdit(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Text) + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Null; + 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 TcxRichEdit then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TcxRichEdit(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 TFTComboBox then + begin + if (TFTComboBox(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TFTComboBox(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; + end + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TDateTimePicker(Controls[i]).DateTime; + end + else if Controls[i] is TBtnEditA then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditA(Controls[i]).TxtCode); + if (TBtnEditA(Controls[i]).Hint <> '') and (TBtnEditA(Controls[i]).ParentCtl3D = True) then + ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value := Trim(TBtnEditA(Controls[i]).Text); + end + else if Controls[i] is TBtnEditC then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditC(Controls[i]).TxtCode); + //if (TBtnEditC(Controls[i]).Hint<>'') and (TBtnEditC(Controls[i]).ParentCtl3D=True)then + //ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value:=Trim(TBtnEditC(Controls[i]).Text); + end + else if Controls[i] is TcxTimeEdit then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TcxTimeEdit(Controls[i]).Text); + end + else if Controls[i] is TcxButtonEdit then + begin + if (TcxButtonEdit(Controls[i]).BeepOnEnter = True) or (TcxButtonEdit(Controls[i]).ParentShowHint = True) then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TcxButtonEdit(Controls[i]).Text); + if TcxButtonEdit(Controls[i]).ParentShowHint = False then + begin + MCode := Copy(Trim(Controls[i].Name), 1, Length(Trim(Controls[i].Name)) - 4); + ADOQueryCmd.FieldByName(MCode).Value := Trim(TcxButtonEdit(Controls[i]).Hint); + end; + end; + end; + end; + end; +end; + +procedure SSetsaveSqlNew(ADOQueryCmd: TADOQuery; MyTable: string; 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 + if Trim(TEdit(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TEdit(Controls[i]).Text) + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Null; + 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 TCheckBox then + begin + if TCheckBox(Controls[i]).Checked = True then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := 1 + else + ADOQueryCmd.FieldByName(Controls[i].Name).Value := 0; + end + else if Controls[i] is TcxRichEdit then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := TcxRichEdit(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 TFTComboBox then + begin + if (TFTComboBox(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TFTComboBox(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 TBtnEditA then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditA(Controls[i]).Text); + if (TBtnEditA(Controls[i]).Hint <> '') then + ADOQueryCmd.FieldByName(Trim(TBtnEditA(Controls[i]).Hint)).Value := Trim(TBtnEditA(Controls[i]).TxtCode); + end + else if Controls[i] is TBtnEditC then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TBtnEditC(Controls[i]).Text); + if (TBtnEditC(Controls[i]).Hint <> '') then + begin + if Pos('/', TBtnEditC(Controls[i]).Hint) > 0 then + begin + + end + else + ADOQueryCmd.FieldByName(Trim(TBtnEditC(Controls[i]).Hint)).Value := Trim(TBtnEditC(Controls[i]).TxtCode); + end; + end + else if Controls[i] is TcxTimeEdit then + begin + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TcxTimeEdit(Controls[i]).Text); + end + else if Controls[i] is TcxButtonEdit then + begin + if (TcxButtonEdit(Controls[i]).BeepOnEnter = True) or (TcxButtonEdit(Controls[i]).ParentShowHint = True) then + ADOQueryCmd.FieldByName(Controls[i].Name).Value := Trim(TcxButtonEdit(Controls[i]).Text); + if TcxButtonEdit(Controls[i]).ParentShowHint = False then + begin + MCode := Copy(Trim(Controls[i].Name), 1, Length(Trim(Controls[i].Name)) - 4); + ADOQueryCmd.FieldByName(MCode).Value := Trim(TcxButtonEdit(Controls[i]).Hint); + end; + end; + end; + end; + end; +end; + +procedure SSetsavedata10(ADOQueryCmd: TADOQuery; MyTable: string; Myparent: TWinControl; MyTag: integer); +var + i: Integer; + FFName: string; +begin + with Myparent do + begin + for i := 0 to ControlCount - 1 do + begin + FFName := Trim(Copy(Controls[i].Name, 1, (Length(Controls[i].Name) - 1))); + if Controls[i].Tag = MyTag then + begin + if Controls[i] is TEdit then + begin + if Trim(TEdit(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(FFName).Value := Trim(TEdit(Controls[i]).Text); + end + else if Controls[i] is TRichEdit then + begin + ADOQueryCmd.FieldByName(FFName).Value := TRichEdit(Controls[i]).Text; + end + else if Controls[i] is TMemo then + begin + ADOQueryCmd.FieldByName(FFName).Value := TMemo(Controls[i]).Text; + end; + if Controls[i] is TFTComboBox then + begin + if (TFTComboBox(Controls[i]).Text) <> '' then + ADOQueryCmd.FieldByName(FFName).Value := Trim(TFTComboBox(Controls[i]).Item2); + end + else if Controls[i] is TComboBox then + begin + ADOQueryCmd.FieldByName(FFName).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(FFName).Value := TDateTimePicker(Controls[i]).DateTime; + end + else + ADOQueryCmd.FieldByName(FFName).Value := TDateTimePicker(Controls[i]).DateTime; + end + else if Controls[i] is TBtnEditA then + begin + ADOQueryCmd.FieldByName(FFName).Value := Trim(TBtnEditA(Controls[i]).TxtCode); + end + else if Controls[i] is TBtnEditC then + begin + ADOQueryCmd.FieldByName(FFName).Value := Trim(TBtnEditC(Controls[i]).TxtCode); + 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 TFTComboBox then + begin + if Controls[i].Tag = 99 then + begin + idx := TftComboBox(Controls[i]).Items.IndexOf(trim(fieldByName(mfield).AsString)); + TComboBox(Controls[i]).ItemIndex := idx; + end + else + begin + idx := TftComboBox(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; + +procedure SInitComBoxByTvColumns(cb: TComboBox; Tv1: TcxGridDBTableView; ColumnTag: Integer; TowFlag: Boolean; emptyFlag: Boolean); +var + A: TA; + i: Integer; +begin + cb.Items.Clear; + for i := 0 to Tv1.ColumnCount - 1 do + begin + if Tv1.Columns[i].Tag = ColumnTag then + begin + if TowFlag = False then + begin + cb.Items.Add(trim(Tv1.Columns[i].Caption)); + end + else + begin + A := TA.Create(Nil); + A.s := Trim(Tv1.Columns[i].DataBinding.FieldName); + cb.Items.AddObject(Trim(Tv1.Columns[i].Caption), TObject(A)); + end; + end; + end; + if emptyFlag = False then + cb.Items.Add(''); + if cb.Items.Count > 0 then + cb.ItemIndex := 0; +end; + +procedure SSetWinData30(ADOQueryTmp: TADOQuery; mParent: TWinControl; FTag: Integer); +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 <> 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 TFTComboBox then + begin + idx := TftComboBox(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 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]).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 TRichEdit then + begin + TRichEdit(Controls[i]).Text := fieldbyname(mfield).AsString; + end; + end; // end for + end; // end with + end; //end for with + +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 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 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 TFTComboBox then + begin + idx := TftComboBox(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; + +procedure SCSHDataNew(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) + else + TEdit(Controls[i]).Text := ''; + end //ftcombobox + else if Controls[i] is TFTComboBox then + begin + idx := TftComboBox(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]).Text := trim(fieldByName(mfield).AsString); + if Trim(TBtnEditA(Controls[i]).Hint) <> '' then + TBtnEditA(Controls[i]).TxtCode := trim(fieldByName(Trim(TBtnEditA(Controls[i]).Hint)).AsString); + end + else if Controls[i] is TBtnEditC then + begin + TBtnEditC(Controls[i]).Text := trim(fieldByName(mfield).AsString); + if Trim(TBtnEditC(Controls[i]).Hint) <> '' then + begin + if Pos('/', TBtnEditC(Controls[i]).Hint) > 0 then + begin + + end + else + TBtnEditC(Controls[i]).TxtCode := trim(fieldByName(Trim(TBtnEditC(Controls[i]).Hint)).AsString); + end; + 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 + if FieldByName(mfield).Value = null then + TcheckBox(Controls[i]).Checked := False + else + 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; + +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 TFTComboBox then + begin + idx := TftComboBox(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; + +procedure SCSHDataWTag(ADOQueryTmp: TADOQuery; mParent: TWinControl); +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 TFTComboBox then + begin + idx := TftComboBox(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; + +procedure SSetWinData10(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:=Copy(Trim(Controls[i].Name),1,(Length(Trim(Controls[i].Name))-1)); + mfield := Trim(Controls[i].Name); + 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 TFTComboBox then + begin + if Controls[i].Tag = 99 then + begin + idx := TftComboBox(Controls[i]).Items.IndexOf(trim(fieldByName(mfield).AsString)); + TComboBox(Controls[i]).ItemIndex := idx; + end + else + begin + idx := TftComboBox(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 := 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 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 TcxLookupComboBox then + begin + TcxLookupComboBox(Controls[i]).EditValue:=fieldByName(mfield).AsString; + TcxLookupComboBox(Controls[i]).EditingText:=fieldByName(mfield+'name').AsString; + end}; + end; // end for + end; // end with + end; //end for with + +end; + +procedure SSetWinData20(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 := Copy(Trim(Controls[i].Name), 1, (Length(Trim(Controls[i].Name)) - 1)); + //mfield:=Trim(Controls[i].Name); + 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 TFTComboBox then + begin + if Controls[i].Tag = 99 then + begin + idx := TftComboBox(Controls[i]).Items.IndexOf(trim(fieldByName(mfield).AsString)); + TComboBox(Controls[i]).ItemIndex := idx; + end + else + begin + idx := TftComboBox(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 := 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 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 TcxLookupComboBox then + begin + TcxLookupComboBox(Controls[i]).EditValue:=fieldByName(mfield).AsString; + TcxLookupComboBox(Controls[i]).EditingText:=fieldByName(mfield+'name').AsString; + end}; + end; // end for + end; // end with + end; //end for with + +end; + +////////////////////////////////////////////// +//////ܣSQLɾ +////////////////////////////////////////////// +function SDelData(ADOQueryCmd: TADOQuery; mDelStr: string): Boolean; +begin + try + result := False; + with ADOQueryCmd do + begin + Close; + SQL.Clear; + SQL.Add(mDelStr); + ExecSQL; + end; + result := True; + except + result := False; + Application.MessageBox('ɾʧܣ', 'ʾ', 0); + end; +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) + '%') + else if Controls[i].Tag = 88 then + Result := Result + 'and ' + Controls[i].Name + ' like ' + QuotedStr(Trim(TBtnEditA(Controls[i]).Text) + '%'); + 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 TFTComboBox then + begin + if Trim(TFTComboBox(Controls[i]).Text) <> '' then + if Controls[i].Tag = EquTag then + Result := Result + 'and ' + Controls[i].Name + '=' + QuotedStr(Trim(TFTComboBox(Controls[i]).Item2)) + else if Controls[i].Tag = LikeTag then + Result := Result + 'and ' + Controls[i].Name + ' like ' + QuotedStr('%' + Trim(TFTComboBox(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(RightBStr(Result, Length(Result) - 4)); +end; + +function SGetFiltersHint(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].Hint + '=' + 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].Hint + ' 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].Hint + ' 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].Hint + ' like ' + QuotedStr('%' + Trim(fsj1) + '%'); + fsj1 := ''; + end; + end; + end + else + Result := Result + 'and ' + Controls[i].Hint + ' like ' + QuotedStr('%' + Trim(TEdit(Controls[i]).Text) + '%'); + end; + end; + end; + end; + end; + if Trim(Result) <> '' then + Result := Trim(RightBStr(Result, Length(Result) - 4)); +end; + +function SGetFinds(TMPanel: TPanel; EquTag, LikeTag: Integer): string; +var + i: Integer; +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 + Result := Result + 'and ' + Controls[i].Name + ' like ' + QuotedStr('%' + Trim(TEdit(Controls[i]).Text) + '%'); + 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) + '%'); + 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 TFTComboBox then + begin + if Trim(TFTComboBox(Controls[i]).Text) <> '' then + if Controls[i].Tag = EquTag then + Result := Result + 'and ' + Controls[i].Name + '=' + QuotedStr(Trim(TFTComboBox(Controls[i]).Item2)) + else if Controls[i].Tag = LikeTag then + Result := Result + 'and ' + Controls[i].Name + ' like ' + QuotedStr('%' + Trim(TFTComboBox(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; +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 SDofilter10(cds_Main: TClientDataSet; FilterStr: string); +begin + try + cds_Main.DisableControls; + with cds_Main do + begin + if Trim(FilterStr) = '' then + begin + Filtered := False; + end + else + begin + Filtered := False; + Filter := FilterStr; + Filtered := True; + end; + end; + finally + cds_Main.EnableControls; + end; +end; + +function SGetMaxNo(MyAdoQuery: TADOQuery; MyTable: string; MyField: string; MyFlag: string): string; +var + fsj: string; + i: Integer; +begin + try + result := ''; + fsj := Trim(Formatdatetime('yyyyMMdd', Now)); + i := Length(Trim(MyFlag)); + with MyAdoQuery do + begin + Close; + SQL.Clear; + sql.Add('select Max(' + MyField + ') MaxNo from ' + MyTable); + SQL.Add('where ' + MyField + ' like ' + QuotedStr('%' + fsj + '%')); + Open; + end; + with MyAdoQuery do + begin + if Trim(fieldbyname('MaxNo').AsString) = '' then + begin + Result := Trim(MyFlag) + Trim(Formatdatetime('yyyyMMdd', Now)) + '1001'; + Exit; + end; + end; + {fsj:=Trim(MyAdoQuery.fieldbyname('MaxNo').AsString); + + + with MyAdoQuery1 do + begin + Close; + SQL.Clear; + SQL.Add('select Max('+MyField+') MaxNo from '+MyTable); + SQL.Add('where '+MyField+' like '+QuotedStr('%'+copy(fsj,3,8)+'%')); + Open; + ShowMessage(copy(fsj,3,8)); + if Trim(fieldbyname('MaxNo').AsString)='' then + begin + Result:=Trim(MyFlag)+Trim(Formatdatetime('yyyyMMdd',Now))+'1001'; + Exit; + end; + end;} + fsj := Trim(MyAdoQuery.fieldbyname('MaxNo').AsString); + result := Trim(MyFlag) + Trim(Formatdatetime('yyyyMMdd', Now)) + IntToStr(StrtoInt(Copy(fsj, i + 9, Length(fsj) - i - 8)) + 1); + + except + Result := ''; + Application.MessageBox(PChar('ֶȡֵMaxNo󣬲鿴<' + Trim(MyTable) + '>ֶ<' + MyField + '>'), 'ʾ', 0); + end; +end; + +procedure SCreateCDS20(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.Close; + mClientDataset.CreateDataSet; +end; + +procedure SCreateCDSYS(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.Close; + mClientDataset.CreateDataSet; +end; + +procedure SCreateCDSOnly(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.Close; + mClientDataset.CreateDataSet; +end; + +procedure SInitCDSData20(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 SInitCDSDataYS(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; + inc(k); + Post; + end; + fromADO.Next; + end; + if not toCDS.IsEmpty then + begin + toCDS.First; + end; + finally + toCDS.EnableControls; + end; +end; + +procedure SInitCDSDataOnly(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; + inc(k); + Post; + end; + fromADO.Next; + end; + if not toCDS.IsEmpty then + begin + toCDS.First; + end; + finally + toCDS.EnableControls; + end; +end; + +procedure SInitFtComBoxBySql(ADOQueryTmp: TADOQuery; cb: TFtComboBox; FlagType: string; Boxtype: integer; showMsg: string; emptyFlag: Boolean; mSql: string); +begin + with ADOQueryTmp do + begin + close; + sql.clear; + sql.Add(mSql); + Open; + if isEmpty then + begin + application.MessageBox(pChar(showMsg), '', 0); + exit; + end; + cb.Clear; + while not EOF do + begin + if Boxtype = 0 then + begin + cb.Items.Add(trim(fieldByName('Name').AsString)); + end + else + begin + cb.AddItem2(trim(fieldByName('Name').AsString), nil, trim(fieldByName('code').AsString)); + end; + next; + end; + + if not emptyFlag then + cb.Items.Add(''); + + if emptyFlag and (cb.Items.Count > 0) then + cb.ItemIndex := 0; + end; +end; + +procedure SInitComBoxBySql(ADOQueryTmp: TADOQuery; cb: TComboBox; emptyFlag: Boolean; mSql: string); +begin + cb.Clear; + with ADOQueryTmp do + begin + close; + sql.clear; + sql.Add(mSql); + Open; + if isEmpty then + begin + exit; + end; + 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; +////////////////////////////////////////////// + //Իcomboxе + //XC_CustCodeȡ + //Boxtype:0; ţ1; +////////////////////////////////////////////// + +procedure SInitComBoxByCustCode(ADOQueryTmp: TADOQuery; cb: TComboBox; FlagType: string; Boxtype: integer; showMsg: string; emptyFlag: Boolean); +var + A: TA; +begin + cb.Items.Clear; + with ADOQueryTmp do + begin + close; + sql.clear; + sql.Add('exec P_Get_XC_Custcode'); + sql.Add(quotedStr(trim(FlagType))); + Open; + if isEmpty then + begin + application.MessageBox(pChar('ͻϢάģδҵ' + showMsg), '', 0); + exit; + end; + + while not EOF do + begin + if Boxtype = 0 then + begin + cb.Items.Add(trim(fieldByName('name').AsString)); + end + else + begin + A := TA.Create(Nil); + A.s := trim(fieldByName('code').AsString); + cb.Items.AddObject(trim(fieldByName('name').AsString), TObject(A)); + end; + next; + end; + + if not emptyFlag then + cb.Items.Add(''); + + if emptyFlag and (cb.Items.Count > 0) then + cb.ItemIndex := 0; + end; +end; + +procedure SInitCxGridComboBoxByCustCode(ADOQueryTmp: TADOQuery; c3: TcxGriddbColumn; FlagType: 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(' select * from XC_CustCode ' + ' where Flag=''' + trim(FlagType) + ''' ' + ' order by orderno '); + Open; + if isEmpty then + begin + Application.MessageBox(PChar('ͻϢάģδҵ:' + 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 + (c3.Properties as TcxComboBoxProperties).Items.Add(''); + 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(PChar('δҵ:'+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(PChar('δҵ:' + 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; + + +/////////////////////////////////////////////////// +//***** ***** // +///////////////////////////////////////////////// +function SSWR(s: real): real; +var + r1, r2: real; + s1, s2: string; +begin + r1 := int(s); + r2 := frac(s); + s1 := copy(floattostr(r1), 1, length(floattostr(r1))); + if length(floattostr(r2)) >= 5 then + begin + if strtoint(copy((floattostr(r2)), 5, 1)) >= 5 then + if strtoint(copy((floattostr(r2)), 4, 1)) = 9 then + if strtoint(copy((floattostr(r2)), 3, 1)) = 9 then + begin + s1 := inttostr(strtoint(s1) + 1); + s2 := ''; + end + else + s2 := inttostr(strtoint(copy((floattostr(r2)), 3, 1)) + 1) + else if copy((floattostr(r2)), 3, 1) = '0' then + s2 := '0' + inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) + else + s2 := inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) + else + s2 := copy(floattostr(r2), 3, 2); + end + else + s2 := copy(floattostr(r2), 3, 2); + result := strtofloat(s1 + '.' + s2); +end; + +procedure SInitCDSDataSel(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; + inc(k); + Post; + end; + fromADO.Next; + end; + if not toCDS.IsEmpty then + begin + toCDS.First; + end; + finally + toCDS.EnableControls; + end; +end; + +procedure SCreateCDSSel(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.Close; + mClientDataset.CreateDataSet; +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..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 CopyAddRowCDS(CDS_Sub: TClientDataSet); +var + AA: array[0..1000] 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 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; + + +/////////////////////////////////////////////////// +//ܣȡˮ +//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(Pchar('޷ˮ(' + mFlag + ')'), 'ʾϢ', MB_ICONINFORMATION); + + except + result := false; + application.MessageBox(Pchar('޷ˮ(' + mFlag + ')'), 'ʾϢ', MB_ICONINFORMATION); + + end; +end; +/////////////////////////////////////////////////// +//ܣȡˮ +//mFlag:ǰ׺mTable: +//mlen:ˮų; +//mtype:Ƿ 1 0 +//HZype 0 ȡţ1ȡţ2ȡ,3ȡ,4ȡ +/////////////////////////////////////////////////// + +function GetLSNoHZ(ADOQueryTmp: TADOQuery; var mMaxNo: string; mFlag: string; mTable: string; mlen: integer; mtype: integer = 0; HZype: integer = 0): Boolean; +begin + try + with ADOQueryTmp do + begin + Close; + sql.Clear; + sql.Add('exec Get_SY_MaxBH_HZ '); + sql.Add(' ' + quotedStr(mFlag)); + sql.Add(',' + quotedStr(mTable)); + sql.Add(',' + intTostr(mlen)); + sql.Add(',' + intTostr(mtype)); + sql.Add(',' + intTostr(HZype)); + // 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(Pchar('޷ɻˮ(' + mFlag + ')'), 'ʾϢ', MB_ICONINFORMATION); + + except + result := false; + application.MessageBox(Pchar('޷ɻˮ(' + 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); + CreateGroupSummarry(cxgrid); +end; +/////////////////////////////////////////////////////////////// + //ܣļжȡcxGridCol + //fileName ƼΪڵcaptioncaption +/////////////////////////////////////////////////////////////// + +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 CreateGroupSummarry(tv1: TcxGridDBTableView); +var + csg: TcxDataSummaryGroup; + csglink: TcxDataSummaryGroupItemLink; + csgItem: TcxDataSummaryItem; + i: integer; + mFieldName: string; +begin + /// + with tv1.DataController.Summary do + begin + try + csg := DataController.Summary.SummaryGroups.Add; // + + csg.Links.Clear; + for i := 0 to tv1.ColumnCount - 1 do + begin + if not tv1.Columns[i].Visible then + continue; + mFieldName := tv1.Columns[i].DataBinding.FieldName; + + if tv1.Columns[i].Summary.FooterKind = skSum then + begin + // (tv1.DataController.DataSet.Fields[i] as TNumericField).DisplayFormat := '#,0.00;-#,0.00;#'; + //tv1.Columns[i].Summary.FooterFormat:='0.0'; + //tv1.Columns[i].Summary.FooterKind := skSum; + //Group RowϵĻͬʱʹʱֻһЧ + //зϵĻ + + csgItem := csg.SummaryItems.Add; + csgItem.ItemLink := tv1.Columns[i]; //ֶ1 + csgItem.Position := spGroup; + csgItem.Kind := skSum; + csgItem.Format := trim(tv1.Columns[i].Caption) + 'С=#,0.0'; + + tv1.Columns[i].Summary.GroupFooterKind := skSum; + tv1.Columns[i].Summary.GroupFooterFormat := '#,0.00'; + + end + else if tv1.Columns[i].Summary.FooterKind = skCount then + begin + // (tv1.DataController.DataSet.Fields[i] as TNumericField).DisplayFormat := '#,0.00;-#,0.00;#'; + //tv1.Columns[i].Summary.FooterFormat:='0.0'; + tv1.Columns[i].Summary.FooterKind := skCount; + + tv1.Columns[i].Summary.GroupFooterKind := skCount; + + //tv1.Columns[i].Summary.GroupFooterFormat := '#,0.00'; + //Group RowϵĻͬʱʹʱֻһЧ + //зϵĻ + csgItem := csg.SummaryItems.Add; + csgItem.ItemLink := tv1.Columns[i]; //ֶ1 + csgItem.Kind := skCount; + //csgItem.Format := 'С=#,0.0'; + + end + else + begin + csglink := csg.Links.Add; + csglink.ItemLink := tv1.Columns[i]; //ֶ + //вܵжп飬뽫Щм뵽 + //SummaryGroupItemLinkУûмӵʱ + //ֵʾ + end; + + end; + finally + end; + end; + +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 TcxGridToExcelEng(mfileName: string; gridName: TcxGrid); +var + saveDialog: TSaveDialog; +begin + try + saveDialog := TSaveDialog.Create(nil); + saveDialog.Filter := 'xls(*.xls)|*.xls|ALL(*.*)|*.*'; + saveDialog.Options := [ofOverwritePrompt]; + saveDialog.FileName := mfileName; + if saveDialog.Execute then + if Assigned(gridName) then + begin + try + + ExportGridToExcel(saveDialog.FileName, gridName); + except + application.MessageBox('The source file may be in edit mode!', 'Prompt message', 0); + exit; + end; + application.MessageBox('Export success!', 'Prompt message', 0); + end + else + application.MessageBox('Export failure!', 'Prompt message', 0); + finally + saveDialog.Free; + end; +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; + +procedure SelExportData(FTv: TcxGridDBTableView; FAdoQry: TADOQuery; FTile: string); +var + i, j: Integer; + fsj: string; +begin + if FAdoQry.IsEmpty then + Exit; + try + frmSelExportField := TfrmSelExportField.Create(Application); + with frmSelExportField do + begin + with frmSelExportField.ExpGrid do + begin + // ExpGrid.Columns.Clear; + ExpGrid.ClearItems; + frmSelExportField.IniName := FTile; + {if FTv.OptionsView.Footer=true then + begin + ExpGrid.OptionsView.Footer:=True; + end else + begin + ExpGrid.OptionsView.Footer:=False; + end; } + ExpGrid.OptionsView.Footer := FTv.OptionsView.Footer; + for i := 0 to FTv.ColumnCount - 1 do + begin + //if FTv.Columns[i].Visible=True then + begin + ExpGrid.CreateColumn; + j := ExpGrid.ColumnCount - 1; + ExpGrid.Columns[j].Caption := FTv.Columns[i].Caption; + ExpGrid.Columns[i].Visible := FTv.Columns[i].Visible; + ExpGrid.Columns[j].DataBinding.FieldName := FTv.Columns[i].DataBinding.FieldName; + ExpGrid.Columns[j].Width := FTv.Columns[i].Width; + ExpGrid.Columns[i].Summary.FooterKind := FTv.Columns[i].Summary.FooterKind; + + end; + end; + end; + ExportDataSource.DataSet := FAdoQry; + FAdoQry.Open; + if ShowModal = 1 then + begin + + end; + end; + frmSelExportField.Free; + except + + end; +end; + +procedure SelExportDataBand(FTv: TcxGridDBBandedTableView; FAdoQry: TADOQuery; FTile: string); +var + i, j: Integer; + fsj: string; +begin + if FAdoQry.IsEmpty then + Exit; + try + frmSelExportField := TfrmSelExportField.Create(Application); + with frmSelExportField do + begin + with frmSelExportField.ExpGrid do + begin + // ExpGrid.Columns.Clear; + ExpGrid.ClearItems; + frmSelExportField.IniName := FTile; + {if FTv.OptionsView.Footer=true then + begin + ExpGrid.OptionsView.Footer:=True; + end else + begin + ExpGrid.OptionsView.Footer:=False; + end; } + ExpGrid.OptionsView.Footer := FTv.OptionsView.Footer; + for i := 0 to FTv.ColumnCount - 1 do + begin + if FTv.Columns[i].Visible = True then + begin + ExpGrid.CreateColumn; + j := ExpGrid.ColumnCount - 1; + ExpGrid.Columns[j].Caption := FTv.Columns[i].Caption; + ExpGrid.Columns[j].DataBinding.FieldName := FTv.Columns[i].DataBinding.FieldName; + ExpGrid.Columns[j].Width := FTv.Columns[i].Width; + ExpGrid.Columns[i].Summary.FooterKind := FTv.Columns[i].Summary.FooterKind; + + end; + end; + end; + ExportDataSource.DataSet := FAdoQry; + FAdoQry.Open; + if ShowModal = 1 then + begin + + end; + end; + frmSelExportField.Free; + except + + end; +end; + +procedure ColumnView(AdoQueryTemp: TADOQuery; Tv1: TcxGridDBTableView; MKName10: string); +begin + with AdoQueryTemp do + begin + Close; + sql.Clear; + sql.Add('select * from Table_Column where CxTabName=''' + Trim(MKName10) + ''' and Owner=''' + Trim(DCode) + ''''); + sql.Add(' and TCNotVisble=1 '); + open; + end; + if AdoQueryTemp.IsEmpty = False then + begin + with AdoQueryTemp do + begin + First; + while not eof do + begin + + Tv1.GetColumnByFieldName(AdoQueryTemp.fieldbyname('ColName').AsString).Visible := False; + Tv1.GetColumnByFieldName(AdoQueryTemp.fieldbyname('ColName').AsString).Hidden := True; + Next; + end; + end; + end; +end; + +procedure ColumnBandView(AdoQueryTemp: TADOQuery; Tv1: TcxGridDBBandedTableView; MKName10: string); +var + fsj: string; +begin + with AdoQueryTemp do + begin + Close; + sql.Clear; + sql.Add('select * from Table_Column where CxTabName=''' + Trim(MKName10) + ''' and Owner=''' + Trim(DCode) + ''''); + sql.Add(' and TCNotVisble=1 '); + open; + end; + if AdoQueryTemp.IsEmpty = False then + begin + with AdoQueryTemp do + begin + First; + while not eof do + begin + fsj := Trim(AdoQueryTemp.fieldbyname('ColName').AsString); + // Tv1.Controller.ge + Tv1.GetColumnByFieldName(fsj).Visible := False; + Tv1.GetColumnByFieldName(fsj).Hidden := True; + Next; + end; + end; + end; +end; + +procedure ColumnSet(TV10: TcxGridDBTableView; MKName10: string); +var + i: Integer; +begin + try + frmColumnSet := TfrmColumnSet.Create(Application); + with frmColumnSet do + begin + ADOQuery2.DisableControls; + with ADOQuery2 do + begin + Close; + sql.Clear; + sql.Add('select * from Table_Column where 1<>1'); + Open; + end; + SCreateCDS20(ADOQuery2, ClientDataSet2); + SInitCDSData20(ADOQuery2, ClientDataSet2); + ADOQuery2.EnableControls; + MKName := MKName10; + for i := 0 to TV10.ColumnCount - 1 do + begin + with ClientDataSet2 do + begin + Append; + FieldByName('CxTabName').Value := MKName; + FieldByName('CxColName').Value := Trim(TV10.Columns[i].Caption); + FieldByName('ColName').Value := Trim(TV10.Columns[i].DataBinding.FieldName); + Post; + end; + end; + if ShowModal = 1 then + begin + + end; + end; + finally + frmColumnSet.Free; + end; +end; + +procedure ColumnBandSet(TV10: TcxGridDBBandedTableView; MKName10: string); +var + i: Integer; +begin + try + frmColumnBandSet := TfrmColumnBandSet.Create(Application); + with frmColumnBandSet do + begin + ADOQuery2.DisableControls; + with ADOQuery2 do + begin + Close; + sql.Clear; + sql.Add('select * from Table_Column where 1<>1'); + Open; + end; + SCreateCDS20(ADOQuery2, ClientDataSet2); + SInitCDSData20(ADOQuery2, ClientDataSet2); + ADOQuery2.EnableControls; + MKName := MKName10; + for i := 0 to TV10.ColumnCount - 1 do + begin + with ClientDataSet2 do + begin + Append; + FieldByName('CxTabName').Value := Trim(TV10.Bands[TV10.Columns[i].Position.BandIndex].Caption); + FieldByName('CxColName').Value := Trim(TV10.Columns[i].Caption); + FieldByName('ColName').Value := Trim(TV10.Columns[i].DataBinding.FieldName); + FieldByName('OrderNo').Value := i; + Post; + end; + end; + ADOQuery5.DisableControls; + with ADOQuery5 do + begin + Close; + sql.Clear; + sql.Add('select * from Table_Name where 1<>1'); + Open; + end; + SCreateCDS20(ADOQuery5, CDSName); + SInitCDSData20(ADOQuery5, CDSName); + ADOQuery2.EnableControls; + MKName := MKName10; + for i := 0 to TV10.Bands.Count - 1 do + begin + with CDSName do + begin + Append; + FieldByName('CxTabName').Value := Trim(TV10.Bands[i].Caption); + FieldByName('OrderNo').Value := i; + Post; + end; + end; + if ShowModal = 1 then + begin + + end; + end; + finally + frmColumnBandSet.Free; + end; +end; + +procedure GetSWLDZ(IPStr: string); +var + myip: ulong; + mymac: array[0..5] of byte; + mymaclength: ulong; + r: integer; +begin + {myip:=inet_addr(PChar(Trim(IPStr))); + mymaclength:=length(mymac); + r:=sendarp(myip,0,@mymac,@mymaclength); + IpCall:=r; + IpWLDZStr:=format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]);} +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 SelOKNoAdo(CDS_MainSel: TADOQuery; 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; + +function num2ceng(strArabic: string): string;//СתӢ +const + sw: array[2..9] of string = ('twenty', 'thirty', 'forty', 'fifty', 'sixty', 'seventy', 'eighty', 'ninety'); + gw: array[1..19] of string = ('one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine', 'ten', 'eleven', 'twelve', 'thirteen', 'fourteen', 'fifteen', 'sixteen', 'seventeen', 'eighteen', 'nineteen'); + exp: array[1..4] of string = ('', 'thousand', 'million', 'billion'); +var + t, j, glb, t1: integer; + ts: string; + + function readu1000(ss: string): string; + var + t, code: integer; + begin + result := ''; + while ss[1] = '0' do + begin + delete(ss, 1, 1); + if length(ss) = 0 then + exit; //ȫ0 + end; + if length(ss) = 3 then + begin + appendstr(result, gw[ord(ss[1]) - ord('0')]); + //appendstr(result,' hundred '); + appendstr(result, ' hundred '); + delete(ss, 1, 1); + end; + while ss[1] = '0' do + begin + delete(ss, 1, 1); + if length(ss) = 0 then + exit; + end; + if length(ss) <> 0 then + if result <> '' then + appendstr(result, 'and '); + if (glb = 1) and (t1 <> 1) then //λʱ3λ + if result = '' then + appendstr(result, 'and '); + begin + val(ss, t, code); + if t < 20 then + result := result + gw[t] + else if t mod 10 = 0 then + result := result + sw[t div 10] + else + //result := result+sw[trunc(t/10)]+'-'+gw[t mod 10]; + result := result + sw[trunc(t / 10)] + ' ' + gw[t mod 10]; + end; + end; + +begin + result := ''; + t := pos('.', strArabic); + if t = 0 then + t := length(strArabic) + 1; + while (t mod 3 <> 1) do + begin + t := t + 1; + strArabic := '0' + strArabic; + end; + t1 := (t - 1) div 3; + for glb := t1 downto 1 do + begin + ts := ''; + for j := 1 to 3 do + begin + ts := ts + strArabic[1]; + delete(strArabic, 1, 1); + end; + result := result + readu1000(ts); + if ts <> '000' then + result := result + ' ' + exp[glb] + ' '; + end; + if length(strArabic) <> 0 then + begin + delete(strArabic, 1, 1); + appendstr(result, 'and '); + result := result + readu1000(strArabic); + end; +end; + +function num2cengnum(strArabic: string): string; +const + gw: array[1..10] of string = ('0', 'one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine'); +var + p, i, j, x: integer; + s: string; +begin + result := ''; + s := strArabic; + p := pos('.', strArabic); + if p = 0 then + begin + result := num2ceng(strArabic) + 'Only'; + exit; + end + else + begin + i := length(s) - p; //Смλ + delete(strArabic, p, i + 1); //ɾС + result := num2ceng(strArabic) + 'Point'; + end; + for x := 1 to i do //תС + begin + j := strtoint(copy(s, p + x, 1)); + case j of + 0: + result := result + ' ' + gw[1]; + 1: + result := result + ' ' + gw[2]; + 2: + result := result + ' ' + gw[3]; + 3: + result := result + ' ' + gw[4]; + 4: + result := result + ' ' + gw[5]; + 5: + result := result + ' ' + gw[6]; + 6: + result := result + ' ' + gw[7]; + 7: + result := result + ' ' + gw[8]; + 8: + result := result + ' ' + gw[9]; + 9: + result := result + ' ' + gw[10]; + end; + end; +end; + +procedure DelCDS(ClientDataSet1: TClientDataSet; ADOCmd: TADOQuery; DelSql: string); +begin + if ClientDataSet1.IsEmpty then + Exit; + if Trim(ClientDataSet1.fieldbyname('ZSID').AsString) <> '' then + begin + if Application.MessageBox('ȷҪɾ', 'ʾ', 32 + 4) <> IDYES then + Exit; + with ADOCmd do + begin + Close; + SQL.Clear; + sql.Add(DelSql); + ExecSQL; + end; + end; + ClientDataSet1.Delete; +end; + +end. + diff --git a/Z99Dependency/ThreeFun/Fun/U_SelExportField.dfm b/Z99Dependency/ThreeFun/Fun/U_SelExportField.dfm index 2cd81dc..fc947d4 100644 --- a/Z99Dependency/ThreeFun/Fun/U_SelExportField.dfm +++ b/Z99Dependency/ThreeFun/Fun/U_SelExportField.dfm @@ -44,7 +44,7 @@ object frmSelExportField: TfrmSelExportField TabOrder = 2 Visible = False object ExpGrid: TcxGridDBTableView - NavigatorButtons.ConfirmDelete = False + Navigator.Buttons.CustomButtons = <> DataController.DataSource = ExportDataSource DataController.Summary.DefaultGroupSummaryItems = <> DataController.Summary.FooterSummaryItems = <> diff --git a/Z99Dependency/ThreeFun/Fun/U_SelExportField.pas b/Z99Dependency/ThreeFun/Fun/U_SelExportField.pas index 23447eb..d270038 100644 --- a/Z99Dependency/ThreeFun/Fun/U_SelExportField.pas +++ b/Z99Dependency/ThreeFun/Fun/U_SelExportField.pas @@ -8,7 +8,22 @@ uses DB,IniFiles, RM_Common, RM_Class, RM_e_Xls, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridLevel, cxClasses, cxControls, cxGridCustomView, - cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid; + cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, + cxLookAndFeels, cxLookAndFeelPainters, dxSkinsCore, dxSkinBlack, + dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom, + dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, + dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, + dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, + dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins, + dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green, + dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black, + dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, + dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, + dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, + dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, + dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine, + dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, dxSkinscxPCPainter, + cxNavigator; type TfrmSelExportField = class(TForm) diff --git a/云翔一码通/U_GetDllForm.pas b/云翔一码通/U_GetDllForm.pas index 1a73c7b..56ae45a 100644 --- a/云翔一码通/U_GetDllForm.pas +++ b/云翔一码通/U_GetDllForm.pas @@ -13,7 +13,8 @@ function ConnData(): Boolean; implementation uses - U_DataLink, U_YMTRKList, U_YMTFHSQList, U_YMTFHDataList, U_YMTJGWCList; + U_DataLink, U_YMTRKList, U_YMTFHSQList, U_YMTFHDataList, U_YMTJGWCList, + U_YMTStockList; ///////////////////////////////////////////////////////////////// // ˵:ȡDllеô // @@ -48,6 +49,8 @@ begin DParameters8 := Parameters8; DParameters9 := Parameters9; DParameters10 := Parameters10; + DName := 'ADMIN'; + DCode := 'ADMIN'; MainApplication := App; DCurHandle := FormH; @@ -56,7 +59,6 @@ begin Application := TApplication(App); DCurHandle := 0; - //ֵַ SetLength(server, 255); SetLength(dtbase, 255); @@ -138,13 +140,63 @@ begin mnewHandle := frmYMTJGWCList.Handle; end; - 211: // + 113: // begin - if frmYMTFHSQList = nil then + if frmStockList = nil then + begin + frmStockList := TfrmStockList.Create(application.MainForm); + with frmStockList do + begin + caption := Trim(Title); + FormStyle := mstyle; + windowState := mstate; + BorderStyle := mborderstyle; + //show; + end; + end + else + frmStockList.BringToFront; + // + mnewHandle := frmStockList.Handle; + end; + +// 211: // +// begin +// if frmYMTFHSQList = nil then +// begin +// frmYMTFHSQList := TfrmYMTFHSQList.Create(application.MainForm); +// with frmYMTFHSQList do +// begin +// caption := Trim(Title); +// FormStyle := mstyle; +// windowState := mstate; +// BorderStyle := mborderstyle; +// //show; +// end; +// end +// else +// frmYMTFHSQList.BringToFront; +// // +// mnewHandle := frmYMTFHSQList.Handle; +// end; + 211: //۷ + begin + bFound := FALSE; + for i := (App.MainForm.MDIChildCount - 1) downto 0 do + begin + if App.MainForm.MDIChildren[i].Caption = '۷' then + begin + BringWindowToTop(frmYMTFHSQList.Handle); + bFound := TRUE; + Break; + end; + end; + if not bFound then begin frmYMTFHSQList := TfrmYMTFHSQList.Create(application.MainForm); with frmYMTFHSQList do begin + Title := '۷'; caption := Trim(Title); FormStyle := mstyle; windowState := mstate; @@ -176,10 +228,42 @@ begin // mnewHandle := frmYMTFHDataList.Handle; end; + 213: //ӹǼ + begin + bFound := FALSE; + for i := (App.MainForm.MDIChildCount - 1) downto 0 do + begin + if App.MainForm.MDIChildren[i].Caption = 'ӹǼ' then + begin + BringWindowToTop(frmYMTFHSQList.Handle); + bFound := TRUE; + Break; + end; + end; + if not bFound then + begin + frmYMTFHSQList := TfrmYMTFHSQList.Create(application.MainForm); + with frmYMTFHSQList do + begin + Title := 'ӹǼ'; + caption := Trim(Title); + FormStyle := mstyle; + windowState := mstate; + BorderStyle := mborderstyle; + //show; + end; + end + else + frmYMTFHSQList.BringToFront; + // + mnewHandle := frmYMTFHSQList.Handle; + end; end; Result := mnewHandle; end; + + //=========================================================== //ݿӳ //=========================================================== diff --git a/云翔一码通/U_YMTFHDataList.dfm b/云翔一码通/U_YMTFHDataList.dfm index e7d30e6..cb1f758 100644 --- a/云翔一码通/U_YMTFHDataList.dfm +++ b/云翔一码通/U_YMTFHDataList.dfm @@ -1,6 +1,6 @@ object frmYMTFHDataList: TfrmYMTFHDataList - Left = 515 - Top = 347 + Left = 479 + Top = 280 Width = 1370 Height = 750 Caption = #21457#36135#25968#25454 @@ -352,13 +352,19 @@ object frmYMTFHDataList: TfrmYMTFHDataList end object v2Column6: TcxGridDBColumn Tag = 2 - Caption = #25968#37327 - DataBinding.FieldName = 'Qty' + Caption = #38271#24230 + DataBinding.FieldName = 'MQty' PropertiesClassName = 'TcxTextEditProperties' HeaderAlignmentHorz = taCenter Options.Editing = False Width = 85 end + object Tv1Column1: TcxGridDBColumn + Caption = #37325#37327 + DataBinding.FieldName = 'KgQty' + HeaderAlignmentHorz = taCenter + Options.Editing = False + end end object cxGrid2Level1: TcxGridLevel GridView = Tv1 diff --git a/云翔一码通/U_YMTFHDataList.pas b/云翔一码通/U_YMTFHDataList.pas index 0486f97..798fc62 100644 --- a/云翔一码通/U_YMTFHDataList.pas +++ b/云翔一码通/U_YMTFHDataList.pas @@ -79,6 +79,7 @@ type Tv1FromMXID: TcxGridDBColumn; ToolButton1: TToolButton; ToolButton2: TToolButton; + Tv1Column1: TcxGridDBColumn; procedure FormDestroy(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); diff --git a/云翔一码通/U_YMTFHSQInPut.dfm b/云翔一码通/U_YMTFHSQInPut.dfm index 9c78497..3aa47af 100644 --- a/云翔一码通/U_YMTFHSQInPut.dfm +++ b/云翔一码通/U_YMTFHSQInPut.dfm @@ -1,20 +1,20 @@ object frmFHSQInPut: TfrmFHSQInPut - Left = 354 - Top = 296 + Left = 677 + Top = 428 Width = 1499 Height = 664 Caption = #21457#36135#30003#35831#24405#20837 Color = clBtnFace Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -15 + Font.Height = -12 Font.Name = #23435#20307 Font.Style = [] OldCreateOrder = False Position = poScreenCenter OnShow = FormShow - PixelsPerInch = 120 - TextHeight = 15 + PixelsPerInch = 96 + TextHeight = 12 object ToolBar1: TToolBar Left = 0 Top = 0 @@ -59,7 +59,7 @@ object frmFHSQInPut: TfrmFHSQInPut Left = 0 Top = 29 Width = 1491 - Height = 139 + Height = 111 Align = alTop BevelInner = bvNone BevelOuter = bvNone @@ -70,121 +70,118 @@ object frmFHSQInPut: TfrmFHSQInPut TabOrder = 1 object Label1: TLabel Tag = 1 - Left = 41 - Top = 15 - Width = 115 - Height = 22 + Left = 33 + Top = 12 + Width = 100 + Height = 19 Caption = #20986#24211#31867#22411#65306 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label12: TLabel Tag = 1 - Left = 49 - Top = 98 - Width = 105 - Height = 22 + Left = 40 + Top = 78 + Width = 93 + Height = 19 Caption = #22791' '#27880#65306 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label11: TLabel Tag = 1 - Left = 475 - Top = 15 - Width = 115 - Height = 22 + Left = 380 + Top = 12 + Width = 100 + Height = 19 Caption = #25910#36135#21333#20301#65306 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label2: TLabel Tag = 1 - Left = 475 - Top = 54 - Width = 115 - Height = 22 + Left = 380 + Top = 43 + Width = 100 + Height = 19 Caption = #30003#35831#26085#26399#65306 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label5: TLabel Tag = 1 - Left = 64 - Top = 54 - Width = 92 - Height = 22 + Left = 53 + Top = 43 + Width = 80 + Height = 19 Caption = #19994#21153#21592#65306 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label3: TLabel Tag = 1 - Left = 1061 - Top = 15 - Width = 92 - Height = 22 + Left = 849 + Top = 12 + Width = 80 + Height = 19 Caption = #21152#24037#31867#22411 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object CRType: TComboBox Tag = 1 - Left = 144 - Top = 10 - Width = 312 - Height = 30 + Left = 123 + Top = 8 + Width = 250 + Height = 27 Style = csDropDownList Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 - ItemHeight = 22 + ItemHeight = 19 ParentFont = False TabOrder = 0 Items.Strings = ( #38144#21806#20869#38144 - #21152#24037#20869#38144 #38144#21806#22806#38144 - #21152#24037#22806#38144 - #21152#24037#20986#24211 - #20854#20182#20986#24211) + '') end object Note: TEdit Tag = 1 - Left = 144 - Top = 94 - Width = 892 - Height = 23 + Left = 123 + Top = 75 + Width = 714 + Height = 28 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -193,14 +190,14 @@ object frmFHSQInPut: TfrmFHSQInPut end object SHDanWei: TBtnEditC Tag = 1 - Left = 569 - Top = 9 - Width = 466 - Height = 26 + Left = 469 + Top = 7 + Width = 373 + Height = 31 Hint = 'KHNo' Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 @@ -211,10 +208,10 @@ object frmFHSQInPut: TfrmFHSQInPut end object SQDate: TDateTimePicker Tag = 1 - Left = 569 - Top = 49 - Width = 162 - Height = 30 + Left = 469 + Top = 39 + Width = 130 + Height = 27 BevelInner = bvNone Date = 43473.670856296290000000 Format = 'yyyy-MM-dd' @@ -222,7 +219,7 @@ object frmFHSQInPut: TfrmFHSQInPut Checked = False Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -231,13 +228,13 @@ object frmFHSQInPut: TfrmFHSQInPut end object Salesman: TBtnEditC Tag = 1 - Left = 144 - Top = 48 - Width = 169 - Height = 26 + Left = 123 + Top = 38 + Width = 135 + Height = 31 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -248,13 +245,13 @@ object frmFHSQInPut: TfrmFHSQInPut end object JGType: TEdit Tag = 1 - Left = 1164 - Top = 10 - Width = 150 - Height = 23 + Left = 936 + Top = 8 + Width = 120 + Height = 28 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -264,7 +261,7 @@ object frmFHSQInPut: TfrmFHSQInPut end object ToolBar2: TToolBar Left = 0 - Top = 168 + Top = 140 Width = 1491 Height = 29 ButtonHeight = 30 @@ -304,9 +301,9 @@ object frmFHSQInPut: TfrmFHSQInPut end object cxGrid1: TcxGrid Left = 0 - Top = 197 + Top = 169 Width = 1491 - Height = 430 + Height = 464 Align = alClient TabOrder = 3 object Tv1: TcxGridDBTableView diff --git a/云翔一码通/U_YMTFHSQInPut2.dfm b/云翔一码通/U_YMTFHSQInPut2.dfm new file mode 100644 index 0000000..fc6559b --- /dev/null +++ b/云翔一码通/U_YMTFHSQInPut2.dfm @@ -0,0 +1,480 @@ +object frmFHSQInPut2: TfrmFHSQInPut2 + Left = 357 + Top = 336 + Width = 1499 + Height = 664 + Caption = #21457#36135#30003#35831#24405#20837 + Color = clBtnFace + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = #23435#20307 + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 12 + object ToolBar1: TToolBar + Left = 0 + Top = 0 + Width = 1491 + Height = 29 + ButtonHeight = 30 + ButtonWidth = 75 + Caption = 'ToolBar1' + Color = clBtnFace + EdgeInner = esNone + EdgeOuter = esNone + Flat = True + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + Images = DataLink_YXYMT.ThreeImgList + List = True + ParentColor = False + ParentFont = False + ShowCaptions = True + TabOrder = 0 + object TBSave: TToolButton + Left = 0 + Top = 0 + AutoSize = True + Caption = #20445#23384 + ImageIndex = 5 + OnClick = TBSaveClick + end + object TBClose: TToolButton + Left = 79 + Top = 0 + AutoSize = True + Caption = #20851#38381 + ImageIndex = 21 + OnClick = TBCloseClick + end + end + object ScrollBox1: TScrollBox + Left = 0 + Top = 29 + Width = 1491 + Height = 111 + Align = alTop + BevelInner = bvNone + BevelOuter = bvNone + Color = clBtnFace + Ctl3D = False + ParentColor = False + ParentCtl3D = False + TabOrder = 1 + object Label1: TLabel + Tag = 1 + Left = 33 + Top = 12 + Width = 100 + Height = 19 + Caption = #20986#24211#31867#22411#65306 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label12: TLabel + Tag = 1 + Left = 40 + Top = 78 + Width = 93 + Height = 19 + Caption = #22791' '#27880#65306 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label11: TLabel + Tag = 1 + Left = 380 + Top = 12 + Width = 100 + Height = 19 + Caption = #25910#36135#21333#20301#65306 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label2: TLabel + Tag = 1 + Left = 380 + Top = 43 + Width = 100 + Height = 19 + Caption = #30003#35831#26085#26399#65306 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label5: TLabel + Tag = 1 + Left = 53 + Top = 43 + Width = 80 + Height = 19 + Caption = #19994#21153#21592#65306 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label3: TLabel + Tag = 1 + Left = 849 + Top = 12 + Width = 80 + Height = 19 + Caption = #21152#24037#31867#22411 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object CRType: TComboBox + Tag = 1 + Left = 121 + Top = 8 + Width = 250 + Height = 27 + Style = csDropDownList + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ItemHeight = 19 + ParentFont = False + TabOrder = 0 + Items.Strings = ( + #21152#24037#20869#38144 + #21152#24037#22806#38144 + #21152#24037#20986#24211 + '') + end + object Note: TEdit + Tag = 1 + Left = 121 + Top = 75 + Width = 714 + Height = 25 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ParentFont = False + TabOrder = 4 + end + object SHDanWei: TBtnEditC + Tag = 1 + Left = 470 + Top = 7 + Width = 373 + Height = 28 + Hint = 'KHNo' + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 + ParentFont = False + TabOrder = 1 + OnBtnUpClick = SHDanWeiBtnUpClick + OnBtnDnClick = SHDanWeiBtnDnClick + end + object SQDate: TDateTimePicker + Tag = 1 + Left = 470 + Top = 39 + Width = 130 + Height = 27 + BevelInner = bvNone + Date = 43473.670856296290000000 + Format = 'yyyy-MM-dd' + Time = 43473.670856296290000000 + Checked = False + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ParentFont = False + TabOrder = 2 + end + object Salesman: TBtnEditC + Tag = 1 + Left = 121 + Top = 38 + Width = 135 + Height = 28 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ParentFont = False + TabOrder = 3 + OnBtnUpClick = SalesmanBtnUpClick + OnBtnDnClick = SalesmanBtnDnClick + end + object JGType: TEdit + Tag = 1 + Left = 931 + Top = 8 + Width = 120 + Height = 25 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ParentFont = False + TabOrder = 5 + end + end + object ToolBar2: TToolBar + Left = 0 + Top = 140 + Width = 1491 + Height = 29 + ButtonHeight = 30 + ButtonWidth = 95 + Caption = 'ToolBar1' + Color = clBtnFace + EdgeInner = esNone + EdgeOuter = esNone + Flat = True + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + Images = DataLink_YXYMT.ThreeImgList + List = True + ParentColor = False + ParentFont = False + ShowCaptions = True + TabOrder = 2 + object ToolButton3: TToolButton + Left = 0 + Top = 0 + AutoSize = True + Caption = #35745#21010#21333 + ImageIndex = 57 + Visible = False + OnClick = ToolButton3Click + end + object ToolButton1: TToolButton + Left = 99 + Top = 0 + AutoSize = True + Caption = #24211#23384 + ImageIndex = 57 + OnClick = ToolButton1Click + end + object ToolButton2: TToolButton + Left = 178 + Top = 0 + AutoSize = True + Caption = #21024#34892 + ImageIndex = 113 + OnClick = ToolButton2Click + end + end + object cxGrid1: TcxGrid + Left = 0 + Top = 169 + Width = 1491 + Height = 464 + Align = alClient + TabOrder = 3 + object Tv1: TcxGridDBTableView + Navigator.Buttons.CustomButtons = <> + DataController.DataSource = DataSource1 + DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost] + DataController.Summary.DefaultGroupSummaryItems = < + item + Format = '0' + Position = spFooter + end + item + Format = '0' + Position = spFooter + end + item + Format = '0' + Position = spFooter + end> + DataController.Summary.FooterSummaryItems = < + item + Kind = skSum + end + item + Kind = skSum + end + item + Kind = skSum + end + item + Kind = skSum + end + item + Kind = skSum + Column = v1Column5 + end> + DataController.Summary.SummaryGroups = <> + OptionsBehavior.FocusCellOnTab = True + OptionsBehavior.GoToNextCellOnEnter = True + OptionsBehavior.FocusCellOnCycle = True + OptionsCustomize.ColumnFiltering = False + OptionsView.Footer = True + OptionsView.GroupByBox = False + Styles.Content = DataLink_YXYMT.Default + Styles.Inactive = DataLink_YXYMT.SHuangSe + Styles.IncSearch = DataLink_YXYMT.SHuangSe + Styles.Selection = DataLink_YXYMT.SHuangSe + Styles.Header = DataLink_YXYMT.Default + object v1Column14: TcxGridDBColumn + Caption = #32534#21495 + DataBinding.FieldName = 'MXID' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 120 + end + object v1Column6: TcxGridDBColumn + Caption = #21697#21517 + DataBinding.FieldName = 'MXPrtName' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 110 + end + object v1Column1: TcxGridDBColumn + Caption = #39068#33394 + DataBinding.FieldName = 'MXPrtColor' + HeaderAlignmentHorz = taCenter + Width = 95 + end + object v1Column2: TcxGridDBColumn + Caption = #33457#22411 + DataBinding.FieldName = 'MXPrtHX' + HeaderAlignmentHorz = taCenter + Width = 81 + end + object v1Column4: TcxGridDBColumn + Caption = #38271#24230 + DataBinding.FieldName = 'MQty' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object Tv1Column1: TcxGridDBColumn + Caption = #37325#37327 + DataBinding.FieldName = 'KgQty' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object v1Column3: TcxGridDBColumn + Caption = #24211#20301 + DataBinding.FieldName = 'Kuwei' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object Tv1Column2: TcxGridDBColumn + Caption = #36153#29992#21333#20215 + DataBinding.FieldName = 'FHPrice' + HeaderAlignmentHorz = taCenter + Width = 107 + end + object v1Column10: TcxGridDBColumn + Caption = #36153#29992#21517#31216 + DataBinding.FieldName = 'FeeName' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + Properties.OnButtonClick = v1Column10PropertiesButtonClick + HeaderAlignmentHorz = taCenter + Width = 107 + end + object v1Column5: TcxGridDBColumn + Caption = #36153#29992#37329#39069 + DataBinding.FieldName = 'FeeMoney' + Visible = False + HeaderAlignmentHorz = taCenter + Width = 106 + end + end + object cxGrid1Level1: TcxGridLevel + GridView = Tv1 + end + end + object ADOTemp: TADOQuery + Connection = DataLink_YXYMT.ADOLink + LockType = ltReadOnly + Parameters = <> + Left = 200 + Top = 65533 + end + object ADOCmd: TADOQuery + Connection = DataLink_YXYMT.ADOLink + Parameters = <> + Left = 168 + Top = 65533 + end + object DataSource1: TDataSource + DataSet = Order_Sub + Left = 768 + Top = 392 + end + object Order_Sub: TClientDataSet + Aggregates = <> + Params = <> + Left = 728 + Top = 392 + end + object ADOQuery1: TADOQuery + Connection = DataLink_YXYMT.ADOLink + Parameters = <> + Left = 136 + Top = 65533 + end + object cxGridPopupMenu2: TcxGridPopupMenu + Grid = cxGrid1 + PopupMenus = <> + Left = 688 + Top = 392 + end +end diff --git a/云翔一码通/U_YMTFHSQInPut2.pas b/云翔一码通/U_YMTFHSQInPut2.pas new file mode 100644 index 0000000..76b41cb --- /dev/null +++ b/云翔一码通/U_YMTFHSQInPut2.pas @@ -0,0 +1,586 @@ +unit U_YMTFHSQInPut2; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, + cxEdit, DB, cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView, + cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, cxMemo, + cxRichEdit, ComCtrls, cxContainer, cxTextEdit, cxMaskEdit, cxButtonEdit, + StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar, StrUtils, + cxDropDownEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels, + cxLookAndFeelPainters, cxNavigator, dxSkinsCore, dxSkinDarkRoom, + dxSkinOffice2013White, dxSkinSharpPlus, dxSkinSpringTime, + dxSkinsDefaultPainters, dxSkinscxPCPainter, dxSkinBlack, dxSkinBlue, + dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkSide, + dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy, + dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian, + dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis, + dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black, + dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink, + dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue, + dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray, + dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSilver, + dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinValentine, + dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue; + +type + TfrmFHSQInPut2 = class(TForm) + ToolBar1: TToolBar; + TBSave: TToolButton; + TBClose: TToolButton; + ScrollBox1: TScrollBox; + ToolBar2: TToolBar; + ToolButton2: TToolButton; + cxGrid1: TcxGrid; + Tv1: TcxGridDBTableView; + cxGrid1Level1: TcxGridLevel; + ADOTemp: TADOQuery; + ADOCmd: TADOQuery; + DataSource1: TDataSource; + Order_Sub: TClientDataSet; + ADOQuery1: TADOQuery; + v1Column14: TcxGridDBColumn; + cxGridPopupMenu2: TcxGridPopupMenu; + Label1: TLabel; + CRType: TComboBox; + Note: TEdit; + Label12: TLabel; + Label11: TLabel; + SHDanWei: TBtnEditC; + v1Column6: TcxGridDBColumn; + Label2: TLabel; + SQDate: TDateTimePicker; + Label5: TLabel; + Salesman: TBtnEditC; + v1Column1: TcxGridDBColumn; + v1Column2: TcxGridDBColumn; + v1Column3: TcxGridDBColumn; + v1Column4: TcxGridDBColumn; + v1Column5: TcxGridDBColumn; + v1Column10: TcxGridDBColumn; + ToolButton3: TToolButton; + Label3: TLabel; + JGType: TEdit; + ToolButton1: TToolButton; + Tv1Column1: TcxGridDBColumn; + Tv1Column2: TcxGridDBColumn; + procedure TBCloseClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure TBSaveClick(Sender: TObject); + procedure ToolButton2Click(Sender: TObject); + procedure SHDanWeiBtnUpClick(Sender: TObject); + procedure SHDanWeiBtnDnClick(Sender: TObject); + procedure ShouKuanKeyPress(Sender: TObject; var Key: Char); + procedure SalesmanBtnUpClick(Sender: TObject); + procedure SalesmanBtnDnClick(Sender: TObject); + procedure v1Column10PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); + procedure ToolButton3Click(Sender: TObject); + procedure ToolButton1Click(Sender: TObject); + private + fuserName: string; + procedure InitData(); + procedure ZDYHelp(FButn: TcxButtonEdit; LType: string); + function SaveData(): Boolean; + { Private declarations } + public + PState, CopyInt: Integer; + FMainId, FFMainId, ChkStr, ConPriceStr: string; + FXS: Integer; + FZZType: string; + { Public declarations } + end; + +var + frmFHSQInPut2: TfrmFHSQInPut2; + newh: hwnd; + +implementation + +uses + U_DataLink, U_ZDYHelp, U_RTFun, U_YMTOrderSel, U_ZdyAttachKH, U_ZdyAttachGYS, + U_YMTStockSel; // U_YMTKHList, , U_YMTGYSList + +{$R *.dfm} + +procedure TfrmFHSQInPut2.TBCloseClick(Sender: TObject); +begin + Close; + WriteCxGrid('¼1', Tv1, ''); +end; + +procedure TfrmFHSQInPut2.InitData(); +var + fsj: string; +begin + if PState = 0 then + begin + Salesman.Text := dname; + SQDate.DateTime := SGetServerDate10(ADOTemp); + end; + with ADOQuery1 do + begin + Close; + SQL.Clear; + sql.Add(' select A.* from YMT_FHSQ_Sub A'); + if PState = 1 then + begin + sql.Add('where FSId=''' + Trim(FMainId) + ''''); + end; + if PState = 0 then + begin + sql.Add(' where 1<>1'); + + end; + Open; + end; + SCreateCDS20(ADOQuery1, Order_Sub); + SInitCDSData20(ADOQuery1, Order_Sub); + + with ADOQuery1 do + begin + Close; + sql.Clear; + sql.Add('select A.* from YMT_FHSQ_Main A'); + sql.Add(' where FSId=''' + Trim(FMainId) + ''' '); + Open; + end; + SCSHDataNew(ADOQuery1, ScrollBox1, 1); +end; + +procedure TfrmFHSQInPut2.ZDYHelp(FButn: TcxButtonEdit; LType: string); +var + FType, ZDYName, FText: string; +begin +end; + +procedure TfrmFHSQInPut2.FormShow(Sender: TObject); +begin + readCxGrid('¼1', Tv1, ''); + InitData(); +end; + +function TfrmFHSQInPut2.SaveData(): Boolean; +var + maxno, maxmnno, FSSId: string; + fconNO, fmxType: string; +begin + try + ADOCmd.Connection.BeginTrans; + /// + if Trim(FMainId) = '' then + begin + if GetLSNoHZ(ADOCmd, maxno, 'NK', 'YMT_FHSQ_Main', 3, 1, 3) = False then + begin + ADOCmd.Connection.RollbackTrans; + Application.MessageBox('ȡʧ!', 'ʾ', 0); + Exit; + end; + end + else + begin + maxno := Trim(FMainId); + end; + with ADOCmd do + begin + Close; + sql.Clear; + SQL.Add('select * from YMT_FHSQ_Main where FSID=''' + Trim(FMainId) + ''''); + Open; + end; + with ADOCmd do + begin + if Trim(FMainId) = '' then + begin + Append; + end + else + begin + Edit; + end; + FieldByName('SQType').Value := 'Ʒ'; + FieldByName('FSID').Value := Trim(maxno); + RTSetsavedata(ADOCmd, 'YMT_FHSQ_Main', ScrollBox1, 1); + + if Trim(FMainId) = '' then + begin + FieldByName('Filler').Value := Trim(DName); + + end + else + begin + FieldByName('Editer').Value := Trim(DName); + FieldByName('EditTime').Value := SGetServerDateTime(ADOTemp); + end; + + Post; + end; + + FMainId := Trim(maxno); + ///ӱ + Order_Sub.DisableControls; + with Order_Sub do + begin + First; + while not Eof do + begin + if Trim(Order_Sub.fieldbyname('SSId').AsString) = '' then + begin + if GetLSNo(ADOCmd, maxno, 'SS', 'YMT_FHSQ_Sub', 4, 1) = False then + begin + Order_Sub.EnableControls; + ADOCmd.Connection.RollbackTrans; + Application.MessageBox('ȡˮʧܣ', 'ʾ', 0); + Exit; + end; + end + else + begin + maxno := Trim(Order_Sub.fieldbyname('SSId').AsString); + end; + with ADOCmd do + begin + Close; + SQL.Clear; + sql.Add('select * from YMT_FHSQ_Sub '); + sql.Add(' where SSId=''' + Trim(maxno) + ''''); + Open; + end; + if ADOCmd.IsEmpty then + begin + FSSId := ''; + end + else + begin + FSSId := Trim(maxno); + end; + with ADOCmd do + begin + if Trim(FSSId) = '' then + begin + Append; + FieldByName('Filler').Value := Trim(DName); + end + else + begin + Edit; + FieldByName('Editer').Value := Trim(DName); + FieldByName('EditTime').Value := SGetServerDateTime(ADOTemp); + end; + FieldByName('FSID').Value := Trim(FMainId); + FieldByName('SSID').Value := Trim(maxno); + RTSetSaveDataCDS(ADOCmd, Tv1, Order_Sub, 'YMT_FHSQ_Sub', 0); + FieldByName('MainId').Value := Order_Sub.fieldbyname('MainId').Value; + FieldByName('SubId').Value := Order_Sub.fieldbyname('SubId').Value; + FieldByName('SSConMainId').Value := Order_Sub.fieldbyname('SSConMainId').Value; + FieldByName('SSConSubId').Value := Order_Sub.fieldbyname('SSConSubId').Value; + FieldByName('FHPrice').Value := Order_Sub.fieldbyname('FHPrice').Value; + FieldByName('BZType').Value := Order_Sub.fieldbyname('BZType').Value; + Post; + end; + Order_Sub.Edit; + Order_Sub.FieldByName('SSID').Value := Trim(maxno); + Next; + end; + end; + Order_Sub.EnableControls; + with ADOCmd do + begin + Close; + sql.Clear; + sql.Add('Update YMT_FHSQ_Main Set '); + sql.Add('SQPSHZ=(select Sum(SQPS) from YMT_FHSQ_Sub A where A.FSID=YMT_FHSQ_Main.FSID)'); + sql.Add(',SQQtyHZM=(select Sum(SQQtyM) from YMT_FHSQ_Sub A where A.FSID=YMT_FHSQ_Main.FSID)'); + sql.Add('where FSID=''' + Trim(FMainId) + ''''); + ExecSQL; + end; + ADOCmd.Connection.CommitTrans; + Result := True; + except + ADOCmd.Connection.RollbackTrans; + Application.MessageBox('ʧܣ', 'ʾ', 0); + Result := False; + end; +end; + +procedure TfrmFHSQInPut2.TBSaveClick(Sender: TObject); +var + Freal: Double; +begin + ToolBar1.SetFocus; + + if Trim(CRType.Text) = '' then + begin + Application.MessageBox('ͲΪգ', 'ʾ', 0); + Exit; + end; + + if Order_Sub.IsEmpty then + begin + Application.MessageBox('ϸΪգ', 'ʾ', 0); + Exit; + end; + + if SaveData() then + begin + Application.MessageBox('ɹ', 'ʾ', 0); + end; +end; + +procedure TfrmFHSQInPut2.ToolButton2Click(Sender: TObject); +begin + if Order_Sub.IsEmpty then + Exit; + if Trim(Order_Sub.fieldbyname('SSId').AsString) <> '' then + begin + with ADOTemp do + begin + Close; + sql.Clear; + sql.Add('select * from YMT_FHSQ_Sub where SSId=''' + Trim(Order_Sub.fieldbyname('SSId').AsString) + ''''); + sql.add(' and isnull(FHPS,0)>0'); + Open; + end; + if ADOTemp.IsEmpty = False then + begin + Application.MessageBox('ѷɾ!', 'ʾ', 0); + exit; + end; + if Application.MessageBox('ȷҪɾ', 'ʾ', 32 + 4) <> IDYES then + Exit; + with ADOCmd do + begin + Close; + sql.Clear; + sql.Add('delete YMT_FHSQ_Sub where SSId=''' + Trim(Order_Sub.fieldbyname('SSId').AsString) + ''''); + ExecSQL; + end; + with ADOCmd do + begin + Close; + sql.Clear; + sql.Add('Update YMT_FHSQ_Main Set '); + sql.Add('SQPSHZ=(select Sum(SQPS) from YMT_FHSQ_Sub A where A.FSID=YMT_FHSQ_Main.FSID)'); + sql.Add('where FSID=''' + Trim(FMainId) + ''''); + ExecSQL; + end; + end; + Order_Sub.Delete; +end; + +procedure TfrmFHSQInPut2.SHDanWeiBtnUpClick(Sender: TObject); +begin + + if CRType.Text = 'ӹ' then + begin + try + frmZdyAttachGYS := TfrmZdyAttachGYS.Create(Application); + with frmZdyAttachGYS do + begin + if ShowModal = 1 then + begin + Self.SHDanWei.Text := Trim(frmZdyAttachGYS.CDS_HZ.fieldbyname('KHNameJC').AsString); + Self.SHDanWei.TxtCode := Trim(frmZdyAttachGYS.CDS_HZ.fieldbyname('KHNo').AsString); + Self.Salesman.Text := Trim(frmZdyAttachGYS.CDS_HZ.fieldbyname('YWY').AsString); + end; + end; + finally + frmZdyAttachGYS.Free; + end; + end + else + begin + try + frmZdyAttachkh := TfrmZdyAttachkh.Create(Application); + with frmZdyAttachkh do + begin +// if self.canshu1 <> 'Ȩ' then +// canshu1 := 'ҵԱ'; + if ShowModal = 1 then + begin + Self.SHDanWei.Text := Trim(frmZdyAttachkh.CDS_HZ.fieldbyname('KHNameJC').AsString); + Self.SHDanWei.TxtCode := Trim(frmZdyAttachkh.CDS_HZ.fieldbyname('KHNo').AsString); + Self.Salesman.Text := Trim(frmZdyAttachkh.CDS_HZ.fieldbyname('YWY').AsString); + end; + end; + finally + frmZdyAttachkh.Free; + end; + end; +end; + +procedure TfrmFHSQInPut2.SHDanWeiBtnDnClick(Sender: TObject); +begin + SHDanWei.Text := ''; +end; + +procedure TfrmFHSQInPut2.ShouKuanKeyPress(Sender: TObject; var Key: Char); +begin + if not (((Key >= '0') and (Key <= '9')) or (Key = '.') or (Key = #8)) then + begin + Key := #0; + end + else if (pos('.', TEdit(Sender).text) <> 0) then + begin + if Key = '.' then + begin + Key := #0; + end; + end; +end; + +procedure TfrmFHSQInPut2.SalesmanBtnUpClick(Sender: TObject); +begin + try + frmZDYHelp := TfrmZDYHelp.Create(Application); + with frmZDYHelp do + begin + flag := 'Salesman'; + flagname := 'ҵԱ'; + if ShowModal = 1 then + begin + Self.Salesman.Text := Trim(frmZDYHelp.ClientDataSet1.fieldbyname('ZdyName').AsString); + end; + end; + finally + frmZDYHelp.Free; + end; +end; + +procedure TfrmFHSQInPut2.SalesmanBtnDnClick(Sender: TObject); +begin + Salesman.Text := ''; +end; + +procedure TfrmFHSQInPut2.v1Column10PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); +begin + try + frmZDYHelp := TfrmZDYHelp.Create(Application); + with frmZDYHelp do + begin + flag := 'FeeName'; + flagname := ''; + if ShowModal = 1 then + begin + with Order_Sub do + begin + Edit; + FieldByName('FeeName').Value := Trim(ClientDataSet1.fieldbyname('ZdyName').AsString); + end; + end; + end; + finally + frmZDYHelp.Free; + end; +end; + +procedure TfrmFHSQInPut2.ToolButton3Click(Sender: TObject); +begin + + try + frmOrderSel := TfrmOrderSel.Create(Application); + with frmOrderSel do + begin + + FKHNo := Trim(SHDanWei.TxtCode); +// FTT := Trim(FHTaiTou.text); + + if ShowModal = 1 then + begin + while frmOrderSel.CDS_Main.Locate('SSel', true, []) do + begin + if Trim(Self.SHDanWei.Text) = '' then + begin + SHDanWei.TxtCode := Trim(frmOrderSel.CDS_Main.fieldbyname('KHNO').AsString); + with ADOQueryTemp do + begin + Close; + sql.Clear; + sql.Add('select * from KH_Main where KHNO=''' + Trim(SHDanWei.TxtCode) + ''''); + open; + end; + SHDanWei.Text := Trim(ADOQueryTemp.fieldbyname('KHNameJC').AsString); + end; + +// if Trim(Self.FHTaiTou.Text) = '' then +// begin +// FHTaiTou.Text := Trim(frmOrderSel.CDS_Main.fieldbyname('SYRName').AsString); +// end; + + if Self.Order_Sub.Locate('SubId;CPType', VarArrayOf([Trim(frmOrderSel.CDS_Main.fieldbyname('SubId').AsString), Trim(frmOrderSel.CDS_Main.fieldbyname('CPType').AsString)]), []) = False then + begin + with Self.Order_Sub do + begin + Append; + FieldByName('MainId').Value := frmOrderSel.CDS_Main.fieldbyname('MainId').Value; + FieldByName('SubId').Value := frmOrderSel.CDS_Main.fieldbyname('SubId').Value; + FieldByName('MXPrtName').Value := Trim(frmOrderSel.CDS_Main.fieldbyname('MLCodeName').AsString); + FieldByName('MXPrtColor').Value := Trim(frmOrderSel.CDS_Main.fieldbyname('MLColor').AsString); + FieldByName('MXPrtHX').Value := Trim(frmOrderSel.CDS_Main.fieldbyname('MLHX').AsString); + FieldByName('SCConNo').Value := Trim(frmOrderSel.CDS_Main.fieldbyname('MLOrderNo').AsString); +// CRType.Text := Trim(frmOrderSel.CDS_Main.fieldbyname('CRType').AsString); + + CRType.ItemIndex := CRType.Items.IndexOf(trim(frmOrderSel.CDS_Main.fieldbyname('CRType').AsString)); + FieldByName('CPType').Value := 'Ʒ'; + FieldByName('SQPS').Value := 0; + FieldByName('SQQtyM').Value := 0; + FieldByName('BZType').Value := frmOrderSel.CDS_Main.fieldbyname('BZType').Value; + FieldByName('FHPrice').Value := frmOrderSel.CDS_Main.fieldbyname('MLPrice').Value; + FieldByName('FeeName').Value := frmOrderSel.CDS_Main.fieldbyname('FeeName').Value; + FieldByName('FeeMoney').Value := frmOrderSel.CDS_Main.fieldbyname('FeeMoney').Value; + Post; + end; + end; + frmOrderSel.CDS_Main.Delete; + end; + end; + end; + finally + frmOrderSel.Free; + end; +end; + +procedure TfrmFHSQInPut2.ToolButton1Click(Sender: TObject); +begin + + try + frmStockSel := TfrmStockSel.Create(Application); + with frmStockSel do + begin + if ShowModal = 1 then + begin + while frmStockSel.CDS_Main.Locate('SSel', true, []) do + begin + with Self.Order_Sub do + begin + Append; + FieldByName('MXPrtName').Value := Trim(frmStockSel.CDS_Main.fieldbyname('SPName').AsString); + FieldByName('MXPrtColor').Value := Trim(frmStockSel.CDS_Main.fieldbyname('SPColor').AsString); + FieldByName('MXPrtHX').Value := Trim(frmStockSel.CDS_Main.fieldbyname('SPHX').AsString); + FieldByName('MXID').Value := Trim(frmStockSel.CDS_Main.fieldbyname('FromMXID').AsString); + + FieldByName('CPType').Value := 'ƥ'; + FieldByName('MQty').Value := frmStockSel.CDS_Main.fieldbyname('MQty').Value; + ; + FieldByName('KgQty').Value := frmStockSel.CDS_Main.fieldbyname('KgQty').Value; + FieldByName('Kuwei').Value := frmStockSel.CDS_Main.fieldbyname('KuWei').Value; + Post; + end; + + with frmStockSel.CDS_Main do + begin + Edit; + fieldbyname('SSel').Value := False; + Post; + end; + end; + end; + end; + finally + frmStockSel.Free; + end; +end; + +end. + diff --git a/云翔一码通/U_YMTFHSQList.dfm b/云翔一码通/U_YMTFHSQList.dfm index d55f586..7d45c4d 100644 --- a/云翔一码通/U_YMTFHSQList.dfm +++ b/云翔一码通/U_YMTFHSQList.dfm @@ -7,7 +7,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList Color = clBtnFace Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -15 + Font.Height = -12 Font.Name = #23435#20307 Font.Style = [] OldCreateOrder = False @@ -15,8 +15,8 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow - PixelsPerInch = 120 - TextHeight = 15 + PixelsPerInch = 96 + TextHeight = 12 object ToolBar1: TToolBar Left = 0 Top = 0 @@ -54,16 +54,24 @@ object frmYMTFHSQList: TfrmYMTFHSQList ImageIndex = 1 OnClick = TBAddClick end - object TBEdit: TToolButton + object TbAdd2: TToolButton Left = 158 Top = 0 AutoSize = True + Caption = #26032#22686 + ImageIndex = 2 + OnClick = TbAdd2Click + end + object TBEdit: TToolButton + Left = 237 + Top = 0 + AutoSize = True Caption = #20462#25913 ImageIndex = 11 OnClick = TBEditClick end object ToolButton2: TToolButton - Left = 237 + Left = 316 Top = 0 AutoSize = True Caption = #25209#37327#20462#25913 @@ -71,7 +79,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnClick = ToolButton2Click end object ToolButton1: TToolButton - Left = 356 + Left = 435 Top = 0 AutoSize = True Caption = #26597#30475 @@ -79,7 +87,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnClick = ToolButton1Click end object TBDel: TToolButton - Left = 435 + Left = 514 Top = 0 AutoSize = True Caption = #21024#38500 @@ -87,7 +95,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnClick = TBDelClick end object tchk: TToolButton - Left = 514 + Left = 593 Top = 0 AutoSize = True Caption = #23457#26680 @@ -95,7 +103,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnClick = tchkClick end object Tnochk: TToolButton - Left = 593 + Left = 672 Top = 0 AutoSize = True Caption = #25764#38144#23457#26680 @@ -103,7 +111,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnClick = TnochkClick end object TBPrint: TToolButton - Left = 712 + Left = 791 Top = 0 AutoSize = True Caption = #25171#21360 @@ -111,7 +119,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnClick = TBPrintClick end object TBClose: TToolButton - Left = 791 + Left = 870 Top = 0 AutoSize = True Caption = #20851#38381 @@ -121,9 +129,9 @@ object frmYMTFHSQList: TfrmYMTFHSQList end object cxGrid1: TcxGrid Left = 0 - Top = 128 + Top = 108 Width = 1300 - Height = 194 + Height = 282 Align = alClient TabOrder = 2 object Tv1: TcxGridDBTableView @@ -373,88 +381,88 @@ object frmYMTFHSQList: TfrmYMTFHSQList Left = 0 Top = 32 Width = 1300 - Height = 96 + Height = 76 Align = alTop BevelInner = bvRaised BevelOuter = bvLowered Color = clSkyBlue TabOrder = 1 object Label1: TLabel - Left = 29 - Top = 19 - Width = 92 - Height = 22 + Left = 23 + Top = 15 + Width = 80 + Height = 19 Caption = #30003#35831#26085#26399 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label4: TLabel - Left = 343 - Top = 19 - Width = 92 - Height = 22 + Left = 274 + Top = 15 + Width = 80 + Height = 19 Caption = #25910#36135#21333#20301 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label5: TLabel - Left = 365 - Top = 56 - Width = 69 - Height = 22 + Left = 292 + Top = 45 + Width = 60 + Height = 19 Caption = #19994#21153#21592 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label2: TLabel - Left = 106 - Top = 56 - Width = 12 - Height = 22 + Left = 85 + Top = 45 + Width = 11 + Height = 19 Caption = '-' Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label3: TLabel - Left = 586 - Top = 19 - Width = 92 - Height = 22 + Left = 469 + Top = 15 + Width = 80 + Height = 19 Caption = #23457#26680#29366#24577 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object BegDate: TDateTimePicker - Left = 126 - Top = 15 - Width = 156 - Height = 30 + Left = 101 + Top = 12 + Width = 125 + Height = 27 Date = 40675.464742650460000000 Format = 'yyyy-MM-dd' Time = 40675.464742650460000000 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -463,16 +471,16 @@ object frmYMTFHSQList: TfrmYMTFHSQList OnChange = BegDateChange end object EndDate: TDateTimePicker - Left = 126 - Top = 52 - Width = 157 - Height = 30 + Left = 101 + Top = 42 + Width = 125 + Height = 27 Date = 40675.464761099540000000 Format = 'yyyy-MM-dd' Time = 40675.464761099540000000 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -482,13 +490,13 @@ object frmYMTFHSQList: TfrmYMTFHSQList end object SHDanWei: TEdit Tag = 2 - Left = 435 - Top = 17 - Width = 123 - Height = 25 + Left = 363 + Top = 11 + Width = 98 + Height = 27 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -498,13 +506,13 @@ object frmYMTFHSQList: TfrmYMTFHSQList end object Salesman: TEdit Tag = 2 - Left = 435 - Top = 54 - Width = 120 - Height = 25 + Left = 363 + Top = 40 + Width = 98 + Height = 27 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -514,16 +522,16 @@ object frmYMTFHSQList: TfrmYMTFHSQList end object ComboBox1: TComboBox Tag = 7 - Left = 679 - Top = 15 - Width = 126 - Height = 30 + Left = 555 + Top = 10 + Width = 101 + Height = 27 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] - ItemHeight = 22 + ItemHeight = 19 ItemIndex = 0 ParentFont = False TabOrder = 4 @@ -536,7 +544,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList end object cxSplitter1: TcxSplitter Left = 0 - Top = 322 + Top = 390 Width = 1300 Height = 8 HotZoneClassName = 'TcxMediaPlayer9Style' @@ -545,9 +553,9 @@ object frmYMTFHSQList: TfrmYMTFHSQList end object cxGrid2: TcxGrid Left = 0 - Top = 330 + Top = 398 Width = 1300 - Height = 312 + Height = 250 Align = alBottom TabOrder = 4 object Tv2: TcxGridDBTableView @@ -657,11 +665,18 @@ object frmYMTFHSQList: TfrmYMTFHSQList Width = 105 end object v2Column3: TcxGridDBColumn - Caption = #21457#36135#31859#25968 + Caption = #21457#36135#38271#24230 DataBinding.FieldName = 'FHMQty' HeaderAlignmentHorz = taCenter Width = 126 end + object Tv2Column1: TcxGridDBColumn + Caption = #21457#36135#37325#37327 + DataBinding.FieldName = 'FHKgQty' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 126 + end object v2Column4: TcxGridDBColumn Caption = #36153#29992#21517#31216 DataBinding.FieldName = 'FeeName' @@ -680,52 +695,52 @@ object frmYMTFHSQList: TfrmYMTFHSQList end end object Panel3: TPanel - Left = 610 - Top = 235 - Width = 293 - Height = 121 + Left = 488 + Top = 188 + Width = 234 + Height = 97 Color = clSkyBlue TabOrder = 5 Visible = False object Label25: TLabel - Left = 30 - Top = 15 - Width = 60 - Height = 15 + Left = 24 + Top = 12 + Width = 48 + Height = 12 Caption = #20986#24211#31867#22411 end object btnChk: TButton - Left = 35 - Top = 71 - Width = 75 - Height = 32 + Left = 28 + Top = 57 + Width = 60 + Height = 25 Caption = #30830#35748 TabOrder = 0 OnClick = btnChkClick end object Button3: TButton - Left = 200 - Top = 71 - Width = 75 - Height = 32 + Left = 160 + Top = 57 + Width = 60 + Height = 25 Caption = #20851#38381 TabOrder = 1 OnClick = Button3Click end object CRType: TComboBox Tag = 1 - Left = 99 - Top = 10 - Width = 174 - Height = 30 + Left = 79 + Top = 8 + Width = 139 + Height = 27 Style = csDropDownList Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -22 + Font.Height = -19 Font.Name = #23435#20307 Font.Style = [fsBold] ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 - ItemHeight = 22 + ItemHeight = 19 ParentFont = False TabOrder = 2 Items.Strings = ( @@ -882,7 +897,7 @@ object frmYMTFHSQList: TfrmYMTFHSQList object cxStyleRepository1: TcxStyleRepository Left = 636 Top = 337 - PixelsPerInch = 120 + PixelsPerInch = 96 object cxStyle1: TcxStyle AssignedValues = [svFont] Font.Charset = ANSI_CHARSET diff --git a/云翔一码通/U_YMTFHSQList.pas b/云翔一码通/U_YMTFHSQList.pas index 589b713..5b8f1fb 100644 --- a/云翔一码通/U_YMTFHSQList.pas +++ b/云翔一码通/U_YMTFHSQList.pas @@ -110,6 +110,8 @@ type CRType: TComboBox; v1Column6: TcxGridDBColumn; Tv1Column1: TcxGridDBColumn; + TbAdd2: TToolButton; + Tv2Column1: TcxGridDBColumn; //RMllPDFExport1: TRMllPDFExport; procedure FormDestroy(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); @@ -133,6 +135,7 @@ type procedure ToolButton2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure btnChkClick(Sender: TObject); + procedure TbAdd2Click(Sender: TObject); private procedure InitGrid(); procedure InitSubGrid(); @@ -152,7 +155,7 @@ var implementation uses - U_DataLink, U_YMTFHSQInPut, U_Fun, U_ZDYHelp, U_LabelPrintFun; + U_DataLink, U_YMTFHSQInPut, U_Fun, U_ZDYHelp, U_LabelPrintFun, U_YMTFHSQInPut2; {$R *.dfm} @@ -263,6 +266,15 @@ begin sql.Add(' and filltime>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.Date)) + ''''); sql.Add(' and filltime<''' + Trim(FormatDateTime('yyyy-MM-dd', EndDate.Date + 1)) + ''''); + if Trim(Self.Caption) = '۷' then + begin + sql.Add(' and CRType in ('''','''')'); + end + else if Trim(Self.Caption) = 'ӹǼ' then + begin + sql.Add(' and CRType in (''ӹ'',''ӹ'',''ӹ'')'); + end; + if ComboBox1.Text = 'δ' then begin SQL.Add(' and isnull(A.Chker,'''')='''' '); @@ -295,7 +307,16 @@ begin EndDate.DateTime := SGetServerDate10(ADOQueryTemp); BegDate.DateTime := EndDate.DateTime; - InitGrid(); + if Trim(Self.Caption) = '۷' then + begin + TBAdd.Visible := True; + TBAdd2.Visible := False; + end + else if Trim(Self.Caption) = 'ӹǼ' then + begin + TBAdd2.Visible := True; + TBAdd.Visible := False; + end; end; @@ -329,21 +350,44 @@ begin Application.MessageBox('Ӧ˿޸!', 'ʾ', 0); Exit; end; - try - frmFHSQInPut := TfrmFHSQInPut.Create(Application); - with frmFHSQInPut do - begin - PState := 1; - FMainId := Trim(Self.Order_Main.fieldbyname('FSID').AsString); - FZZType := trim(self.FZZType); - if ShowModal = 1 then - begin + if Trim(Self.Caption) = '۷' then + begin + try + frmFHSQInPut := TfrmFHSQInPut.Create(Application); + with frmFHSQInPut do + begin + PState := 1; + FMainId := Trim(Self.Order_Main.fieldbyname('FSID').AsString); + FZZType := trim(self.FZZType); + if ShowModal = 1 then + begin + + end; end; + finally + frmFHSQInPut.Free; + end; + end + else if Trim(Self.Caption) = 'ӹǼ' then + begin + try + frmFHSQInPut2 := TfrmFHSQInPut2.Create(Application); + with frmFHSQInPut2 do + begin + PState := 1; + FMainId := Trim(Self.Order_Main.fieldbyname('FSID').AsString); + FZZType := trim(self.FZZType); + if ShowModal = 1 then + begin + + end; + end; + finally + frmFHSQInPut2.Free; end; - finally - frmFHSQInPut.Free; end; + end; procedure TfrmYMTFHSQList.TBDelClick(Sender: TObject); @@ -435,7 +479,7 @@ begin MPrintJson := '{ "LBName": "뵥","QrCodeField": "ssid","DConString": "' + DConString + '","DCode": "' + DCode + '","DName": "' + DName + '","IsPreview": true,"printerIndex": 0,"ExportFileType": "", "PrtArgs": [ {"SqlStr": "' + msql + '" }] }'; FunPrint(Application, PChar(MPrintJson)); - + end; procedure TfrmYMTFHSQList.TBRafreshClick(Sender: TObject); @@ -469,6 +513,7 @@ end; procedure TfrmYMTFHSQList.FormShow(Sender: TObject); begin InitForm(); + InitGrid(); end; procedure TfrmYMTFHSQList.CheckBox1Click(Sender: TObject); @@ -682,5 +727,25 @@ begin end; end; +procedure TfrmYMTFHSQList.TbAdd2Click(Sender: TObject); +begin + try + frmFHSQInPut2 := TfrmFHSQInPut2.Create(Application); + with frmFHSQInPut2 do + begin + PState := 0; + FMainId := ''; + FZZType := trim(self.FZZType); + if ShowModal = 1 then + begin + + end; + end; + finally + frmFHSQInPut2.Free; + end; + InitGrid(); +end; + end. diff --git a/云翔一码通/U_YMTJGWCList.dfm b/云翔一码通/U_YMTJGWCList.dfm index d047b58..7c11770 100644 --- a/云翔一码通/U_YMTJGWCList.dfm +++ b/云翔一码通/U_YMTJGWCList.dfm @@ -1,6 +1,6 @@ object frmYMTJGWCList: TfrmYMTJGWCList - Left = 433 - Top = 674 + Left = 558 + Top = 353 Width = 1370 Height = 750 Caption = #21152#24037#23436#25104#22238#20179#25968#25454 @@ -236,7 +236,7 @@ object frmYMTJGWCList: TfrmYMTJGWCList end item Kind = skSum - Column = TV1Qty + Column = TV1MQty end item Kind = skSum @@ -353,10 +353,17 @@ object frmYMTJGWCList: TfrmYMTJGWCList Options.Editing = False Width = 70 end - object TV1Qty: TcxGridDBColumn + object Tv1KgQty: TcxGridDBColumn + Caption = #37325#37327 + DataBinding.FieldName = 'KgQty' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 85 + end + object TV1MQty: TcxGridDBColumn Tag = 2 - Caption = #25968#37327 - DataBinding.FieldName = 'Qty' + Caption = #38271#24230 + DataBinding.FieldName = 'MQty' PropertiesClassName = 'TcxTextEditProperties' HeaderAlignmentHorz = taCenter Options.Editing = False diff --git a/云翔一码通/U_YMTJGWCList.pas b/云翔一码通/U_YMTJGWCList.pas index 6c8337a..0a7d4de 100644 --- a/云翔一码通/U_YMTJGWCList.pas +++ b/云翔一码通/U_YMTJGWCList.pas @@ -71,7 +71,7 @@ type TV1SPHX: TcxGridDBColumn; TV1FactoryName: TcxGridDBColumn; TV1SPName: TcxGridDBColumn; - TV1Qty: TcxGridDBColumn; + TV1MQty: TcxGridDBColumn; cxGrid2Level1: TcxGridLevel; Label13: TLabel; MXPrtColor: TEdit; @@ -87,6 +87,7 @@ type btn1: TButton; KuWei: TcxButtonEdit; Tv1KuWei: TcxGridDBColumn; + Tv1KgQty: TcxGridDBColumn; procedure FormDestroy(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); @@ -377,7 +378,7 @@ begin with Self.CDS_Main do begin Edit; - FieldByName('KuWei').Value := Trim(frmKuWeiList.Order_Main.fieldbyname('KWName').AsString); + KuWei.Text := Trim(frmKuWeiList.Order_Main.fieldbyname('KWName').AsString); end; end; end; diff --git a/云翔一码通/U_YMTRKInPut.dfm b/云翔一码通/U_YMTRKInPut.dfm index 70dfbd2..76f3304 100644 --- a/云翔一码通/U_YMTRKInPut.dfm +++ b/云翔一码通/U_YMTRKInPut.dfm @@ -14,6 +14,8 @@ object frmYMTRKInPut: TfrmYMTRKInPut OldCreateOrder = False Position = poScreenCenter OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy OnShow = FormShow PixelsPerInch = 96 TextHeight = 12 @@ -315,6 +317,7 @@ object frmYMTRKInPut: TfrmYMTRKInPut Width = 70 end object Tv1Price: TcxGridDBColumn + Tag = 2 Caption = #21333#20215 DataBinding.FieldName = 'Price' PropertiesClassName = 'TcxCurrencyEditProperties' @@ -577,9 +580,9 @@ object frmYMTRKInPut: TfrmYMTRKInPut TabOrder = 3 object cxGrid1: TcxGrid Left = 1 - Top = 1 + Top = 71 Width = 257 - Height = 557 + Height = 487 Align = alClient TabOrder = 0 object TvMX: TcxGridDBTableView @@ -629,28 +632,90 @@ object frmYMTRKInPut: TfrmYMTRKInPut Caption = #32534#21495 DataBinding.FieldName = 'MXID' HeaderAlignmentHorz = taCenter + Options.Editing = False Width = 99 end object TvMXMXQty: TcxGridDBColumn Caption = #25968#37327 - DataBinding.FieldName = 'MXQty' + DataBinding.FieldName = 'MQty' PropertiesClassName = 'TcxTextEditProperties' HeaderAlignmentHorz = taCenter - Options.Editing = False Options.Sorting = False - Width = 80 + Width = 60 end object TvMXColumn1: TcxGridDBColumn Caption = #37325#37327 DataBinding.FieldName = 'KGQty' HeaderAlignmentHorz = taCenter - Width = 80 + Width = 60 end end object cxGridLevel2: TcxGridLevel GridView = TvMX end end + object Panel3: TPanel + Left = 1 + Top = 1 + Width = 257 + Height = 41 + Align = alTop + TabOrder = 1 + object Label17: TLabel + Left = 6 + Top = 12 + Width = 36 + Height = 12 + Caption = #22686#34892#25968 + Layout = tlCenter + end + object AddNum: TEdit + Left = 47 + Top = 10 + Width = 41 + Height = 20 + TabOrder = 0 + OnKeyPress = AddNumKeyPress + end + object BtnQuicklyAdd: TButton + Left = 98 + Top = 4 + Width = 75 + Height = 30 + Caption = #24555#36895#22686#34892 + TabOrder = 1 + OnClick = BtnQuicklyAddClick + end + end + object ToolBar2: TToolBar + Left = 1 + Top = 42 + Width = 257 + Height = 29 + ButtonHeight = 30 + ButtonWidth = 71 + Caption = 'ToolBar2' + Images = DataLink_YXYMT.ThreeImgList + List = True + ShowCaptions = True + TabOrder = 2 + object TbAddRow: TToolButton + Left = 0 + Top = 2 + AutoSize = True + Caption = #22686#21333#34892 + ImageIndex = 12 + OnClick = TbAddRowClick + end + object TbDeleteRow: TToolButton + Left = 75 + Top = 2 + AutoSize = True + Caption = #21024#34892 + ImageIndex = 13 + OnClick = TbDeleteRowClick + end + end end object DataSource3: TDataSource DataSet = CDS_Sub @@ -700,4 +765,21 @@ object frmYMTRKInPut: TfrmYMTRKInPut Left = 1170 Top = 287 end + object http: TIdHTTP + MaxLineAction = maException + ReadTimeout = 0 + AllowCookies = True + ProxyParams.BasicAuthentication = False + ProxyParams.ProxyPort = 0 + Request.ContentLength = -1 + Request.ContentRangeEnd = 0 + Request.ContentRangeStart = 0 + Request.ContentType = 'text/html' + Request.Accept = 'text/html, */*' + Request.BasicAuthentication = False + Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)' + HTTPOptions = [hoForceEncodeParams] + Left = 532 + Top = 320 + end end diff --git a/云翔一码通/U_YMTRKInPut.pas b/云翔一码通/U_YMTRKInPut.pas index d6d23ea..a765c67 100644 --- a/云翔一码通/U_YMTRKInPut.pas +++ b/云翔一码通/U_YMTRKInPut.pas @@ -22,7 +22,8 @@ uses dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, - dxSkinscxPCPainter, cxNavigator, cxCurrencyEdit; + dxSkinscxPCPainter, cxNavigator, cxCurrencyEdit, IdBaseComponent, IdComponent, + IdTCPConnection, IdTCPClient, IdHTTP; type TfrmYMTRKInPut = class(TForm) @@ -92,6 +93,14 @@ type Tv1IsTax: TcxGridDBColumn; Tv1Money: TcxGridDBColumn; Tv1Price: TcxGridDBColumn; + Panel3: TPanel; + Label17: TLabel; + AddNum: TEdit; + BtnQuicklyAdd: TButton; + ToolBar2: TToolBar; + TbAddRow: TToolButton; + TbDeleteRow: TToolButton; + http: TIdHTTP; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure TBAddClick(Sender: TObject); procedure TBCloseClick(Sender: TObject); @@ -116,6 +125,12 @@ type procedure v1Column21PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure Tv1PricePropertiesEditValueChanged(Sender: TObject); procedure Tv1PriceTypePropertiesEditValueChanged(Sender: TObject); + procedure BtnQuicklyAddClick(Sender: TObject); + procedure TbAddRowClick(Sender: TObject); + procedure TbDeleteRowClick(Sender: TObject); + procedure AddNumKeyPress(Sender: TObject; var Key: Char); + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); private { Private declarations } function SaveCKData(): Boolean; @@ -123,10 +138,12 @@ type procedure InitGrid(); procedure AddRows(); function YFData(): Boolean; + function BatchStockIn(MXIDs: string; UserID: string): Boolean; public { Public declarations } FBCId: string; PState, CopyInt: Integer; + FSelectedSPIDs: TStringList; // ڱѡеSPID end; var @@ -135,9 +152,85 @@ var implementation uses - U_DataLink, U_RTFun, U_ZDYHelp, U_ZdyAttachGYS, U_MLMangeYHSel, U_ZdyAttachKH,U_KuWeiList; + U_DataLink, U_RTFun, U_ZDYHelp, U_ZdyAttachGYS, U_MLMangeYHSel, U_ZdyAttachKH, + U_KuWeiList, superobject; {$R *.dfm} + +function TfrmYMTRKInPut.BatchStockIn(MXIDs: string; UserID: string): Boolean; +var + IdHttp: TIdHTTP; + Url, ResponseStr: string; + ResponseStream: TStringStream; + vJson1: ISuperObject; +begin + Result := False; + +// ֤ + if Trim(MXIDs) = '' then + begin + ShowMessage('MXIDΪ'); + Exit; + end; + + if Trim(UserID) = '' then + begin + ShowMessage('ûIDΪ'); + Exit; + end; + + IdHttp := TIdHTTP.Create(nil); + ResponseStream := TStringStream.Create(''); + try + try + // GET - ҪContentType + // ֱӷURL + // ӿURLURLУ + Url := 'http://www.rightsoft.top/YunXiang/api/YMTCK/batchStockIn?' + 'MXID=' + Trim(MXIDs) + '&userid=' + Trim(UserID); +// ShowMessage(Url); + // GET + IdHttp.Get(Url, ResponseStream); + + // ȡӦ + ResponseStr := ResponseStream.DataString; + + // JSONӦ + vJson1 := SO(ResponseStr); +// ShowMessage(ResponseStr); + if (vJson1.O['code'] <> nil) then + begin + if (vJson1.O['code'].AsInteger = 10000) then + begin + Result := True; + ShowMessage('ɹ'); + end + else + begin + // ȡϢ + if vJson1.O['message'] <> nil then + ShowMessage('ʧ: ' + vJson1.O['message'].AsString) + else + ShowMessage('ʧܣδ֪'); + end; + end + else + begin + ShowMessage('ӿڷظʽ'); + end; + + except + on e: Exception do + begin + ShowMessage('쳣: ' + e.Message); + end; + end; + + finally + IdHttp.Free; + ResponseStream.Free; + end; +end; + function TfrmYMTRKInPut.YFData(): Boolean; var CRID, OrdMainId, YFID, FComTaiTou, FCRID, FFactoryName, FFactoryNo: string; @@ -311,17 +404,43 @@ begin end; procedure TfrmYMTRKInPut.InitMXGrid(SPID: string); +var + FilterSPID: string; begin - with ADOQueryTemp do - begin - Close; - sql.Clear; - sql.Add('select * from YMT_CK_MX where SPID=' + quotedstr(Trim(SPID))); - sql.Add(' order by MXID'); - Open; + if not Assigned(CDS_MX) then + Exit; + + try + CDS_MX.DisableControls; + try + // й + CDS_MX.Filtered := False; + CDS_MX.Filter := ''; + + // CDS_SubȡSPIDù + + FilterSPID := SPID; + + if FilterSPID <> '' then + begin + CDS_MX.Filter := 'SPID = ''' + FilterSPID + ''''; + CDS_MX.Filtered := True; + end; + + // ѡûйλһ¼ + if not CDS_MX.Filtered then + CDS_MX.First; + + finally + CDS_MX.EnableControls; + end; + except + on E: Exception do + begin + // ӴʾϢ + MessageDlg('ʼMXGridʱ: ' + E.Message, mtError, [mbOK], 0); + end; end; - SCreateCDS20(ADOQueryTemp, CDS_MX); - SInitCDSData20(ADOQueryTemp, CDS_MX); end; procedure TfrmYMTRKInPut.AddRows(); @@ -363,23 +482,58 @@ begin end; procedure TfrmYMTRKInPut.InitGrid(); +var + SPIDList: string; + i: Integer; begin - with ADOQueryTemp do + // жѡеSPIDINѯ + if Assigned(FSelectedSPIDs) and (FSelectedSPIDs.Count > 0) then begin - Close; - sql.Clear; - sql.Add(' select A.* '); - sql.Add(',OrderNO=(select OrderNO from JYOrder_Main JM where JM.MainId=A.ORDMainIdRK)'); - sql.Add(' from YMT_CK_CR A'); - sql.Add(' where SPID=''' + Trim(FBCId) + ''''); - Open; + SPIDList := ''; + for i := 0 to FSelectedSPIDs.Count - 1 do + begin + if i > 0 then + SPIDList := SPIDList + ','; + SPIDList := SPIDList + QuotedStr(FSelectedSPIDs[i]); + end; + + with ADOQueryTemp do + begin + Close; + sql.Clear; + sql.Add(' select A.* '); + sql.Add(',OrderNO=(select OrderNO from JYOrder_Main JM where JM.MainId=A.ORDMainIdRK)'); + sql.Add(' from YMT_CK_CR A'); + sql.Add(' where SPID IN (' + SPIDList + ')'); + Open; + end; + end + else + begin + // ԭеĵSPIDѯ߼ + with ADOQueryTemp do + begin + Close; + sql.Clear; + sql.Add(' select A.* '); + sql.Add(',OrderNO=(select OrderNO from JYOrder_Main JM where JM.MainId=A.ORDMainIdRK)'); + sql.Add(' from YMT_CK_CR A'); + sql.Add(' where SPID=''' + Trim(FBCId) + ''''); + Open; + end; end; + + // 뱣ֲ SCreateCDS20(ADOQueryTemp, CDS_Sub); SInitCDSData20(ADOQueryTemp, CDS_Sub); if CDS_Sub.IsEmpty then Exit; + // ע⣺Ҫ޸ģΪжSPID + // ҪδSPID InitMXGrid(CDS_Sub.fieldbyname('SPID').AsString); + + // 뱣ֲ with ADOQueryTemp do begin Close; @@ -388,8 +542,10 @@ begin sql.Add(' and CRQtyFlag=-1'); Open; end; + if not ADOQueryTemp.IsEmpty then begin + // v1Column4.Options.Focusing := False; v1Column14.Options.Focusing := False; v2Column1.Options.Focusing := False; @@ -402,6 +558,7 @@ begin end else begin + // v1Column4.Options.Focusing := True; v1Column14.Options.Focusing := True; v2Column1.Options.Focusing := True; @@ -412,6 +569,56 @@ begin v1Column11.Options.Focusing := True; end; end; +//procedure TfrmYMTRKInPut.InitGrid(); +//begin +// with ADOQueryTemp do +// begin +// Close; +// sql.Clear; +// sql.Add(' select A.* '); +// sql.Add(',OrderNO=(select OrderNO from JYOrder_Main JM where JM.MainId=A.ORDMainIdRK)'); +// sql.Add(' from YMT_CK_CR A'); +// sql.Add(' where SPID=''' + Trim(FBCId) + ''''); +// Open; +// end; +// SCreateCDS20(ADOQueryTemp, CDS_Sub); +// SInitCDSData20(ADOQueryTemp, CDS_Sub); +// if CDS_Sub.IsEmpty then +// Exit; +// +// InitMXGrid(CDS_Sub.fieldbyname('SPID').AsString); +// with ADOQueryTemp do +// begin +// Close; +// sql.Clear; +// sql.Add('select * from YMT_CK_CR where FZSPID=''' + Trim(CDS_Sub.fieldbyname('SPID').AsString) + ''''); +// sql.Add(' and CRQtyFlag=-1'); +// Open; +// end; +// if not ADOQueryTemp.IsEmpty then +// begin +// v1Column4.Options.Focusing := False; +// v1Column14.Options.Focusing := False; +// v2Column1.Options.Focusing := False; +// v1Column8.Options.Focusing := False; +// v1Column7.Options.Focusing := False; +// v1Column1.Options.Focusing := False; +// v1Column10.Options.Focusing := False; +// v1Column11.Options.Focusing := False; +// Exit; +// end +// else +// begin +// v1Column4.Options.Focusing := True; +// v1Column14.Options.Focusing := True; +// v2Column1.Options.Focusing := True; +// v1Column8.Options.Focusing := True; +// v1Column7.Options.Focusing := True; +// v1Column1.Options.Focusing := True; +// v1Column10.Options.Focusing := True; +// v1Column11.Options.Focusing := True; +// end; +//end; procedure TfrmYMTRKInPut.FormClose(Sender: TObject; var Action: TCloseAction); begin @@ -458,16 +665,20 @@ end; function TfrmYMTRKInPut.SaveCKData(): Boolean; var - FCRID, Maxno, FFSPID: string; + FCRID, Maxno, MaxMXno, FFSPID, FFMXID: string; + MXIDs: string; // ռҪMXID begin try ADOQueryCmd.Connection.BeginTrans; CDS_Sub.DisableControls; + // ʼMXIDsÿʼʱ + MXIDs := ''; with CDS_Sub do begin First; while not eof do begin + with ADOQueryTemp do begin Close; @@ -476,6 +687,7 @@ begin open; end; FFSPID := Trim(ADOQueryTemp.fieldbyname('SPID').AsString); + if Trim(FFSPID) = '' then begin Maxno := Trim(CDS_Sub.fieldbyname('SPID').AsString); @@ -503,7 +715,8 @@ begin begin Edit; end; - + //////////////////////////////////////////////////////////////////////////////////////////// + ////////// FieldByName('SPID').Value := Trim(Maxno); FieldByName('FZSPID').Value := Trim(Maxno); FieldByName('CKName').Value := '첼'; @@ -517,7 +730,7 @@ begin FieldByName('CRQtyFlag').Value := 1; RTSetSaveDataCDS(ADOQueryCmd, Tv1, CDS_Sub, 'YMT_CK_CR', 2); - YFData(); + if Trim(FFSPID) = '' then FieldByName('Filler').Value := Trim(DName) else @@ -530,10 +743,13 @@ begin begin FieldByName('QCOrderNo').Value := Trim(CDS_Sub.fieldbyname('OrderNo').AsString); end; - + //////////////////////////////////////////////////////////////////////////////////////////// Post; end; + //////////Ӧ + YFData(); + with ADOQueryCmd do begin Close; @@ -560,19 +776,103 @@ begin Exit; end; + + /////////////////////////////////////////////////////////////////////////// + /// ӱ + with CDS_MX do + begin + DisableControls; // CDS_MXؼ + try + CDS_MX.Filter := 'SPID = ''' + Trim(Maxno) + ''''; + First; + while not Eof do + begin + // ѯϸ¼Ƿ + with ADOQueryTemp do + begin + Close; + SQL.Clear; + SQL.Add('select * from YMT_CK_MX where MXID=''' + Trim(CDS_MX.fieldbyname('MXID').AsString) + ''''); + Open; + end; + + FFMXID := Trim(ADOQueryTemp.fieldbyname('MXID').AsString); + + if Trim(FFMXID) = '' then + MaxMXno := Trim(CDS_MX.fieldbyname('MXID').AsString) + else + MaxMXno := Trim(FFMXID); + + // ׼ϸ + with ADOQueryCmd do + begin + Close; + SQL.Clear; + SQL.Add('select * from YMT_CK_MX where MXID=''' + Trim(MaxMXno) + ''''); + Open; + + if Trim(FFMXID) = '' then + Append + else + Edit; + + FieldByName('SPID').Value := Trim(CDS_MX.fieldbyname('SPID').AsString); + FieldByName('MXID').Value := Trim(MaxMXno); // ȷMXID + + RTSetSaveDataCDS(ADOQueryCmd, TvMX, CDS_MX, 'YMT_CK_MX', 0); + + if Trim(FFMXID) = '' then + FieldByName('Filler').Value := Trim(DName) + else + begin + FieldByName('EditUser').Value := Trim(DName); + FieldByName('EditTime').Value := SGetServerDate(ADOQueryTemp); + end; + + Post; + end; + + // MQtyǷ0ռMXID + if CDS_MX.FieldByName('MQty').AsFloat > 0 then + begin + if MXIDs <> '' then + MXIDs := MXIDs + ',' + Trim(MaxMXno) + else + MXIDs := Trim(MaxMXno); + end; + + Next; // ƶһ¼ѭ + end; + finally + EnableControls; // ָCDS_MXؼ״̬ + end; + end; + Edit; FieldByName('SPID').Value := Trim(Maxno); Post; - if PState = 0 then - AddRows(); + Next; end; end; CDS_Sub.EnableControls; + ADOQueryCmd.Connection.CommitTrans; + // Ҫļ¼ýӿ + if MXIDs <> '' then + begin + if not BatchStockIn(MXIDs, Trim(DCode)) then + begin +// ӿڵʧܣѡع +// ADOQueryCmd.Connection.RollbackTrans; + Application.MessageBox('ӿڵʧ!', 'ʾ', 0); + Exit; + end; + end; Result := True; except Result := False; + ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('쳣!', 'ʾ', 0); end; @@ -592,6 +892,19 @@ begin ReadCxGrid('첼Ǽ', Tv1, '첼ֿ'); InitGrid(); + with ADOQueryTemp do + begin + Close; + sql.Clear; + sql.Add('select * from YMT_CK_MX '); + Open; + end; + SCreateCDS20(ADOQueryTemp, CDS_MX); + SInitCDSData20(ADOQueryTemp, CDS_MX); + if PState = 0 then + InitMXGrid(' ') + else + InitMXGrid(Trim(CDS_Sub.fieldbyname('SPID').AsString)); end; procedure TfrmYMTRKInPut.TBDelClick(Sender: TObject); @@ -649,16 +962,18 @@ begin // Application.MessageBox('ʱ䲻Ϊ!', 'ʾ', 0); // Exit; // end; -// if CDS_Sub.Locate('CRType', null, []) = True then -// begin -// Application.MessageBox('ͲΪ!', 'ʾ', 0); -// Exit; -// end; -// if CDS_Sub.Locate('SPName', null, []) = True then -// begin -// Application.MessageBox('ƷΪ!', 'ʾ', 0); -// Exit; -// end; + + if CDS_Sub.Locate('CRType', null, []) = True then + begin + Application.MessageBox('ͲΪ!', 'ʾ', 0); + Exit; + end; + if CDS_Sub.Locate('SPName', null, []) = True then + begin + Application.MessageBox('ƷΪ!', 'ʾ', 0); + Exit; + end; + // if CDS_Sub.Locate('OrderNo', null, []) = True then // begin // Application.MessageBox('ŲΪ!', 'ʾ', 0); @@ -669,14 +984,16 @@ begin // Application.MessageBox('ŹΪ!', 'ʾ', 0); // Exit; // end; -// if trim(CDS_Sub.fieldbyname('CRType').AsString) <> 'ͻ˻' then -// begin -// if CDS_Sub.Locate('FactoryName', null, []) = True then -// begin -// Application.MessageBox('ӹΪ!', 'ʾ', 0); -// Exit; -// end; -// end; + if (trim(CDS_Sub.fieldbyname('CRType').AsString) <> 'ڳ') and (trim(CDS_Sub.fieldbyname('CRType').AsString) <> 'ͻ˻') then + begin + if CDS_Sub.Locate('FactoryName', null, []) = True then + begin + Application.MessageBox('Ӧ̲Ϊ!', 'ʾ', 0); + Exit; + end; + end; + + // if CDS_Sub.Locate('PiQty', null, []) = True then // begin // Application.MessageBox('ƥΪ!', 'ʾ', 0); @@ -1082,5 +1399,151 @@ begin end; end; +procedure TfrmYMTRKInPut.BtnQuicklyAddClick(Sender: TObject); +var + Num, i: Integer; + MaxNo, MMXID, SPID: string; +begin + Num := StrToInt(Trim(AddNum.Text)); + SPID := Trim(CDS_Sub.fieldbyname('SPID').AsString); + if SPID = '' then + Exit; + + try + ADOQueryCmd.Connection.BeginTrans; + for i := 1 to Num do + begin + if GetLSNo(ADOQueryTemp, MaxNo, 'MCM', 'YMT_CK_MX', 3, 1) = False then + begin + Application.MessageBox('ȡʧ!', 'ʾ', 0); + Exit; + end; + MMXID := Trim(MaxNo); + with CDS_MX do + begin + Append; + FieldByName('MXID').Value := MMXID; + FieldByName('SPID').Value := SPID; + FieldByName('MQty').Value := '0'; + FieldByName('KGQty').Value := '0'; + Post; + end; + end; + ADOQueryCmd.Connection.CommitTrans; + except + ADOQueryCmd.Connection.RollbackTrans; + Application.MessageBox('ʧ!', 'ʾ', 0); + end; + +end; + +procedure TfrmYMTRKInPut.TbAddRowClick(Sender: TObject); +var + MaxNo, MMXID, SPID: string; +begin + SPID := Trim(CDS_Sub.fieldbyname('SPID').AsString); + if SPID = '' then + Exit; + if GetLSNo(ADOQueryTemp, MaxNo, 'MCM', 'YMT_CK_MX', 3, 1) = False then + begin + Application.MessageBox('ȡʧ!', 'ʾ', 0); + Exit; + end; + + MMXID := Trim(MaxNo); + + with CDS_MX do + begin + if IsEmpty = False then + begin + Append; + end + else + begin + Edit; + end; + FieldByName('MXID').Value := MMXID; + FieldByName('SPID').Value := SPID; + FieldByName('MQty').Value := '0'; + FieldByName('KGQty').Value := '0'; + Post; + end; + +end; + +procedure TfrmYMTRKInPut.TbDeleteRowClick(Sender: TObject); +var + Bookmark: TBookmark; +begin + if CDS_MX.IsEmpty then + begin + Application.MessageBox('ǰûпɾļ¼', 'ʾ', MB_ICONWARNING); + Exit; + end; + + if Trim(CDS_MX.fieldbyname('MXID').AsString) <> '' then + begin + with ADOQueryTemp do + begin + Close; + sql.Clear; + sql.Add('select * from YMT_FHSQ_Sub where MXID=''' + Trim(CDS_MX.fieldbyname('MXID').AsString) + ''''); + Open; + end; + if ADOQueryTemp.IsEmpty = False then + begin + Application.MessageBox('г¼ɾ!', 'ʾ', 0); + Exit; + end; + end; + + if Application.MessageBox('ȷҪɾǰ', 'ȷɾ', MB_ICONQUESTION + MB_YESNO) <> IDYES then + Exit; + + // ¼ǰУɾԻصλ + Bookmark := CDS_MX.GetBookmark; + with ADOQueryCmd do + begin + Close; + SQL.Clear; + sql.Add('delete YMT_CK_MX where MXID=' + quotedstr(Trim(CDS_MX.FieldByName('MXID').AsString))); + ExecSQL; + end; + with ADOQueryCmd do + begin + Close; + SQL.Clear; + sql.Add('delete YMT_CK_CR where FromMXID=' + quotedstr(Trim(CDS_MX.FieldByName('MXID').AsString))); + ExecSQL; + end; + try + CDS_MX.Delete; + finally + if CDS_MX.BookmarkValid(Bookmark) then + CDS_MX.GotoBookmark(Bookmark); + CDS_MX.FreeBookmark(Bookmark); + end; + +end; + +procedure TfrmYMTRKInPut.AddNumKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + BtnQuicklyAdd.Click; + +end; + +procedure TfrmYMTRKInPut.FormDestroy(Sender: TObject); +begin + if Assigned(FSelectedSPIDs) then + FSelectedSPIDs.Free; + inherited; +end; + +procedure TfrmYMTRKInPut.FormCreate(Sender: TObject); +begin +FSelectedSPIDs := TStringList.Create; +end; + end. diff --git a/云翔一码通/U_YMTRKList.dfm b/云翔一码通/U_YMTRKList.dfm index 72c60d6..eb9dfa6 100644 --- a/云翔一码通/U_YMTRKList.dfm +++ b/云翔一码通/U_YMTRKList.dfm @@ -1,13 +1,13 @@ object frmYMTRKList: TfrmYMTRKList - Left = 267 - Top = 100 + Left = 206 + Top = 367 Width = 1470 Height = 823 Caption = #38754#26009#22238#20179#30331#35760 Color = clBtnFace Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -15 + Font.Height = -12 Font.Name = #23435#20307 Font.Style = [] OldCreateOrder = False @@ -15,8 +15,8 @@ object frmYMTRKList: TfrmYMTRKList OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow - PixelsPerInch = 120 - TextHeight = 15 + PixelsPerInch = 96 + TextHeight = 12 object ToolBar1: TToolBar Left = 0 Top = 0 @@ -123,118 +123,118 @@ object frmYMTRKList: TfrmYMTRKList Left = 0 Top = 33 Width = 1462 - Height = 90 + Height = 72 Align = alTop BevelInner = bvRaised BevelOuter = bvLowered Color = clSkyBlue TabOrder = 1 object Label1: TLabel - Left = 35 - Top = 15 - Width = 60 - Height = 15 + Left = 28 + Top = 12 + Width = 48 + Height = 12 Caption = #26597#35810#26102#38388 end object Label2: TLabel - Left = 80 - Top = 45 - Width = 15 - Height = 15 + Left = 64 + Top = 36 + Width = 12 + Height = 12 Caption = #33267 end object Label3: TLabel - Left = 398 - Top = 15 - Width = 30 - Height = 15 + Left = 318 + Top = 12 + Width = 24 + Height = 12 Caption = #21697#21517 end object Label4: TLabel - Left = 544 - Top = 15 - Width = 45 - Height = 15 + Left = 435 + Top = 12 + Width = 36 + Height = 12 Caption = #21152#24037#21378 end object Label5: TLabel - Left = 223 - Top = 15 - Width = 60 - Height = 15 + Left = 178 + Top = 12 + Width = 48 + Height = 12 Caption = #20837#24211#21333#21495 end object Label8: TLabel - Left = 398 - Top = 45 - Width = 30 - Height = 15 + Left = 318 + Top = 36 + Width = 24 + Height = 12 Caption = #35268#26684 end object Label6: TLabel - Left = 544 - Top = 45 - Width = 46 - Height = 15 + Left = 435 + Top = 36 + Width = 36 + Height = 12 Caption = #25104' '#20998 end object Label7: TLabel - Left = 701 - Top = 45 - Width = 61 - Height = 15 + Left = 561 + Top = 36 + Width = 48 + Height = 12 Caption = #35746' '#21333' '#21495 end object Label9: TLabel - Left = 701 - Top = 15 - Width = 60 - Height = 15 + Left = 561 + Top = 12 + Width = 48 + Height = 12 Caption = #23384#25918#24037#21378 end object Label12: TLabel - Left = 223 - Top = 45 - Width = 60 - Height = 15 + Left = 178 + Top = 36 + Width = 48 + Height = 12 Caption = #20837#24211#31867#22411 end object Label11: TLabel - Left = 1029 - Top = 46 - Width = 60 - Height = 15 + Left = 823 + Top = 37 + Width = 48 + Height = 12 Caption = #26579#21378#32568#21495 end object Label13: TLabel - Left = 880 - Top = 15 - Width = 30 - Height = 15 + Left = 704 + Top = 12 + Width = 24 + Height = 12 Caption = #39068#33394 end object Label15: TLabel - Left = 880 - Top = 46 - Width = 30 - Height = 15 + Left = 704 + Top = 37 + Width = 24 + Height = 12 Caption = #33457#22411 end object BegDate: TDateTimePicker - Left = 96 - Top = 11 - Width = 109 - Height = 23 + Left = 77 + Top = 9 + Width = 87 + Height = 20 Date = 40768.458268587970000000 Time = 40768.458268587970000000 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 0 end object EndDate: TDateTimePicker - Left = 96 - Top = 40 - Width = 109 - Height = 23 + Left = 77 + Top = 32 + Width = 87 + Height = 20 Date = 40768.458268587970000000 Time = 40768.458268587970000000 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 @@ -242,9 +242,9 @@ object frmYMTRKList: TfrmYMTRKList end object SPName: TEdit Tag = 2 - Left = 431 - Top = 11 - Width = 100 + Left = 345 + Top = 9 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 2 @@ -252,9 +252,9 @@ object frmYMTRKList: TfrmYMTRKList end object FactoryName: TEdit Tag = 2 - Left = 590 - Top = 11 - Width = 100 + Left = 472 + Top = 9 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 3 @@ -262,9 +262,9 @@ object frmYMTRKList: TfrmYMTRKList end object SPID: TEdit Tag = 2 - Left = 285 - Top = 11 - Width = 100 + Left = 228 + Top = 9 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 1 @@ -272,9 +272,9 @@ object frmYMTRKList: TfrmYMTRKList end object SPSpec: TEdit Tag = 2 - Left = 431 - Top = 40 - Width = 100 + Left = 345 + Top = 32 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 9 @@ -282,9 +282,9 @@ object frmYMTRKList: TfrmYMTRKList end object SPCF: TEdit Tag = 2 - Left = 590 - Top = 40 - Width = 100 + Left = 472 + Top = 32 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 10 @@ -292,9 +292,9 @@ object frmYMTRKList: TfrmYMTRKList end object OrderNo: TEdit Tag = 2 - Left = 765 - Top = 41 - Width = 100 + Left = 612 + Top = 33 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 11 @@ -302,9 +302,9 @@ object frmYMTRKList: TfrmYMTRKList end object ToFactoryName: TEdit Tag = 2 - Left = 765 - Top = 11 - Width = 100 + Left = 612 + Top = 9 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 4 @@ -312,13 +312,13 @@ object frmYMTRKList: TfrmYMTRKList end object CRType: TComboBox Tag = 2 - Left = 285 - Top = 40 - Width = 100 - Height = 23 + Left = 228 + Top = 32 + Width = 80 + Height = 20 Style = csDropDownList ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 - ItemHeight = 15 + ItemHeight = 12 TabOrder = 8 OnChange = TBFindClick Items.Strings = ( @@ -333,9 +333,9 @@ object frmYMTRKList: TfrmYMTRKList end object RCGangNo: TEdit Tag = 2 - Left = 1093 - Top = 43 - Width = 100 + Left = 874 + Top = 34 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 12 @@ -343,9 +343,9 @@ object frmYMTRKList: TfrmYMTRKList end object SPColor: TEdit Tag = 2 - Left = 911 - Top = 11 - Width = 100 + Left = 729 + Top = 9 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 5 @@ -353,9 +353,9 @@ object frmYMTRKList: TfrmYMTRKList end object SPHX: TEdit Tag = 2 - Left = 911 - Top = 43 - Width = 100 + Left = 729 + Top = 34 + Width = 80 Height = 20 ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 TabOrder = 6 @@ -364,9 +364,9 @@ object frmYMTRKList: TfrmYMTRKList end object cxGrid2: TcxGrid Left = 0 - Top = 123 - Width = 1107 - Height = 663 + Top = 105 + Width = 1178 + Height = 687 Align = alClient TabOrder = 2 object Tv1: TcxGridDBTableView @@ -660,21 +660,22 @@ object frmYMTRKList: TfrmYMTRKList end end object Panel2: TPanel - Left = 1107 - Top = 123 - Width = 355 - Height = 663 + Left = 1178 + Top = 105 + Width = 284 + Height = 687 Align = alRight Caption = 'Panel2' TabOrder = 3 object cxGrid1: TcxGrid Left = 1 - Top = 82 - Width = 353 - Height = 580 + Top = 71 + Width = 282 + Height = 615 Align = alClient TabOrder = 0 object TvMX: TcxGridDBTableView + PopupMenu = pm1 Navigator.Buttons.CustomButtons = <> Navigator.Buttons.Delete.Enabled = False Navigator.Buttons.Delete.Visible = False @@ -728,6 +729,7 @@ object frmYMTRKList: TfrmYMTRKList Caption = #32534#21495 DataBinding.FieldName = 'MXID' HeaderAlignmentHorz = taCenter + Options.Editing = False Width = 80 end object TvMXMXQty: TcxGridDBColumn @@ -735,15 +737,15 @@ object frmYMTRKList: TfrmYMTRKList DataBinding.FieldName = 'MQty' PropertiesClassName = 'TcxTextEditProperties' HeaderAlignmentHorz = taCenter - Options.Editing = False Options.Sorting = False - Width = 80 + Width = 63 end object TvMXColumn1: TcxGridDBColumn Caption = #37325#37327 DataBinding.FieldName = 'KgQty' HeaderAlignmentHorz = taCenter - Width = 80 + Options.Editing = False + Width = 63 end end object cxGridLevel2: TcxGridLevel @@ -752,16 +754,17 @@ object frmYMTRKList: TfrmYMTRKList end object ToolBar2: TToolBar Left = 1 - Top = 53 - Width = 353 + Top = 42 + Width = 282 Height = 29 ButtonHeight = 30 - ButtonWidth = 80 + ButtonWidth = 71 Caption = 'ToolBar2' Images = DataLink_YXYMT.ThreeImgList List = True ShowCaptions = True TabOrder = 1 + Visible = False object TbAddRow: TToolButton Left = 0 Top = 2 @@ -771,7 +774,7 @@ object frmYMTRKList: TfrmYMTRKList OnClick = TbAddRowClick end object TbDeleteRow: TToolButton - Left = 84 + Left = 75 Top = 2 AutoSize = True Caption = #21024#34892 @@ -782,30 +785,31 @@ object frmYMTRKList: TfrmYMTRKList object Panel3: TPanel Left = 1 Top = 1 - Width = 353 - Height = 52 + Width = 282 + Height = 41 Align = alTop TabOrder = 2 + Visible = False object Label17: TLabel - Left = 8 - Top = 15 - Width = 45 - Height = 15 + Left = 6 + Top = 12 + Width = 36 + Height = 12 Caption = #22686#34892#25968 Layout = tlCenter end object AddNum: TEdit - Left = 59 - Top = 13 - Width = 51 + Left = 47 + Top = 10 + Width = 41 Height = 20 TabOrder = 0 end object Button1: TButton - Left = 123 - Top = 5 - Width = 93 - Height = 38 + Left = 98 + Top = 4 + Width = 75 + Height = 30 Caption = #24555#36895#22686#34892 TabOrder = 1 OnClick = Button1Click @@ -813,41 +817,41 @@ object frmYMTRKList: TfrmYMTRKList end end object Panel4: TPanel - Left = 684 - Top = 175 - Width = 293 - Height = 156 + Left = 547 + Top = 140 + Width = 235 + Height = 125 Color = clSkyBlue TabOrder = 4 Visible = False object Label25: TLabel - Left = 48 - Top = 43 - Width = 30 - Height = 15 + Left = 38 + Top = 34 + Width = 24 + Height = 12 Caption = #24211#20301 end object btnChk: TButton - Left = 35 - Top = 101 - Width = 75 - Height = 32 + Left = 28 + Top = 81 + Width = 60 + Height = 25 Caption = #30830#35748 TabOrder = 0 OnClick = btnChkClick end object btn1: TButton - Left = 200 - Top = 100 - Width = 75 - Height = 31 + Left = 160 + Top = 80 + Width = 60 + Height = 25 Caption = #20851#38381 TabOrder = 1 OnClick = btn1Click end object KuWei: TcxButtonEdit - Left = 94 - Top = 34 + Left = 75 + Top = 27 ParentFont = False Properties.Buttons = < item @@ -857,12 +861,69 @@ object frmYMTRKList: TfrmYMTRKList Properties.OnButtonClick = KuWeiPropertiesButtonClick Style.Font.Charset = GB2312_CHARSET Style.Font.Color = clWindowText - Style.Font.Height = -23 + Style.Font.Height = -19 Style.Font.Name = #23435#20307 Style.Font.Style = [fsBold] Style.IsFontAssigned = True TabOrder = 2 - Width = 151 + Width = 121 + end + end + object Panel5: TPanel + Left = 1203 + Top = 300 + Width = 235 + Height = 141 + Color = clSkyBlue + TabOrder = 5 + Visible = False + object Label10: TLabel + Left = 38 + Top = 18 + Width = 24 + Height = 12 + Caption = #25968#37327 + end + object Label14: TLabel + Left = 38 + Top = 58 + Width = 24 + Height = 12 + Caption = #37325#37327 + end + object Sure: TButton + Left = 28 + Top = 97 + Width = 60 + Height = 25 + Caption = #30830#35748 + TabOrder = 0 + OnClick = SureClick + end + object Quit: TButton + Left = 160 + Top = 96 + Width = 60 + Height = 25 + Caption = #20851#38381 + TabOrder = 1 + OnClick = QuitClick + end + object MQty: TEdit + Left = 72 + Top = 14 + Width = 121 + Height = 20 + TabOrder = 2 + Text = '0' + end + object KgQty: TEdit + Left = 72 + Top = 54 + Width = 121 + Height = 20 + TabOrder = 3 + Text = '0' end end object ADOQueryCmd: TADOQuery @@ -995,4 +1056,29 @@ object frmYMTRKList: TfrmYMTRKList Left = 832 Top = 316 end + object pm1: TPopupMenu + Left = 676 + Top = 442 + object MenuItem1: TMenuItem + Caption = #25286#25209 + OnClick = MenuItem1Click + end + end + object http: TIdHTTP + MaxLineAction = maException + ReadTimeout = 0 + AllowCookies = True + ProxyParams.BasicAuthentication = False + ProxyParams.ProxyPort = 0 + Request.ContentLength = -1 + Request.ContentRangeEnd = 0 + Request.ContentRangeStart = 0 + Request.ContentType = 'text/html' + Request.Accept = 'text/html, */*' + Request.BasicAuthentication = False + Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)' + HTTPOptions = [hoForceEncodeParams] + Left = 532 + Top = 320 + end end diff --git a/云翔一码通/U_YMTRKList.pas b/云翔一码通/U_YMTRKList.pas index 3113261..bde58ce 100644 --- a/云翔一码通/U_YMTRKList.pas +++ b/云翔一码通/U_YMTRKList.pas @@ -25,7 +25,7 @@ uses dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, dxSkinscxPCPainter, cxNavigator, cxCurrencyEdit, - cxMaskEdit; + cxMaskEdit, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP; type TfrmYMTRKList = class(TForm) @@ -135,6 +135,16 @@ type Tv1Column3: TcxGridDBColumn; TvMXColumn1: TcxGridDBColumn; Tv1Column4: TcxGridDBColumn; + pm1: TPopupMenu; + MenuItem1: TMenuItem; + Panel5: TPanel; + Label10: TLabel; + Sure: TButton; + Quit: TButton; + Label14: TLabel; + MQty: TEdit; + KgQty: TEdit; + http: TIdHTTP; procedure FormDestroy(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); @@ -163,11 +173,16 @@ type procedure KuWeiPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure btnChkClick(Sender: TObject); procedure btn1Click(Sender: TObject); + procedure MenuItem1Click(Sender: TObject); + procedure SureClick(Sender: TObject); + procedure QuitClick(Sender: TObject); private canshu1, canshu2: string; procedure InitGrid(); procedure InitImage(fsubID: string); procedure InitMXGrid(SPID: string); + function BatchStockIn(MXIDs: string; UserID: string): Boolean; + { Private declarations } public { Public declarations } @@ -179,10 +194,84 @@ var implementation uses - U_DataLink, U_RTFun, U_YMTRKInPut, U_ZdyAttachGYS, U_LabelPrintFun, - U_ZDYHelp, U_KuWeiList; + U_DataLink, U_RTFun, U_YMTRKInPut, U_ZdyAttachGYS, U_LabelPrintFun, U_ZDYHelp, + U_KuWeiList, superobject; {$R *.dfm} +function TfrmYMTRKList.BatchStockIn(MXIDs: string; UserID: string): Boolean; +var + IdHttp: TIdHTTP; + Url, ResponseStr: string; + ResponseStream: TStringStream; + vJson1: ISuperObject; +begin + Result := False; + +// ֤ + if Trim(MXIDs) = '' then + begin + ShowMessage('MXIDΪ'); + Exit; + end; + + if Trim(UserID) = '' then + begin + ShowMessage('ûIDΪ'); + Exit; + end; + + IdHttp := TIdHTTP.Create(nil); + ResponseStream := TStringStream.Create(''); + try + try + // GET - ҪContentType + // ֱӷURL + // ӿURLURLУ + Url := 'http://www.rightsoft.top/YunXiang/api/YMTCK/batchStockIn?' + 'MXID=' + Trim(MXIDs) + '&userid=' + Trim(UserID); +// ShowMessage(Url); + // GET + IdHttp.Get(Url, ResponseStream); + + // ȡӦ + ResponseStr := ResponseStream.DataString; + + // JSONӦ + vJson1 := SO(ResponseStr); +// ShowMessage(ResponseStr); + if (vJson1.O['code'] <> nil) then + begin + if (vJson1.O['code'].AsInteger = 10000) then + begin + Result := True; + ShowMessage('ɹ'); + end + else + begin + // ȡϢ + if vJson1.O['message'] <> nil then + ShowMessage('ʧ: ' + vJson1.O['message'].AsString) + else + ShowMessage('ʧܣδ֪'); + end; + end + else + begin + ShowMessage('ӿڷظʽ'); + end; + + except + on e: Exception do + begin + ShowMessage('쳣: ' + e.Message); + end; + end; + + finally + IdHttp.Free; + ResponseStream.Free; + end; +end; + procedure TfrmYMTRKList.InitMXGrid(SPID: string); begin with ADOQueryTemp do @@ -349,6 +438,7 @@ begin Application.MessageBox('г¼ɾ!', 'ʾ', 0); Exit; end; + if Application.MessageBox('ȷҪɾ', 'ʾ', 32 + 4) <> IDYES then Exit; try @@ -392,41 +482,126 @@ begin end; end; +//procedure TfrmYMTRKList.TBEditClick(Sender: TObject); +//var +// OldSPID: string; // ڱ浱ǰеSPID +//begin +// if CDS_Main.IsEmpty then +// Exit; +// +// if Trim(CDS_Main.fieldbyname('CRType').AsString) = 'ƽ' then +// begin +// Application.MessageBox('ƽΪԶɣ޸!', 'ʾ', 0); +// Exit; +// end; +// try +// OldSPID := Trim(CDS_Main.fieldbyname('SPID').AsString); +// frmYMTRKInPut := TfrmYMTRKInPut.Create(Application); +// with frmYMTRKInPut do +// begin +// PState := 1; +// FBCId := OldSPID; +// TBDel.Visible := False; +// TBAdd.Visible := False; +// if ShowModal = 1 then +// begin +// +// end; +// end; +// InitGrid(); +// // ¶λԭ +// if not CDS_Main.Locate('SPID', OldSPID, []) then +// begin +// // Ҳԭ¼类ɾλһ¼ +// if not CDS_Main.IsEmpty then +// CDS_Main.First; +// end; +// finally +// frmYMTRKInPut.Free; +// end; +//end; + procedure TfrmYMTRKList.TBEditClick(Sender: TObject); var OldSPID: string; // ڱ浱ǰеSPID + SelectedSPIDs: TStringList; // ڱѡеSPID begin if CDS_Main.IsEmpty then Exit; - if Trim(CDS_Main.fieldbyname('CRType').AsString) = 'ƽ' then - begin - Application.MessageBox('ƽΪԶɣ޸!', 'ʾ', 0); - Exit; - end; + + // ַбѡеSPID + SelectedSPIDs := TStringList.Create; try - OldSPID := Trim(CDS_Main.fieldbyname('SPID').AsString); - frmYMTRKInPut := TfrmYMTRKInPut.Create(Application); - with frmYMTRKInPut do + // Ƿѡе + if CDS_Main.Locate('SSel', True, []) = True then begin - PState := 1; - FBCId := OldSPID; - TBDel.Visible := False; - TBAdd.Visible := False; - if ShowModal = 1 then - begin - - end; - end; - InitGrid(); - // ¶λԭ - if not CDS_Main.Locate('SPID', OldSPID, []) then - begin - // Ҳԭ¼类ɾλһ¼ - if not CDS_Main.IsEmpty then + // ݼռѡеSPID + CDS_Main.DisableControls; + try CDS_Main.First; + while not CDS_Main.Eof do + begin + if CDS_Main.FieldByName('SSel').AsBoolean then + begin + // ǷΪƽ + if Trim(CDS_Main.FieldByName('CRType').AsString) = 'ƽ' then + begin + Application.MessageBox('ƽΪԶɣ޸!', 'ʾ', 0); + Exit; // ֱExitҪֶͷSelectedSPIDsfinallyᴦ + end; + SelectedSPIDs.Add(Trim(CDS_Main.FieldByName('SPID').AsString)); + end; + CDS_Main.Next; + end; + finally + CDS_Main.EnableControls; + end; + end + else + begin + // ûйѡκУֻǰ + // 鵱ǰǷΪƽ + if Trim(CDS_Main.FieldByName('CRType').AsString) = 'ƽ' then + begin + Application.MessageBox('ƽΪԶɣ޸!', 'ʾ', 0); + Exit; + end; + SelectedSPIDs.Add(Trim(CDS_Main.FieldByName('SPID').AsString)); + end; + + // 浱ǰеSPIDںλ + OldSPID := Trim(CDS_Main.FieldByName('SPID').AsString); + + try + frmYMTRKInPut := TfrmYMTRKInPut.Create(Application); + with frmYMTRKInPut do + begin + PState := 1; + FBCId := OldSPID; // ԭеSPIDļ + // ѡеSPID + + FSelectedSPIDs.Assign(SelectedSPIDs); + + TBDel.Visible := False; + TBAdd.Visible := False; + if ShowModal = 1 then + begin + // ؽ + end; + end; + InitGrid(); + // ¶λԭ + if not CDS_Main.Locate('SPID', OldSPID, []) then + begin + // Ҳԭ¼类ɾλһ¼ + if not CDS_Main.IsEmpty then + CDS_Main.First; + end; + finally + frmYMTRKInPut.Free; end; finally - frmYMTRKInPut.Free; + SelectedSPIDs.Free; end; end; @@ -511,13 +686,6 @@ procedure TfrmYMTRKList.TbAddRowClick(Sender: TObject); var MaxNo, MMXID, SPID: string; begin -// with CDS_MX do -// begin -// Append; -// FieldByName('MXID').Value := ''; -// FieldByName('MXQty').Value := 0; -// Post; -// end; if GetLSNo(ADOQueryTemp, MaxNo, 'MCM', 'YMT_CK_MX', 3, 1) = False then begin Application.MessageBox('ȡʧ!', 'ʾ', 0); @@ -627,7 +795,7 @@ begin with Self.CDS_Main do begin Edit; - FieldByName('KuWei').Value := Trim(frmKuWeiList.Order_Main.fieldbyname('KWName').AsString); + KuWei.Text := Trim(frmKuWeiList.Order_Main.fieldbyname('KWName').AsString); end; end; end; @@ -678,5 +846,102 @@ begin Panel4.Visible := False; end; +procedure TfrmYMTRKList.MenuItem1Click(Sender: TObject); +begin + if CDS_MX.IsEmpty then + exit; + Panel5.Visible := True; + +end; + +//ִв +procedure TfrmYMTRKList.SureClick(Sender: TObject); +var + MaxNo, MMXID, SPID, MXIDs: string; + fMQty, fKGQty: Double; +begin + // ʼ + ADOQueryCmd.Connection.BeginTrans; + + try + // ֵ֤ + try + fMQty := StrToFloat(Trim(MQty.Text)); + fKGQty := StrToFloat(Trim(KGQty.Text)); + except + Application.MessageBox('Чֵ', 'ʾ', 0); + ADOQueryCmd.Connection.RollbackTrans; // ع + Exit; + end; + + if GetLSNo(ADOQueryTemp, MaxNo, 'MCM', 'YMT_CK_MX', 3, 1) = False then + begin + Application.MessageBox('ȡʧ!', 'ʾ', 0); + ADOQueryCmd.Connection.RollbackTrans; // ع + Exit; + end; + + MMXID := Trim(MaxNo); + SPID := Trim(CDS_Main.fieldbyname('SPID').AsString); + + // Ӳ + with ADOQueryCmd do + begin + Close; + SQL.Clear; + sql.Add('insert into YMT_CK_MX (MXID,SPID,MQty,KGQty,Filler)'); + sql.Add('values(' + quotedstr(MMXID)); + sql.Add(',' + quotedstr(Trim(SPID))); + sql.Add(',' + FloatToStr(fMQty)); // ʹֵ + sql.Add(',' + FloatToStr(fKGQty)); // ʹֵ + sql.Add(',' + quotedstr(Trim(DName))); + sql.Add(')'); + ExecSQL; + end; + + // µǰ + with ADOQueryCmd do + begin + close; + sql.Clear; + sql.Add('update YMT_CK_MX SET MQty = ' + FloatToStr(CDS_MX.FieldByName('MQty').AsFloat - fMQty)); + sql.Add(', KGQty = ' + FloatToStr(CDS_MX.FieldByName('KGQty').AsFloat - fKGQty)); + sql.Add('where MXID=' + quotedstr(trim(CDS_MX.fieldbyname('MXID').AsString))); + execsql; + end; + MXIDs := MMXID + ',' + trim(CDS_MX.fieldbyname('MXID').AsString); + + // ύ - вɹ + ADOQueryCmd.Connection.CommitTrans; + + // ýӿڣ + if MXIDs <> '' then + begin + if not BatchStockIn(MXIDs, Trim(DCode)) then + begin + Application.MessageBox('ӿڵʧ!', 'ʾ', 0); + Exit; + end; + end; + + InitMXGrid(SPID); + Panel5.Visible := False; + application.MessageBox('ɹ', 'ʾϢ'); + + except + on E: Exception do + begin + // ع - κ쳣ع + ADOQueryCmd.Connection.RollbackTrans; + Application.MessageBox(PChar('ʧܣ' + E.Message), 'ʾϢ', 0); + end; + end; +end; + +procedure TfrmYMTRKList.QuitClick(Sender: TObject); +begin + Panel5.Visible := False; +end; + end. diff --git a/云翔一码通/U_YMTStockList.dfm b/云翔一码通/U_YMTStockList.dfm new file mode 100644 index 0000000..4454b3a --- /dev/null +++ b/云翔一码通/U_YMTStockList.dfm @@ -0,0 +1,799 @@ +object frmStockList: TfrmStockList + Left = -1 + Top = 580 + Width = 1470 + Height = 823 + Caption = #24211#23384#26597#35810 + Color = clBtnFace + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = #23435#20307 + Font.Style = [] + OldCreateOrder = False + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 12 + object ToolBar1: TToolBar + Left = 0 + Top = 0 + Width = 1462 + Height = 33 + ButtonHeight = 30 + ButtonWidth = 107 + Caption = 'ToolBar1' + Color = clSkyBlue + Flat = True + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = #23435#20307 + Font.Style = [] + Images = DataLink_YXYMT.ThreeImgList + List = True + ParentColor = False + ParentFont = False + ShowCaptions = True + TabOrder = 0 + object TBRafresh: TToolButton + Left = 0 + Top = 0 + AutoSize = True + Caption = #21047#26032 + ImageIndex = 0 + OnClick = TBRafreshClick + end + object TBFind: TToolButton + Left = 63 + Top = 0 + AutoSize = True + Caption = #36807#28388 + ImageIndex = 20 + OnClick = TBFindClick + end + object TbEditKW: TToolButton + Left = 126 + Top = 0 + AutoSize = True + Caption = #25209#37327#20462#25913#24211#20301 + ImageIndex = 11 + OnClick = TbEditKWClick + end + object TBExport: TToolButton + Left = 237 + Top = 0 + AutoSize = True + Caption = #23548#20986 + ImageIndex = 68 + OnClick = TBExportClick + end + object TBClose: TToolButton + Left = 300 + Top = 0 + AutoSize = True + Caption = #20851#38381 + ImageIndex = 21 + OnClick = TBCloseClick + end + end + object Panel1: TPanel + Left = 0 + Top = 33 + Width = 1462 + Height = 72 + Align = alTop + BevelInner = bvRaised + BevelOuter = bvLowered + Color = clSkyBlue + TabOrder = 1 + object Label1: TLabel + Left = 28 + Top = 12 + Width = 48 + Height = 12 + Caption = #26597#35810#26102#38388 + end + object Label2: TLabel + Left = 64 + Top = 36 + Width = 12 + Height = 12 + Caption = #33267 + end + object Label3: TLabel + Left = 318 + Top = 12 + Width = 24 + Height = 12 + Caption = #21697#21517 + end + object Label4: TLabel + Left = 435 + Top = 12 + Width = 36 + Height = 12 + Caption = #21152#24037#21378 + end + object Label5: TLabel + Left = 178 + Top = 12 + Width = 48 + Height = 12 + Caption = #20837#24211#21333#21495 + end + object Label8: TLabel + Left = 318 + Top = 36 + Width = 24 + Height = 12 + Caption = #35268#26684 + end + object Label6: TLabel + Left = 435 + Top = 36 + Width = 36 + Height = 12 + Caption = #25104' '#20998 + end + object Label7: TLabel + Left = 561 + Top = 36 + Width = 48 + Height = 12 + Caption = #35746' '#21333' '#21495 + end + object Label9: TLabel + Left = 561 + Top = 12 + Width = 48 + Height = 12 + Caption = #23384#25918#24037#21378 + end + object Label12: TLabel + Left = 178 + Top = 36 + Width = 48 + Height = 12 + Caption = #20837#24211#31867#22411 + end + object Label11: TLabel + Left = 823 + Top = 37 + Width = 48 + Height = 12 + Caption = #26579#21378#32568#21495 + end + object Label13: TLabel + Left = 704 + Top = 12 + Width = 24 + Height = 12 + Caption = #39068#33394 + end + object Label15: TLabel + Left = 704 + Top = 37 + Width = 24 + Height = 12 + Caption = #33457#22411 + end + object BegDate: TDateTimePicker + Left = 77 + Top = 9 + Width = 87 + Height = 20 + Date = 40768.458268587970000000 + Time = 40768.458268587970000000 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 0 + end + object EndDate: TDateTimePicker + Left = 77 + Top = 32 + Width = 87 + Height = 20 + Date = 40768.458268587970000000 + Time = 40768.458268587970000000 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 7 + end + object SPName: TEdit + Tag = 2 + Left = 345 + Top = 9 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 2 + OnChange = TBFindClick + end + object FactoryName: TEdit + Tag = 2 + Left = 472 + Top = 9 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 3 + OnChange = FactoryNameChange + end + object SPID: TEdit + Tag = 2 + Left = 228 + Top = 9 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 1 + OnChange = SPIDChange + end + object SPSpec: TEdit + Tag = 2 + Left = 345 + Top = 32 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 9 + OnChange = SPSpecChange + end + object SPCF: TEdit + Tag = 2 + Left = 472 + Top = 32 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 10 + OnChange = FactoryNameChange + end + object OrderNo: TEdit + Tag = 2 + Left = 612 + Top = 33 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 11 + OnChange = FactoryNameChange + end + object ToFactoryName: TEdit + Tag = 2 + Left = 612 + Top = 9 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 4 + OnChange = FactoryNameChange + end + object CRType: TComboBox + Tag = 2 + Left = 228 + Top = 32 + Width = 80 + Height = 20 + Style = csDropDownList + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ItemHeight = 12 + TabOrder = 8 + OnChange = TBFindClick + Items.Strings = ( + '' + #21152#24037#23436#25104 + #22238#20462#23436#25104 + #26816#39564#36864#22238 + #26399#21021#20837#24211 + #23458#25143#36864#36135 + #37319#36141#20837#24211 + #27425#21697#20837#24211) + end + object RCGangNo: TEdit + Tag = 2 + Left = 874 + Top = 34 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 12 + OnChange = FactoryNameChange + end + object SPColor: TEdit + Tag = 2 + Left = 729 + Top = 9 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 5 + OnChange = FactoryNameChange + end + object SPHX: TEdit + Tag = 2 + Left = 729 + Top = 34 + Width = 80 + Height = 20 + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + TabOrder = 6 + OnChange = FactoryNameChange + end + end + object cxGrid2: TcxGrid + Left = 0 + Top = 105 + Width = 1462 + Height = 687 + Align = alClient + TabOrder = 2 + object Tv1: TcxGridDBTableView + Navigator.Buttons.CustomButtons = <> + DataController.DataSource = DataSource1 + DataController.Summary.DefaultGroupSummaryItems = <> + DataController.Summary.FooterSummaryItems = < + item + Kind = skCount + end + item + Kind = skSum + end + item + Kind = skSum + Column = v2Column6 + end + item + Kind = skSum + end + item + Format = '#,###' + Kind = skSum + end + item + Format = '#,###' + Kind = skSum + end + item + Format = '#,###' + Kind = skSum + end + item + Kind = skSum + Column = Tv1Column4 + end> + DataController.Summary.SummaryGroups = <> + OptionsCustomize.ColumnFiltering = False + OptionsView.Footer = True + OptionsView.GroupByBox = False + OptionsView.Indicator = True + Styles.Inactive = DataLink_YXYMT.SHuangSe + Styles.IncSearch = DataLink_YXYMT.SHuangSe + Styles.Selection = DataLink_YXYMT.SHuangSe + Styles.Header = DataLink_YXYMT.Default + object Tv1SSel: TcxGridDBColumn + Caption = #36873#25321 + DataBinding.FieldName = 'SSel' + PropertiesClassName = 'TcxCheckBoxProperties' + HeaderAlignmentHorz = taCenter + Width = 47 + end + object v1Column6: TcxGridDBColumn + Caption = #20837#24211#21333#21495 + DataBinding.FieldName = 'SPID' + Visible = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 83 + end + object Tv1Column5: TcxGridDBColumn + Caption = #32534#21495 + DataBinding.FieldName = 'FromMXID' + HeaderAlignmentHorz = taCenter + Options.Editing = False + end + object v1Column2: TcxGridDBColumn + Tag = 2 + Caption = #20837#24211#26102#38388 + DataBinding.FieldName = 'CRTime' + PropertiesClassName = 'TcxDateEditProperties' + Properties.SaveTime = False + Properties.ShowTime = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 100 + end + object v1Column4: TcxGridDBColumn + Tag = 2 + Caption = #20837#24211#31867#22411 + DataBinding.FieldName = 'CRType' + PropertiesClassName = 'TcxComboBoxProperties' + Properties.DropDownListStyle = lsFixedList + Properties.Items.Strings = ( + #21152#24037#23436#25104 + #29983#20135#36864#22238) + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 83 + end + object v1Column13: TcxGridDBColumn + Caption = #35746#21333#21495 + DataBinding.FieldName = 'OrderNo' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + Visible = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 102 + end + object Tv1Column3: TcxGridDBColumn + Caption = #23458#25143 + DataBinding.FieldName = 'CustomerNoName' + HeaderAlignmentHorz = taCenter + Width = 80 + end + object v1Column14: TcxGridDBColumn + Tag = 2 + Caption = #20379#24212#21830 + DataBinding.FieldName = 'FactoryName' + PropertiesClassName = 'TcxTextEditProperties' + Properties.ReadOnly = True + HeaderAlignmentHorz = taCenter + Width = 101 + end + object v2Column1: TcxGridDBColumn + Tag = 2 + Caption = #21697#21517 + DataBinding.FieldName = 'SPName' + PropertiesClassName = 'TcxTextEditProperties' + Properties.ReadOnly = True + HeaderAlignmentHorz = taCenter + Width = 97 + end + object v1Column21: TcxGridDBColumn + Tag = 2 + Caption = #20135#21697#32534#21495 + DataBinding.FieldName = 'spcode' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object v1Column8: TcxGridDBColumn + Tag = 2 + Caption = #35268#26684 + DataBinding.FieldName = 'SPSpec' + HeaderAlignmentHorz = taCenter + HeaderGlyphAlignmentHorz = taCenter + Options.Editing = False + Width = 65 + end + object v1Column7: TcxGridDBColumn + Tag = 2 + Caption = #25104#20998 + DataBinding.FieldName = 'SPCF' + HeaderAlignmentHorz = taCenter + HeaderGlyphAlignmentHorz = taCenter + Options.Editing = False + Width = 73 + end + object v1Column1: TcxGridDBColumn + Tag = 2 + Caption = #38376#24133 + DataBinding.FieldName = 'SPMF' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 73 + end + object v1Column10: TcxGridDBColumn + Tag = 2 + Caption = #20811#37325 + DataBinding.FieldName = 'SPKZ' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 90 + end + object v1Column15: TcxGridDBColumn + Caption = #39068#33394 + DataBinding.FieldName = 'SPColor' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 69 + end + object v1Column17: TcxGridDBColumn + Caption = #33457#22411#33457#21495 + DataBinding.FieldName = 'SPHX' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object v1Column11: TcxGridDBColumn + Tag = 2 + Caption = #23384#25918#24037#21378 + DataBinding.FieldName = 'ToFactoryName' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 84 + end + object v1Column18: TcxGridDBColumn + Caption = #24211#20301 + DataBinding.FieldName = 'KuWei' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 86 + end + object v1Column19: TcxGridDBColumn + Caption = #32568#21495 + DataBinding.FieldName = 'RCGangNo' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 75 + end + object Tv1Column2: TcxGridDBColumn + Caption = #24037#33402 + DataBinding.FieldName = 'GYLXName' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 55 + end + object v2Column6: TcxGridDBColumn + Tag = 2 + Caption = #25968#37327 + DataBinding.FieldName = 'MQty' + PropertiesClassName = 'TcxTextEditProperties' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 62 + end + object Tv1Column4: TcxGridDBColumn + Caption = #37325#37327 + DataBinding.FieldName = 'KgQty' + HeaderAlignmentHorz = taCenter + Width = 80 + end + object v1Column3: TcxGridDBColumn + Tag = 2 + Caption = #25968#37327#21333#20301 + DataBinding.FieldName = 'QtyUnit' + PropertiesClassName = 'TcxComboBoxProperties' + Properties.DropDownListStyle = lsFixedList + Properties.Items.Strings = ( + 'Kg' + 'M' + 'Y') + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 66 + end + object Tv1Column1: TcxGridDBColumn + Caption = #21333#20215 + DataBinding.FieldName = 'Price' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 55 + end + object v1Column16: TcxGridDBColumn + Tag = 2 + Caption = #26469#33258#24037#21378 + DataBinding.FieldName = 'FromFactoryName' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + Visible = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + VisibleForCustomization = False + Width = 79 + end + object v1Column12: TcxGridDBColumn + Tag = 2 + Caption = #22791#27880 + DataBinding.FieldName = 'Note' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 79 + end + end + object cxGrid2Level1: TcxGridLevel + GridView = Tv1 + end + end + object Panel4: TPanel + Left = 547 + Top = 140 + Width = 235 + Height = 125 + Color = clSkyBlue + TabOrder = 3 + Visible = False + object Label25: TLabel + Left = 38 + Top = 34 + Width = 24 + Height = 12 + Caption = #24211#20301 + end + object btnChk: TButton + Left = 28 + Top = 81 + Width = 60 + Height = 25 + Caption = #30830#35748 + TabOrder = 0 + OnClick = btnChkClick + end + object btn1: TButton + Left = 160 + Top = 80 + Width = 60 + Height = 25 + Caption = #20851#38381 + TabOrder = 1 + OnClick = btn1Click + end + object KuWei: TcxButtonEdit + Left = 75 + Top = 27 + ParentFont = False + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.OnButtonClick = KuWeiPropertiesButtonClick + Style.Font.Charset = GB2312_CHARSET + Style.Font.Color = clWindowText + Style.Font.Height = -19 + Style.Font.Name = #23435#20307 + Style.Font.Style = [fsBold] + Style.IsFontAssigned = True + TabOrder = 2 + Width = 121 + end + end + object ADOQueryCmd: TADOQuery + Connection = DataLink_YXYMT.ADOLink + Parameters = <> + Left = 504 + Top = 254 + end + object ADOQueryMain: TADOQuery + Connection = DataLink_YXYMT.ADOLink + LockType = ltReadOnly + Parameters = <> + Left = 668 + Top = 254 + end + object ADOQueryTemp: TADOQuery + Connection = DataLink_YXYMT.ADOLink + LockType = ltReadOnly + Parameters = <> + Left = 750 + Top = 254 + end + object DataSource1: TDataSource + DataSet = CDS_Main + Left = 504 + Top = 378 + end + object cxGridPopupMenu1: TcxGridPopupMenu + Grid = cxGrid2 + PopupMenus = <> + Left = 750 + Top = 316 + end + object CDS_Main: TClientDataSet + Aggregates = <> + Params = <> + Left = 504 + Top = 316 + end + object RM1: TRMGridReport + ThreadPrepareReport = True + InitialZoom = pzDefault + PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator] + DefaultCollate = False + SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\' + PreviewOptions.RulerUnit = rmutScreenPixels + PreviewOptions.RulerVisible = False + PreviewOptions.DrawBorder = False + PreviewOptions.BorderPen.Color = clGray + PreviewOptions.BorderPen.Style = psDash + Dataset = RMDBMain + CompressLevel = rmzcFastest + CompressThread = False + LaterBuildEvents = True + OnlyOwnerDataSet = False + Left = 504 + Top = 440 + ReportData = {} + end + object RMDBMain: TRMDBDataSet + Visible = True + DataSet = CDS_PRT + Left = 832 + Top = 378 + end + object RMXLSExport1: TRMXLSExport + ShowAfterExport = True + ExportPrecision = 1 + PagesOfSheet = 100 + ExportImages = True + ExportFrames = True + ExportImageFormat = ifBMP + JPEGQuality = 0 + ScaleX = 1.000000000000000000 + ScaleY = 1.000000000000000000 + CompressFile = False + Left = 586 + Top = 440 + end + object RMDBHZ: TRMDBDataSet + Visible = True + DataSet = CDS_HZ + Left = 750 + Top = 378 + end + object CDS_HZ: TClientDataSet + Aggregates = <> + Params = <> + Left = 832 + Top = 254 + end + object CDS_PRT: TClientDataSet + Aggregates = <> + Params = <> + Left = 668 + Top = 316 + end + object PopupMenu1: TPopupMenu + Left = 668 + Top = 378 + object N1: TMenuItem + Caption = #20840#36873 + OnClick = N1Click + end + object N2: TMenuItem + Caption = #20840#24323 + OnClick = N2Click + end + end + object ADOQueryImage: TADOQuery + Connection = DataLink_YXYMT.ADOLink + Parameters = <> + Left = 586 + Top = 254 + end + object CDS_MX: TClientDataSet + Aggregates = <> + Params = <> + Left = 586 + Top = 316 + end + object DS_MX: TDataSource + DataSet = CDS_MX + Left = 586 + Top = 378 + end + object cxGridPopupMenu2: TcxGridPopupMenu + PopupMenus = <> + Left = 832 + Top = 316 + end +end diff --git a/云翔一码通/U_YMTStockList.pas b/云翔一码通/U_YMTStockList.pas new file mode 100644 index 0000000..c7a3fe1 --- /dev/null +++ b/云翔一码通/U_YMTStockList.pas @@ -0,0 +1,345 @@ +unit U_YMTStockList; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, + cxEdit, DB, cxDBData, cxGridCustomTableView, cxGridTableView, + cxGridBandedTableView, cxGridDBBandedTableView, cxGridLevel, cxClasses, + cxControls, cxGridCustomView, cxGridDBTableView, cxGrid, StdCtrls, ComCtrls, + ExtCtrls, ToolWin, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB, DBClient, + cxDropDownEdit, cxCheckBox, RM_Common, RM_Class, RM_e_Xls, RM_Dataset, + RM_System, RM_GridReport, Menus, cxCalendar, cxButtonEdit, cxTextEdit, + cxContainer, cxImage, cxDBEdit, cxLookAndFeels, cxLookAndFeelPainters, + dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, + dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle, + dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, + dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, + dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins, + dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green, + dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black, + dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, + dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, + dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, + dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld, + dxSkinsDefaultPainters, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, + dxSkinXmas2008Blue, dxSkinscxPCPainter, cxNavigator, cxCurrencyEdit, + cxMaskEdit; + +type + TfrmStockList = class(TForm) + ToolBar1: TToolBar; + TBRafresh: TToolButton; + TBFind: TToolButton; + TBExport: TToolButton; + TBClose: TToolButton; + Panel1: TPanel; + ADOQueryCmd: TADOQuery; + ADOQueryMain: TADOQuery; + ADOQueryTemp: TADOQuery; + DataSource1: TDataSource; + cxGridPopupMenu1: TcxGridPopupMenu; + Label1: TLabel; + Label2: TLabel; + BegDate: TDateTimePicker; + EndDate: TDateTimePicker; + CDS_Main: TClientDataSet; + RM1: TRMGridReport; + RMDBMain: TRMDBDataSet; + RMXLSExport1: TRMXLSExport; + RMDBHZ: TRMDBDataSet; + CDS_HZ: TClientDataSet; + CDS_PRT: TClientDataSet; + PopupMenu1: TPopupMenu; + N1: TMenuItem; + N2: TMenuItem; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label8: TLabel; + SPName: TEdit; + FactoryName: TEdit; + SPID: TEdit; + SPSpec: TEdit; + Label6: TLabel; + SPCF: TEdit; + Label7: TLabel; + OrderNo: TEdit; + cxGrid2: TcxGrid; + Tv1: TcxGridDBTableView; + v1Column6: TcxGridDBColumn; + v1Column2: TcxGridDBColumn; + v1Column4: TcxGridDBColumn; + v1Column13: TcxGridDBColumn; + v1Column15: TcxGridDBColumn; + v1Column17: TcxGridDBColumn; + v1Column14: TcxGridDBColumn; + v2Column1: TcxGridDBColumn; + v1Column8: TcxGridDBColumn; + v1Column7: TcxGridDBColumn; + v1Column1: TcxGridDBColumn; + v1Column10: TcxGridDBColumn; + v1Column11: TcxGridDBColumn; + v2Column6: TcxGridDBColumn; + v1Column3: TcxGridDBColumn; + v1Column16: TcxGridDBColumn; + v1Column12: TcxGridDBColumn; + cxGrid2Level1: TcxGridLevel; + Label9: TLabel; + ToFactoryName: TEdit; + Label12: TLabel; + CRType: TComboBox; + v1Column18: TcxGridDBColumn; + v1Column19: TcxGridDBColumn; + Label11: TLabel; + RCGangNo: TEdit; + Label13: TLabel; + SPColor: TEdit; + Label15: TLabel; + SPHX: TEdit; + ADOQueryImage: TADOQuery; + v1Column21: TcxGridDBColumn; + CDS_MX: TClientDataSet; + DS_MX: TDataSource; + cxGridPopupMenu2: TcxGridPopupMenu; + TbEditKW: TToolButton; + Tv1SSel: TcxGridDBColumn; + Panel4: TPanel; + Label25: TLabel; + btnChk: TButton; + btn1: TButton; + KuWei: TcxButtonEdit; + Tv1Column1: TcxGridDBColumn; + Tv1Column2: TcxGridDBColumn; + Tv1Column3: TcxGridDBColumn; + Tv1Column4: TcxGridDBColumn; + Tv1Column5: TcxGridDBColumn; + procedure FormDestroy(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure TBRafreshClick(Sender: TObject); + procedure ConNoMChange(Sender: TObject); + procedure TBCloseClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure TBExportClick(Sender: TObject); + procedure TBFindClick(Sender: TObject); + procedure N1Click(Sender: TObject); + procedure N2Click(Sender: TObject); + procedure SPIDChange(Sender: TObject); + procedure SPSpecChange(Sender: TObject); + procedure FactoryNameChange(Sender: TObject); + procedure TbEditKWClick(Sender: TObject); + procedure KuWeiPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); + procedure btnChkClick(Sender: TObject); + procedure btn1Click(Sender: TObject); + private + canshu1, canshu2: string; + procedure InitGrid(); + { Private declarations } + public + { Public declarations } + end; + +var + frmStockList: TfrmStockList; + +implementation + +uses + U_DataLink, U_RTFun, U_YMTRKInPut, U_ZdyAttachGYS, U_LabelPrintFun, U_ZDYHelp, + U_KuWeiList; + +{$R *.dfm} + + + +procedure TfrmStockList.FormDestroy(Sender: TObject); +begin + frmStockList := nil; +end; + +procedure TfrmStockList.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caFree; +end; + +procedure TfrmStockList.FormCreate(Sender: TObject); +begin + canshu1 := Trim(DParameters1); + canshu2 := Trim(DParameters2); + EndDate.DateTime := SGetServerDate10(ADOQueryTemp); + BegDate.DateTime := EndDate.DateTime; +end; + +procedure TfrmStockList.InitGrid(); +begin + try + ADOQueryMain.DisableControls; + with ADOQueryMain do + begin + Filtered := False; + Close; + sql.Clear; + sql.Add(' select A.* '); + sql.Add(' from YMT_CK_CR A'); + sql.add(' where A.CRTime>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.DateTime)) + ''''); + sql.Add(' and A.CRTime<=''' + Trim(FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1)) + ''''); + sql.Add(' and isnull(CKName,'''')='''''); + SQL.Add(' and CRFlag='''' '); + Open; + //ShowMessage(SQL.Text); + end; + SCreateCDS20(ADOQueryMain, CDS_Main); + SInitCDSData20(ADOQueryMain, CDS_Main); + finally + ADOQueryMain.EnableControls; + end; +end; + +procedure TfrmStockList.TBRafreshClick(Sender: TObject); +begin + BegDate.SetFocus; + InitGrid(); +end; + +procedure TfrmStockList.ConNoMChange(Sender: TObject); +begin + if ADOQueryMain.Active then + begin + SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2)); + end; +end; + +procedure TfrmStockList.TBCloseClick(Sender: TObject); +begin + WriteCxGrid('첼б', Tv1, 'ϲֿ'); + Close; +end; + +procedure TfrmStockList.FormShow(Sender: TObject); +begin + + ReadCxGrid('첼б', Tv1, 'ϲֿ'); + + InitGrid(); +end; + +procedure TfrmStockList.TBExportClick(Sender: TObject); +begin + if ADOQueryMain.IsEmpty then + exit; + TcxGridToExcel('첼б', cxGrid2); +end; + +procedure TfrmStockList.TBFindClick(Sender: TObject); +begin + if ADOQueryMain.Active then + begin + SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2)); + SCreateCDS20(ADOQueryMain, CDS_Main); + SInitCDSData20(ADOQueryMain, CDS_Main); + end; +end; + +procedure TfrmStockList.N1Click(Sender: TObject); +begin + SelOKNo(CDS_Main, True); +end; + +procedure TfrmStockList.N2Click(Sender: TObject); +begin + SelOKNo(CDS_Main, False); +end; + +procedure TfrmStockList.SPIDChange(Sender: TObject); +begin + if Length(Trim(SPID.Text)) < 4 then + begin + if Trim(SPID.Text) <> '' then + Exit; + end; + TBFind.Click; +end; + +procedure TfrmStockList.SPSpecChange(Sender: TObject); +begin + TBFind.Click; +end; + +procedure TfrmStockList.FactoryNameChange(Sender: TObject); +begin + TBFind.Click; +end; + +procedure TfrmStockList.TbEditKWClick(Sender: TObject); +begin + if CDS_Main.IsEmpty then + exit; + Panel4.Visible := True; +end; + +procedure TfrmStockList.KuWeiPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); +begin + try + frmKuWeiList := TfrmKuWeiList.Create(Application); + with frmKuWeiList do + begin + if ShowModal = 1 then + begin + with Self.CDS_Main do + begin + Edit; + KuWei.Text := Trim(frmKuWeiList.Order_Main.fieldbyname('KWName').AsString); + end; + end; + end; + finally + frmKuWeiList.Free; + end; +end; + +procedure TfrmStockList.btnChkClick(Sender: TObject); +begin + if CDS_Main.IsEmpty then + exit; + if CDS_Main.Locate('SSel', True, []) = False then + begin + application.MessageBox('ѡݣ', 'ʾϢ'); + exit; + end; + + try + while CDS_Main.Locate('SSel', True, []) do + begin + with ADOQueryCmd do + begin + close; + sql.Clear; + sql.Add('update YMT_CK_CR SET KuWei=' + quotedstr(trim(KuWei.Text))); + sql.Add('where SPID=' + quotedstr(trim(CDS_Main.fieldbyname('SPID').AsString))); + execsql; + end; + with CDS_Main do + begin + Edit; + FieldByName('SSel').Value := False; + FieldByName('KuWei').Value := trim(KuWei.Text); + Post; + end; + end; + + Panel4.Visible := False; + application.MessageBox('޸ijɹ', 'ʾϢ'); + except + application.MessageBox('޸ʧܣ', 'ʾϢ', 0); + end; +end; + +procedure TfrmStockList.btn1Click(Sender: TObject); +begin + Panel4.Visible := False; +end; + +end. + diff --git a/云翔一码通/U_YMTStockSel.dfm b/云翔一码通/U_YMTStockSel.dfm new file mode 100644 index 0000000..8b7f40a --- /dev/null +++ b/云翔一码通/U_YMTStockSel.dfm @@ -0,0 +1,616 @@ +object frmStockSel: TfrmStockSel + Left = 237 + Top = 581 + Width = 1328 + Height = 687 + Caption = #24211#23384#36873#25321 + Color = clBtnFace + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = #23435#20307 + Font.Style = [] + OldCreateOrder = False + WindowState = wsMaximized + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 12 + object ToolBar1: TToolBar + Left = 0 + Top = 0 + Width = 1320 + AutoSize = True + ButtonHeight = 30 + ButtonWidth = 73 + Caption = 'ToolBar1' + Color = clSkyBlue + Flat = True + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -18 + Font.Name = #23435#20307 + Font.Style = [fsBold] + Images = DataLink_YXYMT.ThreeImgList + List = True + ParentColor = False + ParentFont = False + ShowCaptions = True + TabOrder = 0 + object TBRafresh: TToolButton + Left = 0 + Top = 0 + AutoSize = True + Caption = #21047#26032 + ImageIndex = 24 + OnClick = TBRafreshClick + end + object ToolButton1: TToolButton + Left = 77 + Top = 0 + AutoSize = True + Caption = #30830#35748 + ImageIndex = 10 + OnClick = ToolButton1Click + end + object TBClose: TToolButton + Left = 154 + Top = 0 + AutoSize = True + Caption = #20851#38381 + ImageIndex = 21 + OnClick = TBCloseClick + end + end + object Panel1: TPanel + Left = 0 + Top = 32 + Width = 1320 + Height = 70 + Align = alTop + BevelInner = bvRaised + BevelOuter = bvLowered + Color = clSkyBlue + TabOrder = 1 + object Label1: TLabel + Left = 25 + Top = 14 + Width = 80 + Height = 19 + Caption = #19979#21333#26085#26399 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label4: TLabel + Left = 241 + Top = 14 + Width = 73 + Height = 19 + Caption = #23458' '#25143 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label12: TLabel + Left = 613 + Top = 119 + Width = 26 + Height = 12 + Caption = #20811#37325 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label5: TLabel + Left = 489 + Top = 14 + Width = 73 + Height = 19 + Caption = #21697' '#21517 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object Label7: TLabel + Left = 525 + Top = 88 + Width = 52 + Height = 12 + Caption = #23457#26680#29366#24577 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + Visible = False + end + object Label2: TLabel + Left = 746 + Top = 14 + Width = 80 + Height = 19 + Caption = #20837#24211#31867#22411 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + end + object BegDate: TDateTimePicker + Left = 100 + Top = 10 + Width = 123 + Height = 27 + Date = 40675.464742650460000000 + Format = 'yyyy-MM-dd' + Time = 40675.464742650460000000 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + end + object EndDate: TDateTimePicker + Left = 100 + Top = 37 + Width = 123 + Height = 27 + Date = 40675.464761099540000000 + Format = 'yyyy-MM-dd' + Time = 40675.464761099540000000 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + TabOrder = 1 + end + object CustomerNoName: TEdit + Tag = 2 + Left = 328 + Top = 9 + Width = 140 + Height = 27 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + TabOrder = 2 + OnChange = CustomerNoNameChange + end + object MPRTKZ: TEdit + Tag = 2 + Left = 654 + Top = 99 + Width = 56 + Height = 20 + TabOrder = 3 + end + object SPName: TEdit + Tag = 2 + Left = 576 + Top = 9 + Width = 139 + Height = 27 + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ParentFont = False + TabOrder = 4 + OnChange = CustomerNoNameChange + OnKeyPress = SPNameKeyPress + end + object status: TComboBox + Tag = 2 + Left = 581 + Top = 87 + Width = 103 + Height = 20 + ItemHeight = 12 + TabOrder = 5 + Visible = False + Items.Strings = ( + #26410#23457#26680 + #24050#23457#26680 + #24050#23436#25104 + '') + end + object CRType: TComboBox + Tag = 2 + Left = 844 + Top = 10 + Width = 139 + Height = 27 + Style = csDropDownList + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = #23435#20307 + Font.Style = [fsBold] + ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861 + ItemHeight = 19 + ParentFont = False + TabOrder = 6 + Items.Strings = ( + '' + #21152#24037#23436#25104 + #22238#20462#23436#25104 + #26816#39564#36864#22238 + #26399#21021#20837#24211 + #23458#25143#36864#36135 + #37319#36141#20837#24211 + #27425#21697#20837#24211) + end + end + object cxSplitter1: TcxSplitter + Left = 0 + Top = 648 + Width = 1320 + Height = 8 + HotZoneClassName = 'TcxMediaPlayer9Style' + AlignSplitter = salBottom + Visible = False + end + object cxGrid2: TcxGrid + Left = 0 + Top = 102 + Width = 1320 + Height = 546 + Align = alClient + TabOrder = 3 + object Tv1: TcxGridDBTableView + Navigator.Buttons.CustomButtons = <> + DataController.DataSource = DataSource1 + DataController.Summary.DefaultGroupSummaryItems = <> + DataController.Summary.FooterSummaryItems = < + item + Kind = skCount + end + item + Kind = skSum + end + item + Kind = skSum + Column = v2Column6 + end + item + Kind = skSum + end + item + Format = '#,###' + Kind = skSum + end + item + Format = '#,###' + Kind = skSum + end + item + Format = '#,###' + Kind = skSum + end + item + Kind = skSum + Column = Tv1Column4 + end> + DataController.Summary.SummaryGroups = <> + OptionsCustomize.ColumnFiltering = False + OptionsView.Footer = True + OptionsView.GroupByBox = False + OptionsView.Indicator = True + Styles.Inactive = DataLink_YXYMT.SHuangSe + Styles.IncSearch = DataLink_YXYMT.SHuangSe + Styles.Selection = DataLink_YXYMT.SHuangSe + Styles.Header = DataLink_YXYMT.Default + object Tv1SSel: TcxGridDBColumn + Caption = #36873#25321 + DataBinding.FieldName = 'SSel' + PropertiesClassName = 'TcxCheckBoxProperties' + HeaderAlignmentHorz = taCenter + Width = 47 + end + object v1Column6: TcxGridDBColumn + Caption = #20837#24211#21333#21495 + DataBinding.FieldName = 'SPID' + Visible = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 83 + end + object v1Column2: TcxGridDBColumn + Tag = 2 + Caption = #20837#24211#26102#38388 + DataBinding.FieldName = 'CRTime' + PropertiesClassName = 'TcxDateEditProperties' + Properties.SaveTime = False + Properties.ShowTime = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 100 + end + object v1Column4: TcxGridDBColumn + Tag = 2 + Caption = #20837#24211#31867#22411 + DataBinding.FieldName = 'CRType' + PropertiesClassName = 'TcxComboBoxProperties' + Properties.DropDownListStyle = lsFixedList + Properties.Items.Strings = ( + #21152#24037#23436#25104 + #29983#20135#36864#22238) + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 83 + end + object v1Column13: TcxGridDBColumn + Caption = #35746#21333#21495 + DataBinding.FieldName = 'OrderNo' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + Visible = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 102 + end + object Tv1Column3: TcxGridDBColumn + Caption = #23458#25143 + DataBinding.FieldName = 'CustomerNoName' + HeaderAlignmentHorz = taCenter + Width = 80 + end + object v1Column14: TcxGridDBColumn + Tag = 2 + Caption = #20379#24212#21830 + DataBinding.FieldName = 'FactoryName' + PropertiesClassName = 'TcxTextEditProperties' + Properties.ReadOnly = True + HeaderAlignmentHorz = taCenter + Width = 101 + end + object v2Column1: TcxGridDBColumn + Tag = 2 + Caption = #21697#21517 + DataBinding.FieldName = 'SPName' + PropertiesClassName = 'TcxTextEditProperties' + Properties.ReadOnly = True + HeaderAlignmentHorz = taCenter + Width = 97 + end + object v1Column21: TcxGridDBColumn + Tag = 2 + Caption = #20135#21697#32534#21495 + DataBinding.FieldName = 'spcode' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object v1Column8: TcxGridDBColumn + Tag = 2 + Caption = #35268#26684 + DataBinding.FieldName = 'SPSpec' + HeaderAlignmentHorz = taCenter + HeaderGlyphAlignmentHorz = taCenter + Options.Editing = False + Width = 65 + end + object v1Column7: TcxGridDBColumn + Tag = 2 + Caption = #25104#20998 + DataBinding.FieldName = 'SPCF' + HeaderAlignmentHorz = taCenter + HeaderGlyphAlignmentHorz = taCenter + Options.Editing = False + Width = 73 + end + object v1Column1: TcxGridDBColumn + Tag = 2 + Caption = #38376#24133 + DataBinding.FieldName = 'SPMF' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 73 + end + object v1Column10: TcxGridDBColumn + Tag = 2 + Caption = #20811#37325 + DataBinding.FieldName = 'SPKZ' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 90 + end + object v1Column15: TcxGridDBColumn + Caption = #39068#33394 + DataBinding.FieldName = 'SPColor' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 69 + end + object v1Column17: TcxGridDBColumn + Caption = #33457#22411#33457#21495 + DataBinding.FieldName = 'SPHX' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 70 + end + object v1Column11: TcxGridDBColumn + Tag = 2 + Caption = #23384#25918#24037#21378 + DataBinding.FieldName = 'ToFactoryName' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 84 + end + object v1Column18: TcxGridDBColumn + Caption = #24211#20301 + DataBinding.FieldName = 'KuWei' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 86 + end + object v1Column19: TcxGridDBColumn + Caption = #32568#21495 + DataBinding.FieldName = 'RCGangNo' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 75 + end + object Tv1Column2: TcxGridDBColumn + Caption = #24037#33402 + DataBinding.FieldName = 'GYLXName' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 55 + end + object v2Column6: TcxGridDBColumn + Tag = 2 + Caption = #25968#37327 + DataBinding.FieldName = 'MQty' + PropertiesClassName = 'TcxTextEditProperties' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 62 + end + object Tv1Column4: TcxGridDBColumn + Caption = #37325#37327 + DataBinding.FieldName = 'KgQty' + HeaderAlignmentHorz = taCenter + Width = 80 + end + object v1Column3: TcxGridDBColumn + Tag = 2 + Caption = #25968#37327#21333#20301 + DataBinding.FieldName = 'QtyUnit' + PropertiesClassName = 'TcxComboBoxProperties' + Properties.DropDownListStyle = lsFixedList + Properties.Items.Strings = ( + 'Kg' + 'M' + 'Y') + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 66 + end + object Tv1Column1: TcxGridDBColumn + Caption = #21333#20215 + DataBinding.FieldName = 'Price' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 55 + end + object v1Column16: TcxGridDBColumn + Tag = 2 + Caption = #26469#33258#24037#21378 + DataBinding.FieldName = 'FromFactoryName' + PropertiesClassName = 'TcxButtonEditProperties' + Properties.Buttons = < + item + Default = True + Kind = bkEllipsis + end> + Properties.ReadOnly = True + Visible = False + HeaderAlignmentHorz = taCenter + Options.Editing = False + VisibleForCustomization = False + Width = 79 + end + object v1Column12: TcxGridDBColumn + Tag = 2 + Caption = #22791#27880 + DataBinding.FieldName = 'Note' + HeaderAlignmentHorz = taCenter + Options.Editing = False + Width = 79 + end + end + object cxGrid2Level1: TcxGridLevel + GridView = Tv1 + end + end + object cxGridPopupMenu1: TcxGridPopupMenu + Grid = cxGrid2 + PopupMenus = <> + Left = 710 + Top = 298 + end + object ADOQueryCmd: TADOQuery + Connection = DataLink_YXYMT.ADOLink + Parameters = <> + Left = 582 + Top = 298 + end + object ADOQueryMain: TADOQuery + Connection = DataLink_YXYMT.ADOLink + LockType = ltReadOnly + Parameters = <> + Left = 614 + Top = 298 + end + object ADOQueryTemp: TADOQuery + Connection = DataLink_YXYMT.ADOLink + LockType = ltReadOnly + Parameters = <> + Left = 646 + Top = 298 + end + object DataSource1: TDataSource + DataSet = CDS_Main + Left = 582 + Top = 330 + end + object CDS_Main: TClientDataSet + Aggregates = <> + Params = <> + Left = 678 + Top = 298 + end + object PopupMenu1: TPopupMenu + Left = 614 + Top = 330 + object N2: TMenuItem + Caption = #20840#36873 + OnClick = N2Click + end + object N1: TMenuItem + Caption = #20840#24323 + OnClick = N1Click + end + object N3: TMenuItem + Caption = #25490#21333 + end + end +end diff --git a/云翔一码通/U_YMTStockSel.pas b/云翔一码通/U_YMTStockSel.pas new file mode 100644 index 0000000..605a1b3 --- /dev/null +++ b/云翔一码通/U_YMTStockSel.pas @@ -0,0 +1,259 @@ +unit U_YMTStockSel; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, + cxEdit, DB, cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView, + cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, cxMemo, + cxRichEdit, ComCtrls, cxContainer, cxTextEdit, cxMaskEdit, cxButtonEdit, + StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar, StrUtils, + cxCurrencyEdit, cxImage, cxDBEdit, Menus, RM_Common, RM_Class, RM_e_Xls, + RM_Dataset, RM_System, RM_GridReport, cxGridCustomPopupMenu, cxGridPopupMenu, + cxPC, cxSplitter, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, + IdFTP, ShellAPI, cxCheckBox, cxLookAndFeels, cxLookAndFeelPainters, + cxNavigator, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, + dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide, + dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy, + dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian, + dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis, + dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black, + dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink, + dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue, + dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray, + dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic, + dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust, + dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, + dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, + dxSkinscxPCPainter, cxDropDownEdit; + +type + TfrmStockSel = class(TForm) + ToolBar1: TToolBar; + TBRafresh: TToolButton; + TBClose: TToolButton; + Panel1: TPanel; + BegDate: TDateTimePicker; + EndDate: TDateTimePicker; + Label1: TLabel; + cxGridPopupMenu1: TcxGridPopupMenu; + ADOQueryCmd: TADOQuery; + ADOQueryMain: TADOQuery; + ADOQueryTemp: TADOQuery; + DataSource1: TDataSource; + CDS_Main: TClientDataSet; + Label4: TLabel; + CustomerNoName: TEdit; + PopupMenu1: TPopupMenu; + N2: TMenuItem; + Label12: TLabel; + MPRTKZ: TEdit; + cxSplitter1: TcxSplitter; + SPName: TEdit; + Label5: TLabel; + N1: TMenuItem; + Label7: TLabel; + status: TComboBox; + N3: TMenuItem; + ToolButton1: TToolButton; + cxGrid2: TcxGrid; + Tv1: TcxGridDBTableView; + Tv1SSel: TcxGridDBColumn; + v1Column6: TcxGridDBColumn; + v1Column2: TcxGridDBColumn; + v1Column4: TcxGridDBColumn; + v1Column13: TcxGridDBColumn; + Tv1Column3: TcxGridDBColumn; + v1Column14: TcxGridDBColumn; + v2Column1: TcxGridDBColumn; + v1Column21: TcxGridDBColumn; + v1Column8: TcxGridDBColumn; + v1Column7: TcxGridDBColumn; + v1Column1: TcxGridDBColumn; + v1Column10: TcxGridDBColumn; + v1Column15: TcxGridDBColumn; + v1Column17: TcxGridDBColumn; + v1Column11: TcxGridDBColumn; + v1Column18: TcxGridDBColumn; + v1Column19: TcxGridDBColumn; + Tv1Column2: TcxGridDBColumn; + v2Column6: TcxGridDBColumn; + Tv1Column4: TcxGridDBColumn; + v1Column3: TcxGridDBColumn; + Tv1Column1: TcxGridDBColumn; + v1Column16: TcxGridDBColumn; + v1Column12: TcxGridDBColumn; + cxGrid2Level1: TcxGridLevel; + Label2: TLabel; + CRType: TComboBox; + procedure FormDestroy(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure TBCloseClick(Sender: TObject); + procedure TBExportClick(Sender: TObject); + procedure TBRafreshClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure CheckBox1Click(Sender: TObject); + procedure CheckBox2Click(Sender: TObject); + procedure N1Click(Sender: TObject); + procedure N2Click(Sender: TObject); + procedure SPNameKeyPress(Sender: TObject; var Key: Char); + procedure MLConNoKeyPress(Sender: TObject; var Key: Char); + procedure MLOrderNoKeyPress(Sender: TObject; var Key: Char); + procedure CustomerNoNameChange(Sender: TObject); + procedure ToolButton1Click(Sender: TObject); + private + DQdate: TDateTime; + procedure InitGrid(); + procedure InitForm(); + + { Private declarations } + public + FFInt, FCloth: Integer; + canshu1, canshu2, canshu3: string; + fFlileFlag: string; + FKHNo, FTT: string; + { Public declarations } + end; + +var + frmStockSel: TfrmStockSel; + +implementation + +uses + U_DataLink, U_Fun; +{$R *.dfm} + +procedure TfrmStockSel.FormDestroy(Sender: TObject); +begin + frmStockSel := nil; +end; + +procedure TfrmStockSel.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caFree; +end; + +procedure TfrmStockSel.FormCreate(Sender: TObject); +begin + DQdate := SGetServerDate(ADOQueryTemp); + canshu1 := trim(DParameters1); + canshu2 := trim(DdataBase); +end; + +procedure TfrmStockSel.TBCloseClick(Sender: TObject); +begin + Close; + WriteCxGrid('ָʾYX', Tv1, 'ָʾ'); +end; + +procedure TfrmStockSel.InitGrid(); +var + fwhere, Pwhere: string; +begin + + try + ADOQueryMain.DisableControls; + with ADOQueryMain do + begin + Filtered := False; + Close; + sql.Clear; + sql.Add(' select A.* '); + sql.Add(' from YMT_CK_CR A'); + sql.add(' where A.CRTime>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.DateTime)) + ''''); + sql.Add(' and A.CRTime<=''' + Trim(FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1)) + ''''); + sql.Add(' and isnull(CKName,'''')='''''); + SQL.Add(' and CRFlag='''' '); + Open; + //ShowMessage(SQL.Text); + end; + SCreateCDS20(ADOQueryMain, CDS_Main); + SInitCDSData20(ADOQueryMain, CDS_Main); + finally + ADOQueryMain.EnableControls; + end; +end; + +procedure TfrmStockSel.InitForm(); +begin + ReadCxGrid('ָʾYX', Tv1, 'ָʾ'); + EndDate.DateTime := SGetServerDate10(ADOQueryTemp); + BegDate.DateTime := EndDate.DateTime; + InitGrid(); + +end; + +procedure TfrmStockSel.TBExportClick(Sender: TObject); +begin + if ADOQueryMain.IsEmpty then + Exit; + SelExportData(Tv1, ADOQueryMain, 'Ⱦɫƻ'); +end; + +procedure TfrmStockSel.TBRafreshClick(Sender: TObject); +begin + InitGrid(); +end; + +procedure TfrmStockSel.FormShow(Sender: TObject); +begin + InitForm(); +end; + +procedure TfrmStockSel.CheckBox1Click(Sender: TObject); +begin + InitGrid(); +end; + +procedure TfrmStockSel.CheckBox2Click(Sender: TObject); +begin + TBRafresh.Click; +end; + +procedure TfrmStockSel.N1Click(Sender: TObject); +begin + SelOKNo(CDS_Main, false); +end; + +procedure TfrmStockSel.N2Click(Sender: TObject); +begin + SelOKNo(CDS_Main, True); +end; + +procedure TfrmStockSel.SPNameKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + InitGrid(); +end; + +procedure TfrmStockSel.MLConNoKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + InitGrid(); +end; + +procedure TfrmStockSel.MLOrderNoKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + InitGrid(); +end; + +procedure TfrmStockSel.CustomerNoNameChange(Sender: TObject); +begin + if ADOQueryMain.Active = False then + Exit; + SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2)); + SCreateCDS20(ADOQueryMain, CDS_Main); + SInitCDSData20(ADOQueryMain, CDS_Main); +end; + +procedure TfrmStockSel.ToolButton1Click(Sender: TObject); +begin + ModalResult := 1; +end; + +end. + diff --git a/云翔一码通/YXYMT.dof b/云翔一码通/YXYMT.dof index c5bbdb0..c24c8dd 100644 --- a/云翔一码通/YXYMT.dof +++ b/云翔一码通/YXYMT.dof @@ -101,7 +101,7 @@ DebugSourceDirs= UsePackages=0 [Parameters] RunParams= -HostApplication=D:\ֿ\Ŀ\D7WMyunxiang\һͨ\testDll.exe +HostApplication=D:\Project\D7myYunxiang\һͨ\testDll.exe Launcher= UseLauncher=0 DebugCWD= diff --git a/云翔一码通/YXYMT.dpr b/云翔一码通/YXYMT.dpr index 5b236ae..e350972 100644 --- a/云翔一码通/YXYMT.dpr +++ b/云翔一码通/YXYMT.dpr @@ -18,7 +18,6 @@ uses U_ColumnBandSet in '..\Z99Dependency\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet}, U_SelPrintFieldNew in '..\Z99Dependency\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew}, U_CompressionFun in '..\Z99Dependency\ThreeFun\Fun\U_CompressionFun.pas', - U_SelExportField in '..\Z99Dependency\ThreeFun\Fun\U_SelExportField.pas' {frmSelExportField}, superobject in '..\Z99Dependency\ThreeFun\Fun\superobject.pas', U_ClientPrintRmf in '..\A00ǩӡ\U_ClientPrintRmf.pas' {frmClientPrintRmf}, U_LabelMapSet in '..\A00ǩӡ\U_LabelMapSet.pas' {frmLabelMapSet}, @@ -26,7 +25,11 @@ uses U_LabelPrintFun in '..\A00ǩӡ\U_LabelPrintFun.pas', U_QrCodeFun in '..\A00ǩӡ\U_QrCodeFun.pas', U_YMTFHDataList in 'U_YMTFHDataList.pas' {frmYMTFHDataList}, - U_YMTJGWCList in 'U_YMTJGWCList.pas' {frmYMTJGWCList}; + U_YMTJGWCList in 'U_YMTJGWCList.pas' {frmYMTJGWCList}, + U_YMTFHSQInPut2 in 'U_YMTFHSQInPut2.pas' {frmFHSQInPut2}, + U_YMTStockSel in 'U_YMTStockSel.pas' {frmStockSel}, + U_YMTStockList in 'U_YMTStockList.pas' {frmStockList}, + U_SelExportField in '..\Z99Dependency\ThreeFun\Fun\U_SelExportField.pas' {frmSelExportField}; {$R *.res} diff --git a/云翔一码通/superobject.pas b/云翔一码通/superobject.pas new file mode 100644 index 0000000..0d41d4b --- /dev/null +++ b/云翔一码通/superobject.pas @@ -0,0 +1,7502 @@ +(* + * Super Object Toolkit + * + * Usage allowed under the restrictions of the Lesser GNU General Public License + * or alternatively the restrictions of the Mozilla Public License 1.1 + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for + * the specific language governing rights and limitations under the License. + * + * Unit owner : Henri Gourvest + * Web site : http://www.progdigy.com + * + * This unit is inspired from the json c lib: + * Michael Clark + * http://oss.metaparadigm.com/json-c/ + * + * CHANGES: + * v1.2 + * + support of currency data type + * + right trim unquoted string + * + read Unicode Files and streams (Litle Endian with BOM) + * + Fix bug on javadate functions + windows nt compatibility + * + Now you can force to parse only the canonical syntax of JSON using the stric parameter + * + Delphi 2010 RTTI marshalling + * v1.1 + * + Double licence MPL or LGPL. + * + Delphi 2009 compatibility & Unicode support. + * + AsString return a string instead of PChar. + * + Escaped and Unascaped JSON serialiser. + * + Missed FormFeed added \f + * - Removed @ trick, uses forcepath() method instead. + * + Fixed parse error with uppercase E symbol in numbers. + * + Fixed possible buffer overflow when enlarging array. + * + Added "delete", "pack", "insert" methods for arrays and/or objects + * + Multi parametters when calling methods + * + Delphi Enumerator (for obj1 in obj2 do ...) + * + Format method ex: obj.format('<%name%>%tab[1]%') + * + ParseFile and ParseStream methods + * + Parser now understand hexdecimal c syntax ex: \xFF + * + Null Object Design Patern (ex: for obj in values.N['path'] do ...) + * v1.0 + * + renamed class + * + interfaced object + * + added a new data type: the method + * + parser can now evaluate properties and call methods + * - removed obselet rpc class + * - removed "find" method, now you can use "parse" method instead + * v0.6 + * + refactoring + * v0.5 + * + new find method to get or set value using a path syntax + * ex: obj.s['obj.prop[1]'] := 'string value'; + * obj.a['@obj.array'].b[n] := true; // @ -> create property if necessary + * v0.4 + * + bug corrected: AVL tree badly balanced. + * v0.3 + * + New validator partially based on the Kwalify syntax. + * + extended syntax to parse unquoted fields. + * + Freepascal compatibility win32/64 Linux32/64. + * + JavaToDelphiDateTime and DelphiToJavaDateTime improved for UTC. + * + new TJsonObject.Compare function. + * v0.2 + * + Hashed string list replaced with a faster AVL tree + * + JsonInt data type can be changed to int64 + * + JavaToDelphiDateTime and DelphiToJavaDateTime helper fonctions + * + from json-c v0.7 + * + Add escaping of backslash to json output + * + Add escaping of foward slash on tokenizing and output + * + Changes to internal tokenizer from using recursion to + * using a depth state structure to allow incremental parsing + * v0.1 + * + first release + *) + +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} +{$ENDIF} + +{$DEFINE SUPER_METHOD} +{$DEFINE WINDOWSNT_COMPATIBILITY} +{.$DEFINE DEBUG} // track memory leack + + +{$if defined(FPC) or defined(VER170) or defined(VER180) or defined(VER190) or defined(VER200) or defined(VER210)} + {$DEFINE HAVE_INLINE} +{$ifend} + +{$if defined(VER210) or defined(VER220) or defined(VER230)} + {$define HAVE_RTTI} +{$ifend} + +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} + +unit superobject; + +interface +uses + Classes +{$IFDEF HAVE_RTTI} + ,Generics.Collections, RTTI, TypInfo +{$ENDIF} + ; + +type +{$IFNDEF FPC} +{$IFDEF CPUX64} + PtrInt = Int64; + PtrUInt = UInt64; +{$ELSE} + PtrInt = longint; + PtrUInt = Longword; +{$ENDIF} +{$ENDIF} + SuperInt = Int64; + +{$if (sizeof(Char) = 1)} + SOChar = WideChar; + SOIChar = Word; + PSOChar = PWideChar; +{$IFDEF FPC} + SOString = UnicodeString; +{$ELSE} + SOString = WideString; +{$ENDIF} +{$else} + SOChar = Char; + SOIChar = Word; + PSOChar = PChar; + SOString = string; +{$ifend} + +const + SUPER_ARRAY_LIST_DEFAULT_SIZE = 32; + SUPER_TOKENER_MAX_DEPTH = 32; + + SUPER_AVL_MAX_DEPTH = sizeof(longint) * 8; + SUPER_AVL_MASK_HIGH_BIT = not ((not longword(0)) shr 1); + +type + // forward declarations + TSuperObject = class; + ISuperObject = interface; + TSuperArray = class; + +(* AVL Tree + * This is a "special" autobalanced AVL tree + * It use a hash value for fast compare + *) + +{$IFDEF SUPER_METHOD} + TSuperMethod = procedure(const This, Params: ISuperObject; var Result: ISuperObject); +{$ENDIF} + + + TSuperAvlBitArray = set of 0..SUPER_AVL_MAX_DEPTH - 1; + + TSuperAvlSearchType = (stEQual, stLess, stGreater); + TSuperAvlSearchTypes = set of TSuperAvlSearchType; + TSuperAvlIterator = class; + + TSuperAvlEntry = class + private + FGt, FLt: TSuperAvlEntry; + FBf: integer; + FHash: Cardinal; + FName: SOString; + FPtr: Pointer; + function GetValue: ISuperObject; + procedure SetValue(const val: ISuperObject); + public + class function Hash(const k: SOString): Cardinal; virtual; + constructor Create(const AName: SOString; Obj: Pointer); virtual; + property Name: SOString read FName; + property Ptr: Pointer read FPtr; + property Value: ISuperObject read GetValue write SetValue; + end; + + TSuperAvlTree = class + private + FRoot: TSuperAvlEntry; + FCount: Integer; + function balance(bal: TSuperAvlEntry): TSuperAvlEntry; + protected + procedure doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); virtual; + function CompareNodeNode(node1, node2: TSuperAvlEntry): integer; virtual; + function CompareKeyNode(const k: SOString; h: TSuperAvlEntry): integer; virtual; + function Insert(h: TSuperAvlEntry): TSuperAvlEntry; virtual; + function Search(const k: SOString; st: TSuperAvlSearchTypes = [stEqual]): TSuperAvlEntry; virtual; + public + constructor Create; virtual; + destructor Destroy; override; + function IsEmpty: boolean; + procedure Clear(all: boolean = false); virtual; + procedure Pack(all: boolean); + function Delete(const k: SOString): ISuperObject; + function GetEnumerator: TSuperAvlIterator; + property count: Integer read FCount; + end; + + TSuperTableString = class(TSuperAvlTree) + protected + procedure doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); override; + procedure PutO(const k: SOString; const value: ISuperObject); + function GetO(const k: SOString): ISuperObject; + procedure PutS(const k: SOString; const value: SOString); + function GetS(const k: SOString): SOString; + procedure PutI(const k: SOString; value: SuperInt); + function GetI(const k: SOString): SuperInt; + procedure PutD(const k: SOString; value: Double); + function GetD(const k: SOString): Double; + procedure PutB(const k: SOString; value: Boolean); + function GetB(const k: SOString): Boolean; +{$IFDEF SUPER_METHOD} + procedure PutM(const k: SOString; value: TSuperMethod); + function GetM(const k: SOString): TSuperMethod; +{$ENDIF} + procedure PutN(const k: SOString; const value: ISuperObject); + function GetN(const k: SOString): ISuperObject; + procedure PutC(const k: SOString; value: Currency); + function GetC(const k: SOString): Currency; + public + property O[const k: SOString]: ISuperObject read GetO write PutO; default; + property S[const k: SOString]: SOString read GetS write PutS; + property I[const k: SOString]: SuperInt read GetI write PutI; + property D[const k: SOString]: Double read GetD write PutD; + property B[const k: SOString]: Boolean read GetB write PutB; +{$IFDEF SUPER_METHOD} + property M[const k: SOString]: TSuperMethod read GetM write PutM; +{$ENDIF} + property N[const k: SOString]: ISuperObject read GetN write PutN; + property C[const k: SOString]: Currency read GetC write PutC; + + function GetValues: ISuperObject; + function GetNames: ISuperObject; + function Find(const k: SOString; var value: ISuperObject): Boolean; + end; + + TSuperAvlIterator = class + private + FTree: TSuperAvlTree; + FBranch: TSuperAvlBitArray; + FDepth: LongInt; + FPath: array[0..SUPER_AVL_MAX_DEPTH - 2] of TSuperAvlEntry; + public + constructor Create(tree: TSuperAvlTree); virtual; + procedure Search(const k: SOString; st: TSuperAvlSearchTypes = [stEQual]); + procedure First; + procedure Last; + function GetIter: TSuperAvlEntry; + procedure Next; + procedure Prior; + // delphi enumerator + function MoveNext: Boolean; + property Current: TSuperAvlEntry read GetIter; + end; + + TSuperObjectArray = array[0..(high(Integer) div sizeof(TSuperObject))-1] of ISuperObject; + PSuperObjectArray = ^TSuperObjectArray; + + TSuperArray = class + private + FArray: PSuperObjectArray; + FLength: Integer; + FSize: Integer; + procedure Expand(max: Integer); + protected + function GetO(const index: integer): ISuperObject; + procedure PutO(const index: integer; const Value: ISuperObject); + function GetB(const index: integer): Boolean; + procedure PutB(const index: integer; Value: Boolean); + function GetI(const index: integer): SuperInt; + procedure PutI(const index: integer; Value: SuperInt); + function GetD(const index: integer): Double; + procedure PutD(const index: integer; Value: Double); + function GetC(const index: integer): Currency; + procedure PutC(const index: integer; Value: Currency); + function GetS(const index: integer): SOString; + procedure PutS(const index: integer; const Value: SOString); +{$IFDEF SUPER_METHOD} + function GetM(const index: integer): TSuperMethod; + procedure PutM(const index: integer; Value: TSuperMethod); +{$ENDIF} + function GetN(const index: integer): ISuperObject; + procedure PutN(const index: integer; const Value: ISuperObject); + public + constructor Create; virtual; + destructor Destroy; override; + function Add(const Data: ISuperObject): Integer; + function Delete(index: Integer): ISuperObject; + procedure Insert(index: Integer; const value: ISuperObject); + procedure Clear(all: boolean = false); + procedure Pack(all: boolean); + property Length: Integer read FLength; + + property N[const index: integer]: ISuperObject read GetN write PutN; + property O[const index: integer]: ISuperObject read GetO write PutO; default; + property B[const index: integer]: boolean read GetB write PutB; + property I[const index: integer]: SuperInt read GetI write PutI; + property D[const index: integer]: Double read GetD write PutD; + property C[const index: integer]: Currency read GetC write PutC; + property S[const index: integer]: SOString read GetS write PutS; +{$IFDEF SUPER_METHOD} + property M[const index: integer]: TSuperMethod read GetM write PutM; +{$ENDIF} + end; + + TSuperWriter = class + public + // abstact methods to overide + function Append(buf: PSOChar; Size: Integer): Integer; overload; virtual; abstract; + function Append(buf: PSOChar): Integer; overload; virtual; abstract; + procedure Reset; virtual; abstract; + end; + + TSuperWriterString = class(TSuperWriter) + private + FBuf: PSOChar; + FBPos: integer; + FSize: integer; + public + function Append(buf: PSOChar; Size: Integer): Integer; overload; override; + function Append(buf: PSOChar): Integer; overload; override; + procedure Reset; override; + procedure TrimRight; + constructor Create; virtual; + destructor Destroy; override; + function GetString: SOString; + property Data: PSOChar read FBuf; + property Size: Integer read FSize; + property Position: integer read FBPos; + end; + + TSuperWriterStream = class(TSuperWriter) + private + FStream: TStream; + public + function Append(buf: PSOChar): Integer; override; + procedure Reset; override; + constructor Create(AStream: TStream); reintroduce; virtual; + end; + + TSuperAnsiWriterStream = class(TSuperWriterStream) + public + function Append(buf: PSOChar; Size: Integer): Integer; override; + end; + + TSuperUnicodeWriterStream = class(TSuperWriterStream) + public + function Append(buf: PSOChar; Size: Integer): Integer; override; + end; + + TSuperWriterFake = class(TSuperWriter) + private + FSize: Integer; + public + function Append(buf: PSOChar; Size: Integer): Integer; override; + function Append(buf: PSOChar): Integer; override; + procedure Reset; override; + constructor Create; reintroduce; virtual; + property size: integer read FSize; + end; + + TSuperWriterSock = class(TSuperWriter) + private + FSocket: longint; + FSize: Integer; + public + function Append(buf: PSOChar; Size: Integer): Integer; override; + function Append(buf: PSOChar): Integer; override; + procedure Reset; override; + constructor Create(ASocket: longint); reintroduce; virtual; + property Socket: longint read FSocket; + property Size: Integer read FSize; + end; + + TSuperTokenizerError = ( + teSuccess, + teContinue, + teDepth, + teParseEof, + teParseUnexpected, + teParseNull, + teParseBoolean, + teParseNumber, + teParseArray, + teParseObjectKeyName, + teParseObjectKeySep, + teParseObjectValueSep, + teParseString, + teParseComment, + teEvalObject, + teEvalArray, + teEvalMethod, + teEvalInt + ); + + TSuperTokenerState = ( + tsEatws, + tsStart, + tsFinish, + tsNull, + tsCommentStart, + tsComment, + tsCommentEol, + tsCommentEnd, + tsString, + tsStringEscape, + tsIdentifier, + tsEscapeUnicode, + tsEscapeHexadecimal, + tsBoolean, + tsNumber, + tsArray, + tsArrayAdd, + tsArraySep, + tsObjectFieldStart, + tsObjectField, + tsObjectUnquotedField, + tsObjectFieldEnd, + tsObjectValue, + tsObjectValueAdd, + tsObjectSep, + tsEvalProperty, + tsEvalArray, + tsEvalMethod, + tsParamValue, + tsParamPut, + tsMethodValue, + tsMethodPut + ); + + PSuperTokenerSrec = ^TSuperTokenerSrec; + TSuperTokenerSrec = record + state, saved_state: TSuperTokenerState; + obj: ISuperObject; + current: ISuperObject; + field_name: SOString; + parent: ISuperObject; + gparent: ISuperObject; + end; + + TSuperTokenizer = class + public + str: PSOChar; + pb: TSuperWriterString; + depth, is_double, floatcount, st_pos, char_offset: Integer; + err: TSuperTokenizerError; + ucs_char: Word; + quote_char: SOChar; + stack: array[0..SUPER_TOKENER_MAX_DEPTH-1] of TSuperTokenerSrec; + line, col: Integer; + public + constructor Create; virtual; + destructor Destroy; override; + procedure ResetLevel(adepth: integer); + procedure Reset; + end; + + // supported object types + TSuperType = ( + stNull, + stBoolean, + stDouble, + stCurrency, + stInt, + stObject, + stArray, + stString +{$IFDEF SUPER_METHOD} + ,stMethod +{$ENDIF} + ); + + TSuperValidateError = ( + veRuleMalformated, + veFieldIsRequired, + veInvalidDataType, + veFieldNotFound, + veUnexpectedField, + veDuplicateEntry, + veValueNotInEnum, + veInvalidLength, + veInvalidRange + ); + + TSuperFindOption = ( + foCreatePath, + foPutValue, + foDelete +{$IFDEF SUPER_METHOD} + ,foCallMethod +{$ENDIF} + ); + + TSuperFindOptions = set of TSuperFindOption; + TSuperCompareResult = (cpLess, cpEqu, cpGreat, cpError); + TSuperOnValidateError = procedure(sender: Pointer; error: TSuperValidateError; const objpath: SOString); + + TSuperEnumerator = class + private + FObj: ISuperObject; + FObjEnum: TSuperAvlIterator; + FCount: Integer; + public + constructor Create(const obj: ISuperObject); virtual; + destructor Destroy; override; + function MoveNext: Boolean; + function GetCurrent: ISuperObject; + property Current: ISuperObject read GetCurrent; + end; + + ISuperObject = interface + ['{4B86A9E3-E094-4E5A-954A-69048B7B6327}'] + function GetEnumerator: TSuperEnumerator; + function GetDataType: TSuperType; + function GetProcessing: boolean; + procedure SetProcessing(value: boolean); + function ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject; + function Format(const str: SOString; BeginSep: SOChar = '%'; EndSep: SOChar = '%'): SOString; + + function GetO(const path: SOString): ISuperObject; + procedure PutO(const path: SOString; const Value: ISuperObject); + function GetB(const path: SOString): Boolean; + procedure PutB(const path: SOString; Value: Boolean); + function GetI(const path: SOString): SuperInt; + procedure PutI(const path: SOString; Value: SuperInt); + function GetD(const path: SOString): Double; + procedure PutC(const path: SOString; Value: Currency); + function GetC(const path: SOString): Currency; + procedure PutD(const path: SOString; Value: Double); + function GetS(const path: SOString): SOString; + procedure PutS(const path: SOString; const Value: SOString); +{$IFDEF SUPER_METHOD} + function GetM(const path: SOString): TSuperMethod; + procedure PutM(const path: SOString; Value: TSuperMethod); +{$ENDIF} + function GetA(const path: SOString): TSuperArray; + + // Null Object Design patern + function GetN(const path: SOString): ISuperObject; + procedure PutN(const path: SOString; const Value: ISuperObject); + + // Writers + function Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer; + function SaveTo(stream: TStream; indent: boolean = false; escape: boolean = true): integer; overload; + function SaveTo(const FileName: string; indent: boolean = false; escape: boolean = true): integer; overload; + function SaveTo(socket: longint; indent: boolean = false; escape: boolean = true): integer; overload; + function CalcSize(indent: boolean = false; escape: boolean = true): integer; + + // convert + function AsBoolean: Boolean; + function AsInteger: SuperInt; + function AsDouble: Double; + function AsCurrency: Currency; + function AsString: SOString; + function AsArray: TSuperArray; + function AsObject: TSuperTableString; +{$IFDEF SUPER_METHOD} + function AsMethod: TSuperMethod; +{$ENDIF} + function AsJSon(indent: boolean = false; escape: boolean = true): SOString; + + procedure Clear(all: boolean = false); + procedure Pack(all: boolean = false); + + property N[const path: SOString]: ISuperObject read GetN write PutN; + property O[const path: SOString]: ISuperObject read GetO write PutO; default; + property B[const path: SOString]: boolean read GetB write PutB; + property I[const path: SOString]: SuperInt read GetI write PutI; + property D[const path: SOString]: Double read GetD write PutD; + property C[const path: SOString]: Currency read GetC write PutC; + property S[const path: SOString]: SOString read GetS write PutS; +{$IFDEF SUPER_METHOD} + property M[const path: SOString]: TSuperMethod read GetM write PutM; +{$ENDIF} + property A[const path: SOString]: TSuperArray read GetA; + +{$IFDEF SUPER_METHOD} + function call(const path: SOString; const param: ISuperObject = nil): ISuperObject; overload; + function call(const path, param: SOString): ISuperObject; overload; +{$ENDIF} + // clone a node + function Clone: ISuperObject; + function Delete(const path: SOString): ISuperObject; + // merges tow objects of same type, if reference is true then nodes are not cloned + procedure Merge(const obj: ISuperObject; reference: boolean = false); overload; + procedure Merge(const str: SOString); overload; + + // validate methods + function Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload; + function Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload; + + // compare + function Compare(const obj: ISuperObject): TSuperCompareResult; overload; + function Compare(const str: SOString): TSuperCompareResult; overload; + + // the data type + function IsType(AType: TSuperType): boolean; + property DataType: TSuperType read GetDataType; + property Processing: boolean read GetProcessing write SetProcessing; + + function GetDataPtr: Pointer; + procedure SetDataPtr(const Value: Pointer); + property DataPtr: Pointer read GetDataPtr write SetDataPtr; + end; + + TSuperObject = class(TObject, ISuperObject) + private + FRefCount: Integer; + FProcessing: boolean; + FDataType: TSuperType; + FDataPtr: Pointer; +{.$if true} + FO: record + case TSuperType of + stBoolean: (c_boolean: boolean); + stDouble: (c_double: double); + stCurrency: (c_currency: Currency); + stInt: (c_int: SuperInt); + stObject: (c_object: TSuperTableString); + stArray: (c_array: TSuperArray); +{$IFDEF SUPER_METHOD} + stMethod: (c_method: TSuperMethod); +{$ENDIF} + end; +{.$ifend} + FOString: SOString; + function GetDataType: TSuperType; + function GetDataPtr: Pointer; + procedure SetDataPtr(const Value: Pointer); + protected + function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; + function _AddRef: Integer; virtual; stdcall; + function _Release: Integer; virtual; stdcall; + + function GetO(const path: SOString): ISuperObject; + procedure PutO(const path: SOString; const Value: ISuperObject); + function GetB(const path: SOString): Boolean; + procedure PutB(const path: SOString; Value: Boolean); + function GetI(const path: SOString): SuperInt; + procedure PutI(const path: SOString; Value: SuperInt); + function GetD(const path: SOString): Double; + procedure PutD(const path: SOString; Value: Double); + procedure PutC(const path: SOString; Value: Currency); + function GetC(const path: SOString): Currency; + function GetS(const path: SOString): SOString; + procedure PutS(const path: SOString; const Value: SOString); +{$IFDEF SUPER_METHOD} + function GetM(const path: SOString): TSuperMethod; + procedure PutM(const path: SOString; Value: TSuperMethod); +{$ENDIF} + function GetA(const path: SOString): TSuperArray; + function Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer; virtual; + public + function GetEnumerator: TSuperEnumerator; + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + class function NewInstance: TObject; override; + property RefCount: Integer read FRefCount; + + function GetProcessing: boolean; + procedure SetProcessing(value: boolean); + + // Writers + function SaveTo(stream: TStream; indent: boolean = false; escape: boolean = true): integer; overload; + function SaveTo(const FileName: string; indent: boolean = false; escape: boolean = true): integer; overload; + function SaveTo(socket: longint; indent: boolean = false; escape: boolean = true): integer; overload; + function CalcSize(indent: boolean = false; escape: boolean = true): integer; + function AsJSon(indent: boolean = false; escape: boolean = true): SOString; + + // parser ... owned! + class function ParseString(s: PSOChar; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = []; + const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject; + class function ParseStream(stream: TStream; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = []; + const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject; + class function ParseFile(const FileName: string; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = []; + const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject; + class function ParseEx(tok: TSuperTokenizer; str: PSOChar; len: integer; strict: Boolean; const this: ISuperObject = nil; + options: TSuperFindOptions = []; const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject; + + // constructors / destructor + constructor Create(jt: TSuperType = stObject); overload; virtual; + constructor Create(b: boolean); overload; virtual; + constructor Create(i: SuperInt); overload; virtual; + constructor Create(d: double); overload; virtual; + constructor CreateCurrency(c: Currency); overload; virtual; + constructor Create(const s: SOString); overload; virtual; +{$IFDEF SUPER_METHOD} + constructor Create(m: TSuperMethod); overload; virtual; +{$ENDIF} + destructor Destroy; override; + + // convert + function AsBoolean: Boolean; virtual; + function AsInteger: SuperInt; virtual; + function AsDouble: Double; virtual; + function AsCurrency: Currency; virtual; + function AsString: SOString; virtual; + function AsArray: TSuperArray; virtual; + function AsObject: TSuperTableString; virtual; +{$IFDEF SUPER_METHOD} + function AsMethod: TSuperMethod; virtual; +{$ENDIF} + procedure Clear(all: boolean = false); virtual; + procedure Pack(all: boolean = false); virtual; + function GetN(const path: SOString): ISuperObject; + procedure PutN(const path: SOString; const Value: ISuperObject); + function ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject; + function Format(const str: SOString; BeginSep: SOChar = '%'; EndSep: SOChar = '%'): SOString; + + property N[const path: SOString]: ISuperObject read GetN write PutN; + property O[const path: SOString]: ISuperObject read GetO write PutO; default; + property B[const path: SOString]: boolean read GetB write PutB; + property I[const path: SOString]: SuperInt read GetI write PutI; + property D[const path: SOString]: Double read GetD write PutD; + property C[const path: SOString]: Currency read GetC write PutC; + property S[const path: SOString]: SOString read GetS write PutS; +{$IFDEF SUPER_METHOD} + property M[const path: SOString]: TSuperMethod read GetM write PutM; +{$ENDIF} + property A[const path: SOString]: TSuperArray read GetA; + +{$IFDEF SUPER_METHOD} + function call(const path: SOString; const param: ISuperObject = nil): ISuperObject; overload; virtual; + function call(const path, param: SOString): ISuperObject; overload; virtual; +{$ENDIF} + // clone a node + function Clone: ISuperObject; virtual; + function Delete(const path: SOString): ISuperObject; + // merges tow objects of same type, if reference is true then nodes are not cloned + procedure Merge(const obj: ISuperObject; reference: boolean = false); overload; + procedure Merge(const str: SOString); overload; + + // validate methods + function Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload; + function Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload; + + // compare + function Compare(const obj: ISuperObject): TSuperCompareResult; overload; + function Compare(const str: SOString): TSuperCompareResult; overload; + + // the data type + function IsType(AType: TSuperType): boolean; + property DataType: TSuperType read GetDataType; + // a data pointer to link to something ele, a treeview for example + property DataPtr: Pointer read GetDataPtr write SetDataPtr; + property Processing: boolean read GetProcessing; + end; + +{$IFDEF HAVE_RTTI} + TSuperRttiContext = class; + + TSerialFromJson = function(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean; + TSerialToJson = function(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject; + + TSuperAttribute = class(TCustomAttribute) + private + FName: string; + public + constructor Create(const AName: string); + property Name: string read FName; + end; + + SOName = class(TSuperAttribute); + SODefault = class(TSuperAttribute); + + + TSuperRttiContext = class + private + class function GetFieldName(r: TRttiField): string; + class function GetFieldDefault(r: TRttiField; const obj: ISuperObject): ISuperObject; + public + Context: TRttiContext; + SerialFromJson: TDictionary; + SerialToJson: TDictionary; + constructor Create; virtual; + destructor Destroy; override; + function FromJson(TypeInfo: PTypeInfo; const obj: ISuperObject; var Value: TValue): Boolean; virtual; + function ToJson(var value: TValue; const index: ISuperObject): ISuperObject; virtual; + function AsType(const obj: ISuperObject): T; + function AsJson(const obj: T; const index: ISuperObject = nil): ISuperObject; + end; + + TSuperObjectHelper = class helper for TObject + public + function ToJson(ctx: TSuperRttiContext = nil): ISuperObject; + constructor FromJson(const obj: ISuperObject; ctx: TSuperRttiContext = nil); overload; + constructor FromJson(const str: string; ctx: TSuperRttiContext = nil); overload; + end; +{$ENDIF} + + TSuperObjectIter = record + key: SOString; + val: ISuperObject; + Ite: TSuperAvlIterator; + end; + +function ObjectIsError(obj: TSuperObject): boolean; +function ObjectIsType(const obj: ISuperObject; typ: TSuperType): boolean; +function ObjectGetType(const obj: ISuperObject): TSuperType; + +function ObjectFindFirst(const obj: ISuperObject; var F: TSuperObjectIter): boolean; +function ObjectFindNext(var F: TSuperObjectIter): boolean; +procedure ObjectFindClose(var F: TSuperObjectIter); + +function SO(const s: SOString = '{}'): ISuperObject; overload; +function SO(const value: Variant): ISuperObject; overload; +function SO(const Args: array of const): ISuperObject; overload; + +function SA(const Args: array of const): ISuperObject; overload; + +function JavaToDelphiDateTime(const dt: int64): TDateTime; +function DelphiToJavaDateTime(const dt: TDateTime): int64; +function TryObjectToDate(const obj: ISuperObject; var dt: TDateTime): Boolean; +function ISO8601DateToJavaDateTime(const str: SOString; var ms: Int64): Boolean; +function ISO8601DateToDelphiDateTime(const str: SOString; var dt: TDateTime): Boolean; +function DelphiDateTimeToISO8601Date(dt: TDateTime): SOString; +{$IFDEF HAVE_RTTI} +function UUIDToString(const g: TGUID): string; +function StringToUUID(const str: string; var g: TGUID): Boolean; + + +type + TSuperInvokeResult = ( + irSuccess, + irMethothodError, // method don't exist + irParamError, // invalid parametters + irError // other error + ); + +function TrySOInvoke(var ctx: TSuperRttiContext; const obj: TValue; const method: string; const params: ISuperObject; var Return: ISuperObject): TSuperInvokeResult; overload; +function SOInvoke(const obj: TValue; const method: string; const params: ISuperObject; ctx: TSuperRttiContext = nil): ISuperObject; overload; +function SOInvoke(const obj: TValue; const method: string; const params: string; ctx: TSuperRttiContext = nil): ISuperObject; overload; +{$ENDIF} + +implementation +uses sysutils, +{$IFDEF UNIX} + baseunix, unix, DateUtils +{$ELSE} + Windows +{$ENDIF} +{$IFDEF FPC} + ,sockets +{$ELSE} + ,WinSock +{$ENDIF}; + +{$IFDEF DEBUG} +var + debugcount: integer = 0; +{$ENDIF} + +const + super_number_chars_set = ['0'..'9','.','+','-','e','E']; + super_hex_chars: PSOChar = '0123456789abcdef'; + super_hex_chars_set = ['0'..'9','a'..'f','A'..'F']; + + ESC_BS: PSOChar = '\b'; + ESC_LF: PSOChar = '\n'; + ESC_CR: PSOChar = '\r'; + ESC_TAB: PSOChar = '\t'; + ESC_FF: PSOChar = '\f'; + ESC_QUOT: PSOChar = '\"'; + ESC_SL: PSOChar = '\\'; + ESC_SR: PSOChar = '\/'; + ESC_ZERO: PSOChar = '\u0000'; + + TOK_CRLF: PSOChar = #13#10; + TOK_SP: PSOChar = #32; + TOK_BS: PSOChar = #8; + TOK_TAB: PSOChar = #9; + TOK_LF: PSOChar = #10; + TOK_FF: PSOChar = #12; + TOK_CR: PSOChar = #13; +// TOK_SL: PSOChar = '\'; +// TOK_SR: PSOChar = '/'; + TOK_NULL: PSOChar = 'null'; + TOK_CBL: PSOChar = '{'; // curly bracket left + TOK_CBR: PSOChar = '}'; // curly bracket right + TOK_ARL: PSOChar = '['; + TOK_ARR: PSOChar = ']'; + TOK_ARRAY: PSOChar = '[]'; + TOK_OBJ: PSOChar = '{}'; // empty object + TOK_COM: PSOChar = ','; // Comma + TOK_DQT: PSOChar = '"'; // Double Quote + TOK_TRUE: PSOChar = 'true'; + TOK_FALSE: PSOChar = 'false'; + +{$if (sizeof(Char) = 1)} +function StrLComp(const Str1, Str2: PSOChar; MaxLen: Cardinal): Integer; +var + P1, P2: PWideChar; + I: Cardinal; + C1, C2: WideChar; +begin + P1 := Str1; + P2 := Str2; + I := 0; + while I < MaxLen do + begin + C1 := P1^; + C2 := P2^; + + if (C1 <> C2) or (C1 = #0) then + begin + Result := Ord(C1) - Ord(C2); + Exit; + end; + + Inc(P1); + Inc(P2); + Inc(I); + end; + Result := 0; +end; + +function StrComp(const Str1, Str2: PSOChar): Integer; +var + P1, P2: PWideChar; + C1, C2: WideChar; +begin + P1 := Str1; + P2 := Str2; + while True do + begin + C1 := P1^; + C2 := P2^; + + if (C1 <> C2) or (C1 = #0) then + begin + Result := Ord(C1) - Ord(C2); + Exit; + end; + + Inc(P1); + Inc(P2); + end; +end; + +function StrLen(const Str: PSOChar): Cardinal; +var + p: PSOChar; +begin + Result := 0; + if Str <> nil then + begin + p := Str; + while p^ <> #0 do inc(p); + Result := (p - Str); + end; +end; +{$ifend} + +function FloatToJson(const value: Double): SOString; +var + p: PSOChar; +begin + Result := FloatToStr(value); + if DecimalSeparator <> '.' then + begin + p := PSOChar(Result); + while p^ <> #0 do + if p^ <> SOChar(DecimalSeparator) then + inc(p) else + begin + p^ := '.'; + Exit; + end; + end; +end; + +function CurrToJson(const value: Currency): SOString; +var + p: PSOChar; +begin + Result := CurrToStr(value); + if DecimalSeparator <> '.' then + begin + p := PSOChar(Result); + while p^ <> #0 do + if p^ <> SOChar(DecimalSeparator) then + inc(p) else + begin + p^ := '.'; + Exit; + end; + end; +end; + +{$IFDEF UNIX} +function GetTimeBias: integer; +var + TimeVal: TTimeVal; + TimeZone: TTimeZone; +begin + fpGetTimeOfDay(@TimeVal, @TimeZone); + Result := TimeZone.tz_minuteswest; +end; +{$ELSE} +function GetTimeBias: integer; +var + tzi : TTimeZoneInformation; +begin + case GetTimeZoneInformation(tzi) of + TIME_ZONE_ID_UNKNOWN : Result := tzi.Bias; + TIME_ZONE_ID_STANDARD: Result := tzi.Bias + tzi.StandardBias; + TIME_ZONE_ID_DAYLIGHT: Result := tzi.Bias + tzi.DaylightBias; + else + Result := 0; + end; +end; +{$ENDIF} + +{$IFDEF UNIX} +type + ptm = ^tm; + tm = record + tm_sec: Integer; (* Seconds: 0-59 (K&R says 0-61?) *) + tm_min: Integer; (* Minutes: 0-59 *) + tm_hour: Integer; (* Hours since midnight: 0-23 *) + tm_mday: Integer; (* Day of the month: 1-31 *) + tm_mon: Integer; (* Months *since* january: 0-11 *) + tm_year: Integer; (* Years since 1900 *) + tm_wday: Integer; (* Days since Sunday (0-6) *) + tm_yday: Integer; (* Days since Jan. 1: 0-365 *) + tm_isdst: Integer; (* +1 Daylight Savings Time, 0 No DST, -1 don't know *) + end; + +function mktime(p: ptm): LongInt; cdecl; external; +function gmtime(const t: PLongint): ptm; cdecl; external; +function localtime (const t: PLongint): ptm; cdecl; external; + +function DelphiToJavaDateTime(const dt: TDateTime): Int64; +var + p: ptm; + l, ms: Integer; + v: Int64; +begin + v := Round((dt - 25569) * 86400000); + ms := v mod 1000; + l := v div 1000; + p := localtime(@l); + Result := Int64(mktime(p)) * 1000 + ms; +end; + +function JavaToDelphiDateTime(const dt: int64): TDateTime; +var + p: ptm; + l, ms: Integer; +begin + l := dt div 1000; + ms := dt mod 1000; + p := gmtime(@l); + Result := EncodeDateTime(p^.tm_year+1900, p^.tm_mon+1, p^.tm_mday, p^.tm_hour, p^.tm_min, p^.tm_sec, ms); +end; +{$ELSE} + +{$IFDEF WINDOWSNT_COMPATIBILITY} +function DayLightCompareDate(const date: PSystemTime; + const compareDate: PSystemTime): Integer; +var + limit_day, dayinsecs, weekofmonth: Integer; + First: Word; +begin + if (date^.wMonth < compareDate^.wMonth) then + begin + Result := -1; (* We are in a month before the date limit. *) + Exit; + end; + + if (date^.wMonth > compareDate^.wMonth) then + begin + Result := 1; (* We are in a month after the date limit. *) + Exit; + end; + + (* if year is 0 then date is in day-of-week format, otherwise + * it's absolute date. + *) + if (compareDate^.wYear = 0) then + begin + (* compareDate.wDay is interpreted as number of the week in the month + * 5 means: the last week in the month *) + weekofmonth := compareDate^.wDay; + (* calculate the day of the first DayOfWeek in the month *) + First := (6 + compareDate^.wDayOfWeek - date^.wDayOfWeek + date^.wDay) mod 7 + 1; + limit_day := First + 7 * (weekofmonth - 1); + (* check needed for the 5th weekday of the month *) + if (limit_day > MonthDays[(date^.wMonth=2) and IsLeapYear(date^.wYear)][date^.wMonth]) then + dec(limit_day, 7); + end + else + limit_day := compareDate^.wDay; + + (* convert to seconds *) + limit_day := ((limit_day * 24 + compareDate^.wHour) * 60 + compareDate^.wMinute ) * 60; + dayinsecs := ((date^.wDay * 24 + date^.wHour) * 60 + date^.wMinute ) * 60 + date^.wSecond; + (* and compare *) + + if dayinsecs < limit_day then + Result := -1 else + if dayinsecs > limit_day then + Result := 1 else + Result := 0; (* date is equal to the date limit. *) +end; + +function CompTimeZoneID(const pTZinfo: PTimeZoneInformation; + lpFileTime: PFileTime; islocal: Boolean): LongWord; +var + ret: Integer; + beforeStandardDate, afterDaylightDate: Boolean; + llTime: Int64; + SysTime: TSystemTime; + ftTemp: TFileTime; +begin + llTime := 0; + + if (pTZinfo^.DaylightDate.wMonth <> 0) then + begin + (* if year is 0 then date is in day-of-week format, otherwise + * it's absolute date. + *) + if ((pTZinfo^.StandardDate.wMonth = 0) or + ((pTZinfo^.StandardDate.wYear = 0) and + ((pTZinfo^.StandardDate.wDay < 1) or + (pTZinfo^.StandardDate.wDay > 5) or + (pTZinfo^.DaylightDate.wDay < 1) or + (pTZinfo^.DaylightDate.wDay > 5)))) then + begin + SetLastError(ERROR_INVALID_PARAMETER); + Result := TIME_ZONE_ID_INVALID; + Exit; + end; + + if (not islocal) then + begin + llTime := PInt64(lpFileTime)^; + dec(llTime, Int64(pTZinfo^.Bias + pTZinfo^.DaylightBias) * 600000000); + PInt64(@ftTemp)^ := llTime; + lpFileTime := @ftTemp; + end; + + FileTimeToSystemTime(lpFileTime^, SysTime); + + (* check for daylight savings *) + ret := DayLightCompareDate(@SysTime, @pTZinfo^.StandardDate); + if (ret = -2) then + begin + Result := TIME_ZONE_ID_INVALID; + Exit; + end; + + beforeStandardDate := ret < 0; + + if (not islocal) then + begin + dec(llTime, Int64(pTZinfo^.StandardBias - pTZinfo^.DaylightBias) * 600000000); + PInt64(@ftTemp)^ := llTime; + FileTimeToSystemTime(lpFileTime^, SysTime); + end; + + ret := DayLightCompareDate(@SysTime, @pTZinfo^.DaylightDate); + if (ret = -2) then + begin + Result := TIME_ZONE_ID_INVALID; + Exit; + end; + + afterDaylightDate := ret >= 0; + + Result := TIME_ZONE_ID_STANDARD; + if( pTZinfo^.DaylightDate.wMonth < pTZinfo^.StandardDate.wMonth ) then + begin + (* Northern hemisphere *) + if( beforeStandardDate and afterDaylightDate) then + Result := TIME_ZONE_ID_DAYLIGHT; + end else (* Down south *) + if( beforeStandardDate or afterDaylightDate) then + Result := TIME_ZONE_ID_DAYLIGHT; + end else + (* No transition date *) + Result := TIME_ZONE_ID_UNKNOWN; +end; + +function GetTimezoneBias(const pTZinfo: PTimeZoneInformation; + lpFileTime: PFileTime; islocal: Boolean; pBias: PLongint): Boolean; +var + bias: LongInt; + tzid: LongWord; +begin + bias := pTZinfo^.Bias; + tzid := CompTimeZoneID(pTZinfo, lpFileTime, islocal); + + if( tzid = TIME_ZONE_ID_INVALID) then + begin + Result := False; + Exit; + end; + if (tzid = TIME_ZONE_ID_DAYLIGHT) then + inc(bias, pTZinfo^.DaylightBias) + else if (tzid = TIME_ZONE_ID_STANDARD) then + inc(bias, pTZinfo^.StandardBias); + pBias^ := bias; + Result := True; +end; + +function SystemTimeToTzSpecificLocalTime( + lpTimeZoneInformation: PTimeZoneInformation; + lpUniversalTime, lpLocalTime: PSystemTime): BOOL; +var + ft: TFileTime; + lBias: LongInt; + llTime: Int64; + tzinfo: TTimeZoneInformation; +begin + if (lpTimeZoneInformation <> nil) then + tzinfo := lpTimeZoneInformation^ else + if (GetTimeZoneInformation(tzinfo) = TIME_ZONE_ID_INVALID) then + begin + Result := False; + Exit; + end; + + if (not SystemTimeToFileTime(lpUniversalTime^, ft)) then + begin + Result := False; + Exit; + end; + llTime := PInt64(@ft)^; + if (not GetTimezoneBias(@tzinfo, @ft, False, @lBias)) then + begin + Result := False; + Exit; + end; + (* convert minutes to 100-nanoseconds-ticks *) + dec(llTime, Int64(lBias) * 600000000); + PInt64(@ft)^ := llTime; + Result := FileTimeToSystemTime(ft, lpLocalTime^); +end; + +function TzSpecificLocalTimeToSystemTime( + const lpTimeZoneInformation: PTimeZoneInformation; + const lpLocalTime: PSystemTime; lpUniversalTime: PSystemTime): BOOL; +var + ft: TFileTime; + lBias: LongInt; + t: Int64; + tzinfo: TTimeZoneInformation; +begin + if (lpTimeZoneInformation <> nil) then + tzinfo := lpTimeZoneInformation^ + else + if (GetTimeZoneInformation(tzinfo) = TIME_ZONE_ID_INVALID) then + begin + Result := False; + Exit; + end; + + if (not SystemTimeToFileTime(lpLocalTime^, ft)) then + begin + Result := False; + Exit; + end; + t := PInt64(@ft)^; + if (not GetTimezoneBias(@tzinfo, @ft, True, @lBias)) then + begin + Result := False; + Exit; + end; + (* convert minutes to 100-nanoseconds-ticks *) + inc(t, Int64(lBias) * 600000000); + PInt64(@ft)^ := t; + Result := FileTimeToSystemTime(ft, lpUniversalTime^); +end; +{$ELSE} +function TzSpecificLocalTimeToSystemTime( + lpTimeZoneInformation: PTimeZoneInformation; + lpLocalTime, lpUniversalTime: PSystemTime): BOOL; stdcall; external 'kernel32.dll'; + +function SystemTimeToTzSpecificLocalTime( + lpTimeZoneInformation: PTimeZoneInformation; + lpUniversalTime, lpLocalTime: PSystemTime): BOOL; stdcall; external 'kernel32.dll'; +{$ENDIF} + +function JavaToDelphiDateTime(const dt: int64): TDateTime; +var + t: TSystemTime; +begin + DateTimeToSystemTime(25569 + (dt / 86400000), t); + SystemTimeToTzSpecificLocalTime(nil, @t, @t); + Result := SystemTimeToDateTime(t); +end; + +function DelphiToJavaDateTime(const dt: TDateTime): int64; +var + t: TSystemTime; +begin + DateTimeToSystemTime(dt, t); + TzSpecificLocalTimeToSystemTime(nil, @t, @t); + Result := Round((SystemTimeToDateTime(t) - 25569) * 86400000) +end; +{$ENDIF} + +function ISO8601DateToJavaDateTime(const str: SOString; var ms: Int64): Boolean; +type + TState = ( + stStart, stYear, stMonth, stWeek, stWeekDay, stDay, stDayOfYear, + stHour, stMin, stSec, stMs, stUTC, stGMTH, stGMTM, + stGMTend, stEnd); + + TPerhaps = (yes, no, perhaps); + TDateTimeInfo = record + year: Word; + month: Word; + week: Word; + weekday: Word; + day: Word; + dayofyear: Integer; + hour: Word; + minute: Word; + second: Word; + ms: Word; + bias: Integer; + end; + +var + p: PSOChar; + state: TState; + pos, v: Word; + sep: TPerhaps; + inctz, havetz, havedate: Boolean; + st: TDateTimeInfo; + DayTable: PDayTable; + + function get(var v: Word; c: SOChar): Boolean; {$IFDEF HAVE_INLINE} inline;{$ENDIF} + begin + if (c < #256) and (AnsiChar(c) in ['0'..'9']) then + begin + Result := True; + v := v * 10 + Ord(c) - Ord('0'); + end else + Result := False; + end; + +label + error; +begin + p := PSOChar(str); + sep := perhaps; + state := stStart; + pos := 0; + FillChar(st, SizeOf(st), 0); + havedate := True; + inctz := False; + havetz := False; + + while true do + case state of + stStart: + case p^ of + '0'..'9': state := stYear; + 'T', 't': + begin + state := stHour; + pos := 0; + inc(p); + havedate := False; + end; + else + goto error; + end; + stYear: + case pos of + 0..1,3: + if get(st.year, p^) then + begin + Inc(pos); + Inc(p); + end else + goto error; + 2: case p^ of + '0'..'9': + begin + st.year := st.year * 10 + ord(p^) - ord('0'); + Inc(pos); + Inc(p); + end; + ':': + begin + havedate := false; + st.hour := st.year; + st.year := 0; + inc(p); + pos := 0; + state := stMin; + sep := yes; + end; + else + goto error; + end; + 4: case p^ of + '-': begin + pos := 0; + Inc(p); + sep := yes; + state := stMonth; + end; + '0'..'9': + begin + sep := no; + pos := 0; + state := stMonth; + end; + 'W', 'w' : + begin + pos := 0; + Inc(p); + state := stWeek; + end; + 'T', 't', ' ': + begin + state := stHour; + pos := 0; + inc(p); + st.month := 1; + st.day := 1; + end; + #0: + begin + st.month := 1; + st.day := 1; + state := stEnd; + end; + else + goto error; + end; + end; + stMonth: + case pos of + 0: case p^ of + '0'..'9': + begin + st.month := ord(p^) - ord('0'); + Inc(pos); + Inc(p); + end; + 'W', 'w': + begin + pos := 0; + Inc(p); + state := stWeek; + end; + else + goto error; + end; + 1: if get(st.month, p^) then + begin + Inc(pos); + Inc(p); + end else + goto error; + 2: case p^ of + '-': + if (sep in [yes, perhaps]) then + begin + pos := 0; + Inc(p); + state := stDay; + sep := yes; + end else + goto error; + '0'..'9': + if sep in [no, perhaps] then + begin + pos := 0; + state := stDay; + sep := no; + end else + begin + st.dayofyear := st.month * 10 + Ord(p^) - Ord('0'); + st.month := 0; + inc(p); + pos := 3; + state := stDayOfYear; + end; + 'T', 't', ' ': + begin + state := stHour; + pos := 0; + inc(p); + st.day := 1; + end; + #0: + begin + st.day := 1; + state := stEnd; + end; + else + goto error; + end; + end; + stDay: + case pos of + 0: if get(st.day, p^) then + begin + Inc(pos); + Inc(p); + end else + goto error; + 1: if get(st.day, p^) then + begin + Inc(pos); + Inc(p); + end else + if sep in [no, perhaps] then + begin + st.dayofyear := st.month * 10 + st.day; + st.day := 0; + st.month := 0; + state := stDayOfYear; + end else + goto error; + + 2: case p^ of + 'T', 't', ' ': + begin + pos := 0; + Inc(p); + state := stHour; + end; + #0: state := stEnd; + else + goto error; + end; + end; + stDayOfYear: + begin + if (st.dayofyear <= 0) then goto error; + case p^ of + 'T', 't', ' ': + begin + pos := 0; + Inc(p); + state := stHour; + end; + #0: state := stEnd; + else + goto error; + end; + end; + stWeek: + begin + case pos of + 0..1: if get(st.week, p^) then + begin + inc(pos); + inc(p); + end else + goto error; + 2: case p^ of + '-': if (sep in [yes, perhaps]) then + begin + Inc(p); + state := stWeekDay; + sep := yes; + end else + goto error; + '1'..'7': + if sep in [no, perhaps] then + begin + state := stWeekDay; + sep := no; + end else + goto error; + else + goto error; + end; + end; + end; + stWeekDay: + begin + if (st.week > 0) and get(st.weekday, p^) then + begin + inc(p); + v := st.year - 1; + v := ((v * 365) + (v div 4) - (v div 100) + (v div 400)) mod 7 + 1; + st.dayofyear := (st.weekday - v) + ((st.week) * 7) + 1; + if v <= 4 then dec(st.dayofyear, 7); + case p^ of + 'T', 't', ' ': + begin + pos := 0; + Inc(p); + state := stHour; + end; + #0: state := stEnd; + else + goto error; + end; + end else + goto error; + end; + stHour: + case pos of + 0: case p^ of + '0'..'9': + if get(st.hour, p^) then + begin + inc(pos); + inc(p); + end else + goto error; + '-': + begin + inc(p); + state := stMin; + end; + else + goto error; + end; + 1: if get(st.hour, p^) then + begin + inc(pos); + inc(p); + end else + goto error; + 2: case p^ of + ':': if sep in [yes, perhaps] then + begin + sep := yes; + pos := 0; + Inc(p); + state := stMin; + end else + goto error; + ',': + begin + Inc(p); + state := stMs; + end; + '+': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + end else + goto error; + '-': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + inctz := True; + end else + goto error; + 'Z', 'z': + if havedate then + state := stUTC else + goto error; + '0'..'9': + if sep in [no, perhaps] then + begin + pos := 0; + state := stMin; + sep := no; + end else + goto error; + #0: state := stEnd; + else + goto error; + end; + end; + stMin: + case pos of + 0: case p^ of + '0'..'9': + if get(st.minute, p^) then + begin + inc(pos); + inc(p); + end else + goto error; + '-': + begin + inc(p); + state := stSec; + end; + else + goto error; + end; + 1: if get(st.minute, p^) then + begin + inc(pos); + inc(p); + end else + goto error; + 2: case p^ of + ':': if sep in [yes, perhaps] then + begin + pos := 0; + Inc(p); + state := stSec; + sep := yes; + end else + goto error; + ',': + begin + Inc(p); + state := stMs; + end; + '+': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + end else + goto error; + '-': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + inctz := True; + end else + goto error; + 'Z', 'z': + if havedate then + state := stUTC else + goto error; + '0'..'9': + if sep in [no, perhaps] then + begin + pos := 0; + state := stSec; + end else + goto error; + #0: state := stEnd; + else + goto error; + end; + end; + stSec: + case pos of + 0..1: if get(st.second, p^) then + begin + inc(pos); + inc(p); + end else + goto error; + 2: case p^ of + ',': + begin + Inc(p); + state := stMs; + end; + '+': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + end else + goto error; + '-': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + inctz := True; + end else + goto error; + 'Z', 'z': + if havedate then + state := stUTC else + goto error; + #0: state := stEnd; + else + goto error; + end; + end; + stMs: + case p^ of + '0'..'9': + begin + st.ms := st.ms * 10 + ord(p^) - ord('0'); + inc(p); + end; + '+': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + end else + goto error; + '-': + if havedate then + begin + state := stGMTH; + pos := 0; + v := 0; + inc(p); + inctz := True; + end else + goto error; + 'Z', 'z': + if havedate then + state := stUTC else + goto error; + #0: state := stEnd; + else + goto error; + end; + stUTC: // = GMT 0 + begin + havetz := True; + inc(p); + if p^ = #0 then + Break else + goto error; + end; + stGMTH: + begin + havetz := True; + case pos of + 0..1: if get(v, p^) then + begin + inc(p); + inc(pos); + end else + goto error; + 2: + begin + st.bias := v * 60; + case p^ of + ':': if sep in [yes, perhaps] then + begin + state := stGMTM; + inc(p); + pos := 0; + v := 0; + sep := yes; + end else + goto error; + '0'..'9': + if sep in [no, perhaps] then + begin + state := stGMTM; + pos := 1; + sep := no; + inc(p); + v := ord(p^) - ord('0'); + end else + goto error; + #0: state := stGMTend; + else + goto error; + end; + + end; + end; + end; + stGMTM: + case pos of + 0..1: if get(v, p^) then + begin + inc(p); + inc(pos); + end else + goto error; + 2: case p^ of + #0: + begin + state := stGMTend; + inc(st.Bias, v); + end; + else + goto error; + end; + end; + stGMTend: + begin + if not inctz then + st.Bias := -st.bias; + Break; + end; + stEnd: + begin + + Break; + end; + end; + + if (st.hour >= 24) or (st.minute >= 60) or (st.second >= 60) or (st.ms >= 1000) or (st.week > 53) + then goto error; + + if not havetz then + st.bias := GetTimeBias; + + ms := st.ms + st.second * 1000 + (st.minute + st.bias) * 60000 + st.hour * 3600000; + if havedate then + begin + DayTable := @MonthDays[IsLeapYear(st.year)]; + if st.month <> 0 then + begin + if not (st.month in [1..12]) or (DayTable^[st.month] < st.day) then + goto error; + + for v := 1 to st.month - 1 do + Inc(ms, DayTable^[v] * 86400000); + end; + dec(st.year); + ms := ms + (int64((st.year * 365) + (st.year div 4) - (st.year div 100) + + (st.year div 400) + st.day + st.dayofyear - 719163) * 86400000); + end; + + Result := True; + Exit; +error: + Result := False; +end; + +function ISO8601DateToDelphiDateTime(const str: SOString; var dt: TDateTime): Boolean; +var + ms: Int64; +begin + Result := ISO8601DateToJavaDateTime(str, ms); + if Result then + dt := JavaToDelphiDateTime(ms) +end; + +function DelphiDateTimeToISO8601Date(dt: TDateTime): SOString; +var + year, month, day, hour, min, sec, msec: Word; + tzh: SmallInt; + tzm: Word; + sign: SOChar; + bias: Integer; +begin + DecodeDate(dt, year, month, day); + DecodeTime(dt, hour, min, sec, msec); + bias := GetTimeBias; + tzh := Abs(bias) div 60; + tzm := Abs(bias) - tzh * 60; + if Bias > 0 then + sign := '-' else + sign := '+'; + Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d,%d%s%.2d:%.2d', + [year, month, day, hour, min, sec, msec, sign, tzh, tzm]); +end; + +function TryObjectToDate(const obj: ISuperObject; var dt: TDateTime): Boolean; +var + i: Int64; +begin + case ObjectGetType(obj) of + stInt: + begin + dt := JavaToDelphiDateTime(obj.AsInteger); + Result := True; + end; + stString: + begin + if ISO8601DateToJavaDateTime(obj.AsString, i) then + begin + dt := JavaToDelphiDateTime(i); + Result := True; + end else + Result := TryStrToDateTime(obj.AsString, dt); + end; + else + Result := False; + end; +end; + +function SO(const s: SOString): ISuperObject; overload; +begin + Result := TSuperObject.ParseString(PSOChar(s), False); +end; + +function SA(const Args: array of const): ISuperObject; overload; +type + TByteArray = array[0..sizeof(integer) - 1] of byte; + PByteArray = ^TByteArray; +var + j: Integer; + intf: IInterface; +begin + Result := TSuperObject.Create(stArray); + for j := 0 to length(Args) - 1 do + with Result.AsArray do + case TVarRec(Args[j]).VType of + vtInteger : Add(TSuperObject.Create(TVarRec(Args[j]).VInteger)); + vtInt64 : Add(TSuperObject.Create(TVarRec(Args[j]).VInt64^)); + vtBoolean : Add(TSuperObject.Create(TVarRec(Args[j]).VBoolean)); + vtChar : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VChar))); + vtWideChar: Add(TSuperObject.Create(SOChar(TVarRec(Args[j]).VWideChar))); + vtExtended: Add(TSuperObject.Create(TVarRec(Args[j]).VExtended^)); + vtCurrency: Add(TSuperObject.CreateCurrency(TVarRec(Args[j]).VCurrency^)); + vtString : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VString^))); + vtPChar : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VPChar^))); + vtAnsiString: Add(TSuperObject.Create(SOString(AnsiString(TVarRec(Args[j]).VAnsiString)))); + vtWideString: Add(TSuperObject.Create(SOString(PWideChar(TVarRec(Args[j]).VWideString)))); + vtInterface: + if TVarRec(Args[j]).VInterface = nil then + Add(nil) else + if IInterface(TVarRec(Args[j]).VInterface).QueryInterface(ISuperObject, intf) = 0 then + Add(ISuperObject(intf)) else + Add(nil); + vtPointer : + if TVarRec(Args[j]).VPointer = nil then + Add(nil) else + Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer))); + vtVariant: + Add(SO(TVarRec(Args[j]).VVariant^)); + vtObject: + if TVarRec(Args[j]).VPointer = nil then + Add(nil) else + Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer))); + vtClass: + if TVarRec(Args[j]).VPointer = nil then + Add(nil) else + Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer))); +{$if declared(vtUnicodeString)} + vtUnicodeString: + Add(TSuperObject.Create(SOString(string(TVarRec(Args[j]).VUnicodeString)))); +{$ifend} + else + assert(false); + end; +end; + +function SO(const Args: array of const): ISuperObject; overload; +var + j: Integer; + arr: ISuperObject; +begin + Result := TSuperObject.Create(stObject); + arr := SA(Args); + with arr.AsArray do + for j := 0 to (Length div 2) - 1 do + Result.AsObject.PutO(O[j*2].AsString, O[(j*2) + 1]); +end; + +function SO(const value: Variant): ISuperObject; overload; +begin + with TVarData(value) do + case VType of + varNull: Result := nil; + varEmpty: Result := nil; + varSmallInt: Result := TSuperObject.Create(VSmallInt); + varInteger: Result := TSuperObject.Create(VInteger); + varSingle: Result := TSuperObject.Create(VSingle); + varDouble: Result := TSuperObject.Create(VDouble); + varCurrency: Result := TSuperObject.CreateCurrency(VCurrency); + varDate: Result := TSuperObject.Create(DelphiToJavaDateTime(vDate)); + varOleStr: Result := TSuperObject.Create(SOString(VOleStr)); + varBoolean: Result := TSuperObject.Create(VBoolean); + varShortInt: Result := TSuperObject.Create(VShortInt); + varByte: Result := TSuperObject.Create(VByte); + varWord: Result := TSuperObject.Create(VWord); + varLongWord: Result := TSuperObject.Create(VLongWord); + varInt64: Result := TSuperObject.Create(VInt64); + varString: Result := TSuperObject.Create(SOString(AnsiString(VString))); +{$if declared(varUString)} + varUString: Result := TSuperObject.Create(SOString(string(VUString))); +{$ifend} + else + raise Exception.CreateFmt('Unsuported variant data type: %d', [VType]); + end; +end; + +function ObjectIsError(obj: TSuperObject): boolean; +begin + Result := PtrUInt(obj) > PtrUInt(-4000); +end; + +function ObjectIsType(const obj: ISuperObject; typ: TSuperType): boolean; +begin + if obj <> nil then + Result := typ = obj.DataType else + Result := typ = stNull; +end; + +function ObjectGetType(const obj: ISuperObject): TSuperType; +begin + if obj <> nil then + Result := obj.DataType else + Result := stNull; +end; + +function ObjectFindFirst(const obj: ISuperObject; var F: TSuperObjectIter): boolean; +var + i: TSuperAvlEntry; +begin + if ObjectIsType(obj, stObject) then + begin + F.Ite := TSuperAvlIterator.Create(obj.AsObject); + F.Ite.First; + i := F.Ite.GetIter; + if i <> nil then + begin + f.key := i.Name; + f.val := i.Value; + Result := true; + end else + Result := False; + end else + Result := False; +end; + +function ObjectFindNext(var F: TSuperObjectIter): boolean; +var + i: TSuperAvlEntry; +begin + F.Ite.Next; + i := F.Ite.GetIter; + if i <> nil then + begin + f.key := i.FName; + f.val := i.Value; + Result := true; + end else + Result := False; +end; + +procedure ObjectFindClose(var F: TSuperObjectIter); +begin + F.Ite.Free; + F.val := nil; +end; + +{$IFDEF HAVE_RTTI} + +function serialtoboolean(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject; +begin + Result := TSuperObject.Create(TValueData(value).FAsSLong <> 0); +end; + +function serialtodatetime(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject; +begin + Result := TSuperObject.Create(DelphiToJavaDateTime(TValueData(value).FAsDouble)); +end; + +function serialtoguid(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject; +var + g: TGUID; +begin + value.ExtractRawData(@g); + Result := TSuperObject.Create( + format('%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x', + [g.D1, g.D2, g.D3, + g.D4[0], g.D4[1], g.D4[2], + g.D4[3], g.D4[4], g.D4[5], + g.D4[6], g.D4[7]]) + ); +end; + +function serialfromboolean(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean; +var + o: ISuperObject; +begin + case ObjectGetType(obj) of + stBoolean: + begin + TValueData(Value).FAsSLong := obj.AsInteger; + Result := True; + end; + stInt: + begin + TValueData(Value).FAsSLong := ord(obj.AsInteger <> 0); + Result := True; + end; + stString: + begin + o := SO(obj.AsString); + if not ObjectIsType(o, stString) then + Result := serialfromboolean(ctx, SO(obj.AsString), Value) else + Result := False; + end; + else + Result := False; + end; +end; + +function serialfromdatetime(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean; +var + dt: TDateTime; + i: Int64; +begin + case ObjectGetType(obj) of + stInt: + begin + TValueData(Value).FAsDouble := JavaToDelphiDateTime(obj.AsInteger); + Result := True; + end; + stString: + begin + if ISO8601DateToJavaDateTime(obj.AsString, i) then + begin + TValueData(Value).FAsDouble := JavaToDelphiDateTime(i); + Result := True; + end else + if TryStrToDateTime(obj.AsString, dt) then + begin + TValueData(Value).FAsDouble := dt; + Result := True; + end else + Result := False; + end; + else + Result := False; + end; +end; + +function UuidFromString(p: PSOChar; Uuid: PGUID): Boolean; +const + hex2bin: array[#48..#102] of Byte = ( + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, + 0,10,11,12,13,14,15, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0,10,11,12,13,14,15); +type + TState = (stEatSpaces, stStart, stHEX, stBracket, stEnd); + TUUID = record + case byte of + 0: (guid: TGUID); + 1: (bytes: array[0..15] of Byte); + 2: (words: array[0..7] of Word); + 3: (ints: array[0..3] of Cardinal); + 4: (i64s: array[0..1] of UInt64); + end; + + function ishex(const c: Char): Boolean; {$IFDEF HAVE_INLINE} inline;{$ENDIF} + begin + result := (c < #256) and (AnsiChar(c) in ['0'..'9', 'a'..'z', 'A'..'Z']) + end; +var + pos: Byte; + state, saved: TState; + bracket, separator: Boolean; +label + redo; +begin + FillChar(Uuid^, SizeOf(TGUID), 0); + saved := stStart; + state := stEatSpaces; + bracket := false; + separator := false; + pos := 0; + while true do +redo: + case state of + stEatSpaces: + begin + while true do + case p^ of + ' ', #13, #10, #9: inc(p); + else + state := saved; + goto redo; + end; + end; + stStart: + case p^ of + '{': + begin + bracket := true; + inc(p); + state := stEatSpaces; + saved := stHEX; + pos := 0; + end; + else + state := stHEX; + end; + stHEX: + case pos of + 0..7: + if ishex(p^) then + begin + Uuid.D1 := (Uuid.D1 * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 8: + if (p^ = '-') then + begin + separator := true; + inc(p); + inc(pos) + end else + inc(pos); + 13,18,23: + if separator then + begin + if p^ <> '-' then + Exit(False); + inc(p); + inc(pos); + end else + inc(pos); + 9..12: + if ishex(p^) then + begin + TUUID(Uuid^).words[2] := (TUUID(Uuid^).words[2] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 14..17: + if ishex(p^) then + begin + TUUID(Uuid^).words[3] := (TUUID(Uuid^).words[3] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 19..20: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[8] := (TUUID(Uuid^).bytes[8] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 21..22: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[9] := (TUUID(Uuid^).bytes[9] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 24..25: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[10] := (TUUID(Uuid^).bytes[10] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 26..27: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[11] := (TUUID(Uuid^).bytes[11] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 28..29: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[12] := (TUUID(Uuid^).bytes[12] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 30..31: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[13] := (TUUID(Uuid^).bytes[13] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 32..33: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[14] := (TUUID(Uuid^).bytes[14] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 34..35: + if ishex(p^) then + begin + TUUID(Uuid^).bytes[15] := (TUUID(Uuid^).bytes[15] * 16) + hex2bin[p^]; + inc(p); + inc(pos); + end else + Exit(False); + 36: if bracket then + begin + state := stEatSpaces; + saved := stBracket; + end else + begin + state := stEatSpaces; + saved := stEnd; + end; + end; + stBracket: + begin + if p^ <> '}' then + Exit(False); + inc(p); + state := stEatSpaces; + saved := stEnd; + end; + stEnd: + begin + if p^ <> #0 then + Exit(False); + Break; + end; + end; + Result := True; +end; + +function UUIDToString(const g: TGUID): string; +begin + Result := format('%.8x%.4x%.4x%.2x%.2x%.2x%.2x%.2x%.2x%.2x%.2x', + [g.D1, g.D2, g.D3, + g.D4[0], g.D4[1], g.D4[2], + g.D4[3], g.D4[4], g.D4[5], + g.D4[6], g.D4[7]]); +end; + +function StringToUUID(const str: string; var g: TGUID): Boolean; +begin + Result := UuidFromString(PSOChar(str), @g); +end; + + +function serialfromguid(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean; +begin + case ObjectGetType(obj) of + stNull: + begin + FillChar(Value.GetReferenceToRawData^, SizeOf(TGUID), 0); + Result := True; + end; + stString: Result := UuidFromString(PSOChar(obj.AsString), Value.GetReferenceToRawData); + else + Result := False; + end; +end; + +function SOInvoke(const obj: TValue; const method: string; const params: ISuperObject; ctx: TSuperRttiContext): ISuperObject; overload; +var + owned: Boolean; +begin + if ctx = nil then + begin + ctx := TSuperRttiContext.Create; + owned := True; + end else + owned := False; + try + if TrySOInvoke(ctx, obj, method, params, Result) <> irSuccess then + raise Exception.Create('Invalid method call'); + finally + if owned then + ctx.Free; + end; +end; + +function SOInvoke(const obj: TValue; const method: string; const params: string; ctx: TSuperRttiContext): ISuperObject; overload; +begin + Result := SOInvoke(obj, method, so(params), ctx) +end; + +function TrySOInvoke(var ctx: TSuperRttiContext; const obj: TValue; + const method: string; const params: ISuperObject; + var Return: ISuperObject): TSuperInvokeResult; +var + t: TRttiInstanceType; + m: TRttiMethod; + a: TArray; + ps: TArray; + v: TValue; + index: ISuperObject; + + function GetParams: Boolean; + var + i: Integer; + begin + case ObjectGetType(params) of + stArray: + for i := 0 to Length(ps) - 1 do + if (pfOut in ps[i].Flags) then + TValue.Make(nil, ps[i].ParamType.Handle, a[i]) else + if not ctx.FromJson(ps[i].ParamType.Handle, params.AsArray[i], a[i]) then + Exit(False); + stObject: + for i := 0 to Length(ps) - 1 do + if (pfOut in ps[i].Flags) then + TValue.Make(nil, ps[i].ParamType.Handle, a[i]) else + if not ctx.FromJson(ps[i].ParamType.Handle, params.AsObject[ps[i].Name], a[i]) then + Exit(False); + stNull: ; + else + Exit(False); + end; + Result := True; + end; + + procedure SetParams; + var + i: Integer; + begin + case ObjectGetType(params) of + stArray: + for i := 0 to Length(ps) - 1 do + if (ps[i].Flags * [pfVar, pfOut]) <> [] then + params.AsArray[i] := ctx.ToJson(a[i], index); + stObject: + for i := 0 to Length(ps) - 1 do + if (ps[i].Flags * [pfVar, pfOut]) <> [] then + params.AsObject[ps[i].Name] := ctx.ToJson(a[i], index); + end; + end; + +begin + Result := irSuccess; + index := SO; + case obj.Kind of + tkClass: + begin + t := TRttiInstanceType(ctx.Context.GetType(obj.AsObject.ClassType)); + m := t.GetMethod(method); + if m = nil then Exit(irMethothodError); + ps := m.GetParameters; + SetLength(a, Length(ps)); + if not GetParams then Exit(irParamError); + if m.IsClassMethod then + begin + v := m.Invoke(obj.AsObject.ClassType, a); + Return := ctx.ToJson(v, index); + SetParams; + end else + begin + v := m.Invoke(obj, a); + Return := ctx.ToJson(v, index); + SetParams; + end; + end; + tkClassRef: + begin + t := TRttiInstanceType(ctx.Context.GetType(obj.AsClass)); + m := t.GetMethod(method); + if m = nil then Exit(irMethothodError); + ps := m.GetParameters; + SetLength(a, Length(ps)); + + if not GetParams then Exit(irParamError); + if m.IsClassMethod then + begin + v := m.Invoke(obj, a); + Return := ctx.ToJson(v, index); + SetParams; + end else + Exit(irError); + end; + else + Exit(irError); + end; +end; + +{$ENDIF} + +{ TSuperEnumerator } + +constructor TSuperEnumerator.Create(const obj: ISuperObject); +begin + FObj := obj; + FCount := -1; + if ObjectIsType(FObj, stObject) then + FObjEnum := FObj.AsObject.GetEnumerator else + FObjEnum := nil; +end; + +destructor TSuperEnumerator.Destroy; +begin + if FObjEnum <> nil then + FObjEnum.Free; +end; + +function TSuperEnumerator.MoveNext: Boolean; +begin + case ObjectGetType(FObj) of + stObject: Result := FObjEnum.MoveNext; + stArray: + begin + inc(FCount); + if FCount < FObj.AsArray.Length then + Result := True else + Result := False; + end; + else + Result := false; + end; +end; + +function TSuperEnumerator.GetCurrent: ISuperObject; +begin + case ObjectGetType(FObj) of + stObject: Result := FObjEnum.Current.Value; + stArray: Result := FObj.AsArray.GetO(FCount); + else + Result := FObj; + end; +end; + +{ TSuperObject } + +constructor TSuperObject.Create(jt: TSuperType); +begin + inherited Create; +{$IFDEF DEBUG} + InterlockedIncrement(debugcount); +{$ENDIF} + + FProcessing := false; + FDataPtr := nil; + FDataType := jt; + case FDataType of + stObject: FO.c_object := TSuperTableString.Create; + stArray: FO.c_array := TSuperArray.Create; + stString: FOString := ''; + else + FO.c_object := nil; + end; +end; + +constructor TSuperObject.Create(b: boolean); +begin + Create(stBoolean); + FO.c_boolean := b; +end; + +constructor TSuperObject.Create(i: SuperInt); +begin + Create(stInt); + FO.c_int := i; +end; + +constructor TSuperObject.Create(d: double); +begin + Create(stDouble); + FO.c_double := d; +end; + +constructor TSuperObject.CreateCurrency(c: Currency); +begin + Create(stCurrency); + FO.c_currency := c; +end; + +destructor TSuperObject.Destroy; +begin +{$IFDEF DEBUG} + InterlockedDecrement(debugcount); +{$ENDIF} + case FDataType of + stObject: FO.c_object.Free; + stArray: FO.c_array.Free; + end; + inherited; +end; + +function TSuperObject.Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer; +function DoEscape(str: PSOChar; len: Integer): Integer; +var + pos, start_offset: Integer; + c: SOChar; + buf: array[0..5] of SOChar; +type + TByteChar = record + case integer of + 0: (a, b: Byte); + 1: (c: WideChar); + end; + begin + if str = nil then + begin + Result := 0; + exit; + end; + pos := 0; start_offset := 0; + with writer do + while pos < len do + begin + c := str[pos]; + case c of + #8,#9,#10,#12,#13,'"','\','/': + begin + if(pos - start_offset > 0) then + Append(str + start_offset, pos - start_offset); + + if(c = #8) then Append(ESC_BS, 2) + else if (c = #9) then Append(ESC_TAB, 2) + else if (c = #10) then Append(ESC_LF, 2) + else if (c = #12) then Append(ESC_FF, 2) + else if (c = #13) then Append(ESC_CR, 2) + else if (c = '"') then Append(ESC_QUOT, 2) + else if (c = '\') then Append(ESC_SL, 2) + else if (c = '/') then Append(ESC_SR, 2); + inc(pos); + start_offset := pos; + end; + else + if (SOIChar(c) > 255) then + begin + if(pos - start_offset > 0) then + Append(str + start_offset, pos - start_offset); + buf[0] := '\'; + buf[1] := 'u'; + buf[2] := super_hex_chars[TByteChar(c).b shr 4]; + buf[3] := super_hex_chars[TByteChar(c).b and $f]; + buf[4] := super_hex_chars[TByteChar(c).a shr 4]; + buf[5] := super_hex_chars[TByteChar(c).a and $f]; + Append(@buf, 6); + inc(pos); + start_offset := pos; + end else + if (c < #32) or (c > #127) then + begin + if(pos - start_offset > 0) then + Append(str + start_offset, pos - start_offset); + buf[0] := '\'; + buf[1] := 'u'; + buf[2] := '0'; + buf[3] := '0'; + buf[4] := super_hex_chars[ord(c) shr 4]; + buf[5] := super_hex_chars[ord(c) and $f]; + Append(buf, 6); + inc(pos); + start_offset := pos; + end else + inc(pos); + end; + end; + if(pos - start_offset > 0) then + writer.Append(str + start_offset, pos - start_offset); + Result := 0; + end; + +function DoMinimalEscape(str: PSOChar; len: Integer): Integer; +var + pos, start_offset: Integer; + c: SOChar; +type + TByteChar = record + case integer of + 0: (a, b: Byte); + 1: (c: WideChar); + end; + begin + if str = nil then + begin + Result := 0; + exit; + end; + pos := 0; start_offset := 0; + with writer do + while pos < len do + begin + c := str[pos]; + case c of + #0: + begin + if(pos - start_offset > 0) then + Append(str + start_offset, pos - start_offset); + Append(ESC_ZERO, 6); + inc(pos); + start_offset := pos; + end; + '"': + begin + if(pos - start_offset > 0) then + Append(str + start_offset, pos - start_offset); + Append(ESC_QUOT, 2); + inc(pos); + start_offset := pos; + end; + '\': + begin + if(pos - start_offset > 0) then + Append(str + start_offset, pos - start_offset); + Append(ESC_SL, 2); + inc(pos); + start_offset := pos; + end; + else + inc(pos); + end; + end; + if(pos - start_offset > 0) then + writer.Append(str + start_offset, pos - start_offset); + Result := 0; + end; + + + procedure _indent(i: shortint; r: boolean); + begin + inc(level, i); + if r then + with writer do + begin +{$IFDEF MSWINDOWS} + Append(TOK_CRLF, 2); +{$ELSE} + Append(TOK_LF, 1); +{$ENDIF} + for i := 0 to level - 1 do + Append(TOK_SP, 1); + end; + end; +var + k,j: Integer; + iter: TSuperObjectIter; + st: AnsiString; + val: ISuperObject; +const + ENDSTR_A: PSOChar = '": '; + ENDSTR_B: PSOChar = '":'; +begin + + if FProcessing then + begin + Result := writer.Append(TOK_NULL, 4); + Exit; + end; + + FProcessing := true; + with writer do + try + case FDataType of + stObject: + if FO.c_object.FCount > 0 then + begin + k := 0; + Append(TOK_CBL, 1); + if indent then _indent(1, false); + if ObjectFindFirst(Self, iter) then + repeat + {$IFDEF SUPER_METHOD} + if (iter.val = nil) or not ObjectIsType(iter.val, stMethod) then + begin + {$ENDIF} + if (iter.val = nil) or (not iter.val.Processing) then + begin + if(k <> 0) then + Append(TOK_COM, 1); + if indent then _indent(0, true); + Append(TOK_DQT, 1); + if escape then + doEscape(PSOChar(iter.key), Length(iter.key)) else + DoMinimalEscape(PSOChar(iter.key), Length(iter.key)); + if indent then + Append(ENDSTR_A, 3) else + Append(ENDSTR_B, 2); + if(iter.val = nil) then + Append(TOK_NULL, 4) else + iter.val.write(writer, indent, escape, level); + inc(k); + end; + {$IFDEF SUPER_METHOD} + end; + {$ENDIF} + until not ObjectFindNext(iter); + ObjectFindClose(iter); + if indent then _indent(-1, true); + Result := Append(TOK_CBR, 1); + end else + Result := Append(TOK_OBJ, 2); + stBoolean: + begin + if (FO.c_boolean) then + Result := Append(TOK_TRUE, 4) else + Result := Append(TOK_FALSE, 5); + end; + stInt: + begin + str(FO.c_int, st); + Result := Append(PSOChar(SOString(st))); + end; + stDouble: + Result := Append(PSOChar(FloatToJson(FO.c_double))); + stCurrency: + begin + Result := Append(PSOChar(CurrToJson(FO.c_currency))); + end; + stString: + begin + Append(TOK_DQT, 1); + if escape then + doEscape(PSOChar(FOString), Length(FOString)) else + DoMinimalEscape(PSOChar(FOString), Length(FOString)); + Append(TOK_DQT, 1); + Result := 0; + end; + stArray: + if FO.c_array.FLength > 0 then + begin + Append(TOK_ARL, 1); + if indent then _indent(1, true); + k := 0; + j := 0; + while k < FO.c_array.FLength do + begin + + val := FO.c_array.GetO(k); + {$IFDEF SUPER_METHOD} + if not ObjectIsType(val, stMethod) then + begin + {$ENDIF} + if (val = nil) or (not val.Processing) then + begin + if (j <> 0) then + Append(TOK_COM, 1); + if(val = nil) then + Append(TOK_NULL, 4) else + val.write(writer, indent, escape, level); + inc(j); + end; + {$IFDEF SUPER_METHOD} + end; + {$ENDIF} + inc(k); + end; + if indent then _indent(-1, false); + Result := Append(TOK_ARR, 1); + end else + Result := Append(TOK_ARRAY, 2); + stNull: + Result := Append(TOK_NULL, 4); + else + Result := 0; + end; + finally + FProcessing := false; + end; +end; + +function TSuperObject.IsType(AType: TSuperType): boolean; +begin + Result := AType = FDataType; +end; + +function TSuperObject.AsBoolean: boolean; +begin + case FDataType of + stBoolean: Result := FO.c_boolean; + stInt: Result := (FO.c_int <> 0); + stDouble: Result := (FO.c_double <> 0); + stCurrency: Result := (FO.c_currency <> 0); + stString: Result := (Length(FOString) <> 0); + stNull: Result := False; + else + Result := True; + end; +end; + +function TSuperObject.AsInteger: SuperInt; +var + code: integer; + cint: SuperInt; +begin + case FDataType of + stInt: Result := FO.c_int; + stDouble: Result := round(FO.c_double); + stCurrency: Result := round(FO.c_currency); + stBoolean: Result := ord(FO.c_boolean); + stString: + begin + Val(FOString, cint, code); + if code = 0 then + Result := cint else + Result := 0; + end; + else + Result := 0; + end; +end; + +function TSuperObject.AsDouble: Double; +var + code: integer; + cdouble: double; +begin + case FDataType of + stDouble: Result := FO.c_double; + stCurrency: Result := FO.c_currency; + stInt: Result := FO.c_int; + stBoolean: Result := ord(FO.c_boolean); + stString: + begin + Val(FOString, cdouble, code); + if code = 0 then + Result := cdouble else + Result := 0.0; + end; + else + Result := 0.0; + end; +end; + +function TSuperObject.AsCurrency: Currency; +var + code: integer; + cdouble: double; +begin + case FDataType of + stDouble: Result := FO.c_double; + stCurrency: Result := FO.c_currency; + stInt: Result := FO.c_int; + stBoolean: Result := ord(FO.c_boolean); + stString: + begin + Val(FOString, cdouble, code); + if code = 0 then + Result := cdouble else + Result := 0.0; + end; + else + Result := 0.0; + end; +end; + +function TSuperObject.AsString: SOString; +begin + if FDataType = stString then + Result := FOString else + Result := AsJSon(false, false); +end; + +function TSuperObject.GetEnumerator: TSuperEnumerator; +begin + Result := TSuperEnumerator.Create(Self); +end; + +procedure TSuperObject.AfterConstruction; +begin + InterlockedDecrement(FRefCount); +end; + +procedure TSuperObject.BeforeDestruction; +begin + if RefCount <> 0 then + raise Exception.Create('Invalid pointer'); +end; + +function TSuperObject.AsArray: TSuperArray; +begin + if FDataType = stArray then + Result := FO.c_array else + Result := nil; +end; + +function TSuperObject.AsObject: TSuperTableString; +begin + if FDataType = stObject then + Result := FO.c_object else + Result := nil; +end; + +function TSuperObject.AsJSon(indent, escape: boolean): SOString; +var + pb: TSuperWriterString; +begin + pb := TSuperWriterString.Create; + try + if(Write(pb, indent, escape, 0) < 0) then + begin + Result := ''; + Exit; + end; + if pb.FBPos > 0 then + Result := pb.FBuf else + Result := ''; + finally + pb.Free; + end; +end; + +class function TSuperObject.ParseString(s: PSOChar; strict: Boolean; partial: boolean; const this: ISuperObject; + options: TSuperFindOptions; const put: ISuperObject; dt: TSuperType): ISuperObject; +var + tok: TSuperTokenizer; + obj: ISuperObject; +begin + tok := TSuperTokenizer.Create; + obj := ParseEx(tok, s, -1, strict, this, options, put, dt); + if(tok.err <> teSuccess) or (not partial and (s[tok.char_offset] <> #0)) then + Result := nil else + Result := obj; + tok.Free; +end; + +class function TSuperObject.ParseStream(stream: TStream; strict: Boolean; + partial: boolean; const this: ISuperObject; options: TSuperFindOptions; + const put: ISuperObject; dt: TSuperType): ISuperObject; +const + BUFFER_SIZE = 1024; +var + tok: TSuperTokenizer; + buffera: array[0..BUFFER_SIZE-1] of AnsiChar; + bufferw: array[0..BUFFER_SIZE-1] of SOChar; + bom: array[0..1] of byte; + unicode: boolean; + j, size: Integer; + st: string; +begin + st := ''; + tok := TSuperTokenizer.Create; + + if (stream.Read(bom, sizeof(bom)) = 2) and (bom[0] = $FF) and (bom[1] = $FE) then + begin + unicode := true; + size := stream.Read(bufferw, BUFFER_SIZE * SizeOf(SoChar)) div SizeOf(SoChar); + end else + begin + unicode := false; + stream.Seek(0, soFromBeginning); + size := stream.Read(buffera, BUFFER_SIZE); + end; + + while size > 0 do + begin + if not unicode then + for j := 0 to size - 1 do + bufferw[j] := SOChar(buffera[j]); + ParseEx(tok, bufferw, size, strict, this, options, put, dt); + + if tok.err = teContinue then + begin + if not unicode then + size := stream.Read(buffera, BUFFER_SIZE) else + size := stream.Read(bufferw, BUFFER_SIZE * SizeOf(SoChar)) div SizeOf(SoChar); + end else + Break; + end; + if(tok.err <> teSuccess) or (not partial and (st[tok.char_offset] <> #0)) then + Result := nil else + Result := tok.stack[tok.depth].current; + tok.Free; +end; + +class function TSuperObject.ParseFile(const FileName: string; strict: Boolean; + partial: boolean; const this: ISuperObject; options: TSuperFindOptions; + const put: ISuperObject; dt: TSuperType): ISuperObject; +var + stream: TFileStream; +begin + stream := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite); + try + Result := ParseStream(stream, strict, partial, this, options, put, dt); + finally + stream.Free; + end; +end; + +class function TSuperObject.ParseEx(tok: TSuperTokenizer; str: PSOChar; len: integer; + strict: Boolean; const this: ISuperObject; options: TSuperFindOptions; const put: ISuperObject; dt: TSuperType): ISuperObject; + +const + spaces = [#32,#8,#9,#10,#12,#13]; + delimiters = ['"', '.', '[', ']', '{', '}', '(', ')', ',', ':', #0]; + reserved = delimiters + spaces; + path = ['a'..'z', 'A'..'Z', '.', '_']; + + function hexdigit(x: SOChar): byte; {$IFDEF HAVE_INLINE} inline;{$ENDIF} + begin + if x <= '9' then + Result := byte(x) - byte('0') else + Result := (byte(x) and 7) + 9; + end; + function min(v1, v2: integer): integer;{$IFDEF HAVE_INLINE} inline;{$ENDIF} + begin if v1 < v2 then result := v1 else result := v2 end; + +var + obj: ISuperObject; + v: SOChar; +{$IFDEF SUPER_METHOD} + sm: TSuperMethod; +{$ENDIF} + numi: SuperInt; + numd: Double; + code: integer; + TokRec: PSuperTokenerSrec; + evalstack: integer; + p: PSOChar; + + function IsEndDelimiter(v: AnsiChar): Boolean; + begin + if tok.depth > 0 then + case tok.stack[tok.depth - 1].state of + tsArrayAdd: Result := v in [',', ']', #0]; + tsObjectValueAdd: Result := v in [',', '}', #0]; + else + Result := v = #0; + end else + Result := v = #0; + end; + +label out, redo_char; +begin + evalstack := 0; + obj := nil; + Result := nil; + TokRec := @tok.stack[tok.depth]; + + tok.char_offset := 0; + tok.err := teSuccess; + + repeat + if (tok.char_offset = len) then + begin + if (tok.depth = 0) and (TokRec^.state = tsEatws) and + (TokRec^.saved_state = tsFinish) then + tok.err := teSuccess else + tok.err := teContinue; + goto out; + end; + + v := str^; + + case v of + #10: + begin + inc(tok.line); + tok.col := 0; + end; + #9: inc(tok.col, 4); + else + inc(tok.col); + end; + +redo_char: + case TokRec^.state of + tsEatws: + begin + if (SOIChar(v) < 256) and (AnsiChar(v) in spaces) then {nop} else + if (v = '/') then + begin + tok.pb.Reset; + tok.pb.Append(@v, 1); + TokRec^.state := tsCommentStart; + end else begin + TokRec^.state := TokRec^.saved_state; + goto redo_char; + end + end; + + tsStart: + case v of + '"', + '''': + begin + TokRec^.state := tsString; + tok.pb.Reset; + tok.quote_char := v; + end; + '-': + begin + TokRec^.state := tsNumber; + tok.pb.Reset; + tok.is_double := 0; + tok.floatcount := -1; + goto redo_char; + end; + + '0'..'9': + begin + if (tok.depth = 0) then + case ObjectGetType(this) of + stObject: + begin + TokRec^.state := tsIdentifier; + TokRec^.current := this; + goto redo_char; + end; + end; + TokRec^.state := tsNumber; + tok.pb.Reset; + tok.is_double := 0; + tok.floatcount := -1; + goto redo_char; + end; + '{': + begin + TokRec^.state := tsEatws; + TokRec^.saved_state := tsObjectFieldStart; + TokRec^.current := TSuperObject.Create(stObject); + end; + '[': + begin + TokRec^.state := tsEatws; + TokRec^.saved_state := tsArray; + TokRec^.current := TSuperObject.Create(stArray); + end; +{$IFDEF SUPER_METHOD} + '(': + begin + if (tok.depth = 0) and ObjectIsType(this, stMethod) then + begin + TokRec^.current := this; + TokRec^.state := tsParamValue; + end; + end; +{$ENDIF} + 'N', + 'n': + begin + TokRec^.state := tsNull; + tok.pb.Reset; + tok.st_pos := 0; + goto redo_char; + end; + 'T', + 't', + 'F', + 'f': + begin + TokRec^.state := tsBoolean; + tok.pb.Reset; + tok.st_pos := 0; + goto redo_char; + end; + else + TokRec^.state := tsIdentifier; + tok.pb.Reset; + goto redo_char; + end; + + tsFinish: + begin + if(tok.depth = 0) then goto out; + obj := TokRec^.current; + tok.ResetLevel(tok.depth); + dec(tok.depth); + TokRec := @tok.stack[tok.depth]; + goto redo_char; + end; + + tsNull: + begin + tok.pb.Append(@v, 1); + if (StrLComp(TOK_NULL, PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 4)) = 0) then + begin + if (tok.st_pos = 4) then + if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then + TokRec^.state := tsIdentifier else + begin + TokRec^.current := TSuperObject.Create(stNull); + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + goto redo_char; + end; + end else + begin + TokRec^.state := tsIdentifier; + tok.pb.FBuf[tok.st_pos] := #0; + dec(tok.pb.FBPos); + goto redo_char; + end; + inc(tok.st_pos); + end; + + tsCommentStart: + begin + if(v = '*') then + begin + TokRec^.state := tsComment; + end else + if (v = '/') then + begin + TokRec^.state := tsCommentEol; + end else + begin + tok.err := teParseComment; + goto out; + end; + tok.pb.Append(@v, 1); + end; + + tsComment: + begin + if(v = '*') then + TokRec^.state := tsCommentEnd; + tok.pb.Append(@v, 1); + end; + + tsCommentEol: + begin + if (v = #10) then + TokRec^.state := tsEatws else + tok.pb.Append(@v, 1); + end; + + tsCommentEnd: + begin + tok.pb.Append(@v, 1); + if (v = '/') then + TokRec^.state := tsEatws else + TokRec^.state := tsComment; + end; + + tsString: + begin + if (v = tok.quote_char) then + begin + TokRec^.current := TSuperObject.Create(SOString(tok.pb.GetString)); + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + end else + if (v = '\') then + begin + TokRec^.saved_state := tsString; + TokRec^.state := tsStringEscape; + end else + begin + tok.pb.Append(@v, 1); + end + end; + + tsEvalProperty: + begin + if (TokRec^.current = nil) and (foCreatePath in options) then + begin + TokRec^.current := TSuperObject.Create(stObject); + TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current) + end else + if not ObjectIsType(TokRec^.current, stObject) then + begin + tok.err := teEvalObject; + goto out; + end; + tok.pb.Reset; + TokRec^.state := tsIdentifier; + goto redo_char; + end; + + tsEvalArray: + begin + if (TokRec^.current = nil) and (foCreatePath in options) then + begin + TokRec^.current := TSuperObject.Create(stArray); + TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current) + end else + if not ObjectIsType(TokRec^.current, stArray) then + begin + tok.err := teEvalArray; + goto out; + end; + tok.pb.Reset; + TokRec^.state := tsParamValue; + goto redo_char; + end; +{$IFDEF SUPER_METHOD} + tsEvalMethod: + begin + if ObjectIsType(TokRec^.current, stMethod) and assigned(TokRec^.current.AsMethod) then + begin + tok.pb.Reset; + TokRec^.obj := TSuperObject.Create(stArray); + TokRec^.state := tsMethodValue; + goto redo_char; + end else + begin + tok.err := teEvalMethod; + goto out; + end; + end; + + tsMethodValue: + begin + case v of + ')': + TokRec^.state := tsIdentifier; + else + if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then + begin + tok.err := teDepth; + goto out; + end; + inc(evalstack); + TokRec^.state := tsMethodPut; + inc(tok.depth); + tok.ResetLevel(tok.depth); + TokRec := @tok.stack[tok.depth]; + goto redo_char; + end; + end; + + tsMethodPut: + begin + TokRec^.obj.AsArray.Add(obj); + case v of + ',': + begin + tok.pb.Reset; + TokRec^.saved_state := tsMethodValue; + TokRec^.state := tsEatws; + end; + ')': + begin + if TokRec^.obj.AsArray.Length = 1 then + TokRec^.obj := TokRec^.obj.AsArray.GetO(0); + dec(evalstack); + tok.pb.Reset; + TokRec^.saved_state := tsIdentifier; + TokRec^.state := tsEatws; + end; + else + tok.err := teEvalMethod; + goto out; + end; + end; +{$ENDIF} + tsParamValue: + begin + case v of + ']': + TokRec^.state := tsIdentifier; + else + if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then + begin + tok.err := teDepth; + goto out; + end; + inc(evalstack); + TokRec^.state := tsParamPut; + inc(tok.depth); + tok.ResetLevel(tok.depth); + TokRec := @tok.stack[tok.depth]; + goto redo_char; + end; + end; + + tsParamPut: + begin + dec(evalstack); + TokRec^.obj := obj; + tok.pb.Reset; + TokRec^.saved_state := tsIdentifier; + TokRec^.state := tsEatws; + if v <> ']' then + begin + tok.err := teEvalArray; + goto out; + end; + end; + + tsIdentifier: + begin + if (this = nil) then + begin + if (SOIChar(v) < 256) and IsEndDelimiter(AnsiChar(v)) then + begin + if not strict then + begin + tok.pb.TrimRight; + TokRec^.current := TSuperObject.Create(tok.pb.Fbuf); + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + goto redo_char; + end else + begin + tok.err := teParseString; + goto out; + end; + end else + if (v = '\') then + begin + TokRec^.saved_state := tsIdentifier; + TokRec^.state := tsStringEscape; + end else + tok.pb.Append(@v, 1); + end else + begin + if (SOIChar(v) < 256) and (AnsiChar(v) in reserved) then + begin + TokRec^.gparent := TokRec^.parent; + if TokRec^.current = nil then + TokRec^.parent := this else + TokRec^.parent := TokRec^.current; + + case ObjectGetType(TokRec^.parent) of + stObject: + case v of + '.': + begin + TokRec^.state := tsEvalProperty; + if tok.pb.FBPos > 0 then + TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf); + end; + '[': + begin + TokRec^.state := tsEvalArray; + if tok.pb.FBPos > 0 then + TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf); + end; + '(': + begin + TokRec^.state := tsEvalMethod; + if tok.pb.FBPos > 0 then + TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf); + end; + else + if tok.pb.FBPos > 0 then + TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf); + if (foPutValue in options) and (evalstack = 0) then + begin + TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, put); + TokRec^.current := put + end else + if (foDelete in options) and (evalstack = 0) then + begin + TokRec^.current := TokRec^.parent.AsObject.Delete(tok.pb.Fbuf); + end else + if (TokRec^.current = nil) and (foCreatePath in options) then + begin + TokRec^.current := TSuperObject.Create(dt); + TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current); + end; + TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf); + TokRec^.state := tsFinish; + goto redo_char; + end; + stArray: + begin + if TokRec^.obj <> nil then + begin + if not ObjectIsType(TokRec^.obj, stInt) or (TokRec^.obj.AsInteger < 0) then + begin + tok.err := teEvalInt; + TokRec^.obj := nil; + goto out; + end; + numi := TokRec^.obj.AsInteger; + TokRec^.obj := nil; + + TokRec^.current := TokRec^.parent.AsArray.GetO(numi); + case v of + '.': + if (TokRec^.current = nil) and (foCreatePath in options) then + begin + TokRec^.current := TSuperObject.Create(stObject); + TokRec^.parent.AsArray.PutO(numi, TokRec^.current); + end else + if (TokRec^.current = nil) then + begin + tok.err := teEvalObject; + goto out; + end; + '[': + begin + if (TokRec^.current = nil) and (foCreatePath in options) then + begin + TokRec^.current := TSuperObject.Create(stArray); + TokRec^.parent.AsArray.Add(TokRec^.current); + end else + if (TokRec^.current = nil) then + begin + tok.err := teEvalArray; + goto out; + end; + TokRec^.state := tsEvalArray; + end; + '(': TokRec^.state := tsEvalMethod; + else + if (foPutValue in options) and (evalstack = 0) then + begin + TokRec^.parent.AsArray.PutO(numi, put); + TokRec^.current := put; + end else + if (foDelete in options) and (evalstack = 0) then + begin + TokRec^.current := TokRec^.parent.AsArray.Delete(numi); + end else + TokRec^.current := TokRec^.parent.AsArray.GetO(numi); + TokRec^.state := tsFinish; + goto redo_char + end; + end else + begin + case v of + '.': + begin + if (foPutValue in options) then + begin + TokRec^.current := TSuperObject.Create(stObject); + TokRec^.parent.AsArray.Add(TokRec^.current); + end else + TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1); + end; + '[': + begin + if (foPutValue in options) then + begin + TokRec^.current := TSuperObject.Create(stArray); + TokRec^.parent.AsArray.Add(TokRec^.current); + end else + TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1); + TokRec^.state := tsEvalArray; + end; + '(': + begin + if not (foPutValue in options) then + TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1) else + TokRec^.current := nil; + + TokRec^.state := tsEvalMethod; + end; + else + if (foPutValue in options) and (evalstack = 0) then + begin + TokRec^.parent.AsArray.Add(put); + TokRec^.current := put; + end else + if tok.pb.FBPos = 0 then + TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1); + TokRec^.state := tsFinish; + goto redo_char + end; + end; + end; +{$IFDEF SUPER_METHOD} + stMethod: + case v of + '.': + begin + TokRec^.current := nil; + sm := TokRec^.parent.AsMethod; + sm(TokRec^.gparent, TokRec^.obj, TokRec^.current); + TokRec^.obj := nil; + end; + '[': + begin + TokRec^.current := nil; + sm := TokRec^.parent.AsMethod; + sm(TokRec^.gparent, TokRec^.obj, TokRec^.current); + TokRec^.state := tsEvalArray; + TokRec^.obj := nil; + end; + '(': + begin + TokRec^.current := nil; + sm := TokRec^.parent.AsMethod; + sm(TokRec^.gparent, TokRec^.obj, TokRec^.current); + TokRec^.state := tsEvalMethod; + TokRec^.obj := nil; + end; + else + if not (foPutValue in options) or (evalstack > 0) then + begin + TokRec^.current := nil; + sm := TokRec^.parent.AsMethod; + sm(TokRec^.gparent, TokRec^.obj, TokRec^.current); + TokRec^.obj := nil; + TokRec^.state := tsFinish; + goto redo_char + end else + begin + tok.err := teEvalMethod; + TokRec^.obj := nil; + goto out; + end; + end; +{$ENDIF} + end; + end else + tok.pb.Append(@v, 1); + end; + end; + + tsStringEscape: + case v of + 'b', + 'n', + 'r', + 't', + 'f': + begin + if(v = 'b') then tok.pb.Append(TOK_BS, 1) + else if(v = 'n') then tok.pb.Append(TOK_LF, 1) + else if(v = 'r') then tok.pb.Append(TOK_CR, 1) + else if(v = 't') then tok.pb.Append(TOK_TAB, 1) + else if(v = 'f') then tok.pb.Append(TOK_FF, 1); + TokRec^.state := TokRec^.saved_state; + end; + 'u': + begin + tok.ucs_char := 0; + tok.st_pos := 0; + TokRec^.state := tsEscapeUnicode; + end; + 'x': + begin + tok.ucs_char := 0; + tok.st_pos := 0; + TokRec^.state := tsEscapeHexadecimal; + end + else + tok.pb.Append(@v, 1); + TokRec^.state := TokRec^.saved_state; + end; + + tsEscapeUnicode: + begin + if ((SOIChar(v) < 256) and (AnsiChar(v) in super_hex_chars_set)) then + begin + inc(tok.ucs_char, (Word(hexdigit(v)) shl ((3-tok.st_pos)*4))); + inc(tok.st_pos); + if (tok.st_pos = 4) then + begin + tok.pb.Append(@tok.ucs_char, 1); + TokRec^.state := TokRec^.saved_state; + end + end else + begin + tok.err := teParseString; + goto out; + end + end; + tsEscapeHexadecimal: + begin + if ((SOIChar(v) < 256) and (AnsiChar(v) in super_hex_chars_set)) then + begin + inc(tok.ucs_char, (Word(hexdigit(v)) shl ((1-tok.st_pos)*4))); + inc(tok.st_pos); + if (tok.st_pos = 2) then + begin + tok.pb.Append(@tok.ucs_char, 1); + TokRec^.state := TokRec^.saved_state; + end + end else + begin + tok.err := teParseString; + goto out; + end + end; + tsBoolean: + begin + tok.pb.Append(@v, 1); + if (StrLComp('true', PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 4)) = 0) then + begin + if (tok.st_pos = 4) then + if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then + TokRec^.state := tsIdentifier else + begin + TokRec^.current := TSuperObject.Create(true); + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + goto redo_char; + end + end else + if (StrLComp('false', PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 5)) = 0) then + begin + if (tok.st_pos = 5) then + if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then + TokRec^.state := tsIdentifier else + begin + TokRec^.current := TSuperObject.Create(false); + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + goto redo_char; + end + end else + begin + TokRec^.state := tsIdentifier; + tok.pb.FBuf[tok.st_pos] := #0; + dec(tok.pb.FBPos); + goto redo_char; + end; + inc(tok.st_pos); + end; + + tsNumber: + begin + if (SOIChar(v) < 256) and (AnsiChar(v) in super_number_chars_set) then + begin + tok.pb.Append(@v, 1); + if (SOIChar(v) < 256) then + case v of + '.': begin + tok.is_double := 1; + tok.floatcount := 0; + end; + 'e','E': + begin + tok.is_double := 1; + tok.floatcount := -1; + end; + '0'..'9': + begin + + if (tok.is_double = 1) and (tok.floatcount >= 0) then + begin + inc(tok.floatcount); + if tok.floatcount > 4 then + tok.floatcount := -1; + end; + end; + end; + end else + begin + if (tok.is_double = 0) then + begin + val(tok.pb.FBuf, numi, code); + if ObjectIsType(this, stArray) then + begin + if (foPutValue in options) and (evalstack = 0) then + begin + this.AsArray.PutO(numi, put); + TokRec^.current := put; + end else + if (foDelete in options) and (evalstack = 0) then + TokRec^.current := this.AsArray.Delete(numi) else + TokRec^.current := this.AsArray.GetO(numi); + end else + TokRec^.current := TSuperObject.Create(numi); + + end else + if (tok.is_double <> 0) then + begin + if tok.floatcount >= 0 then + begin + p := tok.pb.FBuf; + while p^ <> '.' do inc(p); + for code := 0 to tok.floatcount - 1 do + begin + p^ := p[1]; + inc(p); + end; + p^ := #0; + val(tok.pb.FBuf, numi, code); + case tok.floatcount of + 0: numi := numi * 10000; + 1: numi := numi * 1000; + 2: numi := numi * 100; + 3: numi := numi * 10; + end; + TokRec^.current := TSuperObject.CreateCurrency(PCurrency(@numi)^); + end else + begin + val(tok.pb.FBuf, numd, code); + TokRec^.current := TSuperObject.Create(numd); + end; + end else + begin + tok.err := teParseNumber; + goto out; + end; + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + goto redo_char; + end + end; + + tsArray: + begin + if (v = ']') then + begin + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + end else + begin + if(tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then + begin + tok.err := teDepth; + goto out; + end; + TokRec^.state := tsArrayAdd; + inc(tok.depth); + tok.ResetLevel(tok.depth); + TokRec := @tok.stack[tok.depth]; + goto redo_char; + end + end; + + tsArrayAdd: + begin + TokRec^.current.AsArray.Add(obj); + TokRec^.saved_state := tsArraySep; + TokRec^.state := tsEatws; + goto redo_char; + end; + + tsArraySep: + begin + if (v = ']') then + begin + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + end else + if (v = ',') then + begin + TokRec^.saved_state := tsArray; + TokRec^.state := tsEatws; + end else + begin + tok.err := teParseArray; + goto out; + end + end; + + tsObjectFieldStart: + begin + if (v = '}') then + begin + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + end else + if (SOIChar(v) < 256) and (AnsiChar(v) in ['"', '''']) then + begin + tok.quote_char := v; + tok.pb.Reset; + TokRec^.state := tsObjectField; + end else + if not((SOIChar(v) < 256) and ((AnsiChar(v) in reserved) or strict)) then + begin + TokRec^.state := tsObjectUnquotedField; + tok.pb.Reset; + goto redo_char; + end else + begin + tok.err := teParseObjectKeyName; + goto out; + end + end; + + tsObjectField: + begin + if (v = tok.quote_char) then + begin + TokRec^.field_name := tok.pb.FBuf; + TokRec^.saved_state := tsObjectFieldEnd; + TokRec^.state := tsEatws; + end else + if (v = '\') then + begin + TokRec^.saved_state := tsObjectField; + TokRec^.state := tsStringEscape; + end else + begin + tok.pb.Append(@v, 1); + end + end; + + tsObjectUnquotedField: + begin + if (SOIChar(v) < 256) and (AnsiChar(v) in [':', #0]) then + begin + TokRec^.field_name := tok.pb.FBuf; + TokRec^.saved_state := tsObjectFieldEnd; + TokRec^.state := tsEatws; + goto redo_char; + end else + if (v = '\') then + begin + TokRec^.saved_state := tsObjectUnquotedField; + TokRec^.state := tsStringEscape; + end else + tok.pb.Append(@v, 1); + end; + + tsObjectFieldEnd: + begin + if (v = ':') then + begin + TokRec^.saved_state := tsObjectValue; + TokRec^.state := tsEatws; + end else + begin + tok.err := teParseObjectKeySep; + goto out; + end + end; + + tsObjectValue: + begin + if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then + begin + tok.err := teDepth; + goto out; + end; + TokRec^.state := tsObjectValueAdd; + inc(tok.depth); + tok.ResetLevel(tok.depth); + TokRec := @tok.stack[tok.depth]; + goto redo_char; + end; + + tsObjectValueAdd: + begin + TokRec^.current.AsObject.PutO(TokRec^.field_name, obj); + TokRec^.field_name := ''; + TokRec^.saved_state := tsObjectSep; + TokRec^.state := tsEatws; + goto redo_char; + end; + + tsObjectSep: + begin + if (v = '}') then + begin + TokRec^.saved_state := tsFinish; + TokRec^.state := tsEatws; + end else + if (v = ',') then + begin + TokRec^.saved_state := tsObjectFieldStart; + TokRec^.state := tsEatws; + end else + begin + tok.err := teParseObjectValueSep; + goto out; + end + end; + end; + inc(str); + inc(tok.char_offset); + until v = #0; + + if(TokRec^.state <> tsFinish) and + (TokRec^.saved_state <> tsFinish) then + tok.err := teParseEof; + + out: + if(tok.err in [teSuccess]) then + begin +{$IFDEF SUPER_METHOD} + if (foCallMethod in options) and ObjectIsType(TokRec^.current, stMethod) and assigned(TokRec^.current.AsMethod) then + begin + sm := TokRec^.current.AsMethod; + sm(TokRec^.parent, put, Result); + end else +{$ENDIF} + Result := TokRec^.current; + end else + Result := nil; +end; + +procedure TSuperObject.PutO(const path: SOString; const Value: ISuperObject); +begin + ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], Value); +end; + +procedure TSuperObject.PutB(const path: SOString; Value: Boolean); +begin + ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value)); +end; + +procedure TSuperObject.PutD(const path: SOString; Value: Double); +begin + ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value)); +end; + +procedure TSuperObject.PutC(const path: SOString; Value: Currency); +begin + ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.CreateCurrency(Value)); +end; + +procedure TSuperObject.PutI(const path: SOString; Value: SuperInt); +begin + ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value)); +end; + +procedure TSuperObject.PutS(const path: SOString; const Value: SOString); +begin + ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value)); +end; + +function TSuperObject.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; +begin + if GetInterface(IID, Obj) then + Result := 0 + else + Result := E_NOINTERFACE; +end; + +function TSuperObject.SaveTo(stream: TStream; indent, escape: boolean): integer; +var + pb: TSuperWriterStream; +begin + if escape then + pb := TSuperAnsiWriterStream.Create(stream) else + pb := TSuperUnicodeWriterStream.Create(stream); + + if(Write(pb, indent, escape, 0) < 0) then + begin + pb.Reset; + pb.Free; + Result := 0; + Exit; + end; + Result := stream.Size; + pb.Free; +end; + +function TSuperObject.CalcSize(indent, escape: boolean): integer; +var + pb: TSuperWriterFake; +begin + pb := TSuperWriterFake.Create; + if(Write(pb, indent, escape, 0) < 0) then + begin + pb.Free; + Result := 0; + Exit; + end; + Result := pb.FSize; + pb.Free; +end; + +function TSuperObject.SaveTo(socket: Integer; indent, escape: boolean): integer; +var + pb: TSuperWriterSock; +begin + pb := TSuperWriterSock.Create(socket); + if(Write(pb, indent, escape, 0) < 0) then + begin + pb.Free; + Result := 0; + Exit; + end; + Result := pb.FSize; + pb.Free; +end; + +constructor TSuperObject.Create(const s: SOString); +begin + Create(stString); + FOString := s; +end; + +procedure TSuperObject.Clear(all: boolean); +begin + if FProcessing then exit; + FProcessing := true; + try + case FDataType of + stBoolean: FO.c_boolean := false; + stDouble: FO.c_double := 0.0; + stCurrency: FO.c_currency := 0.0; + stInt: FO.c_int := 0; + stObject: FO.c_object.Clear(all); + stArray: FO.c_array.Clear(all); + stString: FOString := ''; +{$IFDEF SUPER_METHOD} + stMethod: FO.c_method := nil; +{$ENDIF} + end; + finally + FProcessing := false; + end; +end; + +procedure TSuperObject.Pack(all: boolean = false); +begin + if FProcessing then exit; + FProcessing := true; + try + case FDataType of + stObject: FO.c_object.Pack(all); + stArray: FO.c_array.Pack(all); + end; + finally + FProcessing := false; + end; +end; + +function TSuperObject.GetN(const path: SOString): ISuperObject; +begin + Result := ParseString(PSOChar(path), False, true, self); + if Result = nil then + Result := TSuperObject.Create(stNull); +end; + +procedure TSuperObject.PutN(const path: SOString; const Value: ISuperObject); +begin + if Value = nil then + ParseString(PSOChar(path), False, True, self, [foCreatePath, foPutValue], TSuperObject.Create(stNull)) else + ParseString(PSOChar(path), False, True, self, [foCreatePath, foPutValue], Value); +end; + +function TSuperObject.Delete(const path: SOString): ISuperObject; +begin + Result := ParseString(PSOChar(path), False, true, self, [foDelete]); +end; + +function TSuperObject.Clone: ISuperObject; +var + ite: TSuperObjectIter; + arr: TSuperArray; + j: integer; +begin + case FDataType of + stBoolean: Result := TSuperObject.Create(FO.c_boolean); + stDouble: Result := TSuperObject.Create(FO.c_double); + stCurrency: Result := TSuperObject.CreateCurrency(FO.c_currency); + stInt: Result := TSuperObject.Create(FO.c_int); + stString: Result := TSuperObject.Create(FOString); +{$IFDEF SUPER_METHOD} + stMethod: Result := TSuperObject.Create(FO.c_method); +{$ENDIF} + stObject: + begin + Result := TSuperObject.Create(stObject); + if ObjectFindFirst(self, ite) then + with Result.AsObject do + repeat + PutO(ite.key, ite.val.Clone); + until not ObjectFindNext(ite); + ObjectFindClose(ite); + end; + stArray: + begin + Result := TSuperObject.Create(stArray); + arr := AsArray; + with Result.AsArray do + for j := 0 to arr.Length - 1 do + Add(arr.GetO(j).Clone); + end; + else + Result := nil; + end; +end; + +procedure TSuperObject.Merge(const obj: ISuperObject; reference: boolean); +var + prop1, prop2: ISuperObject; + ite: TSuperObjectIter; + arr: TSuperArray; + j: integer; +begin + if ObjectIsType(obj, FDataType) then + case FDataType of + stBoolean: FO.c_boolean := obj.AsBoolean; + stDouble: FO.c_double := obj.AsDouble; + stCurrency: FO.c_currency := obj.AsCurrency; + stInt: FO.c_int := obj.AsInteger; + stString: FOString := obj.AsString; +{$IFDEF SUPER_METHOD} + stMethod: FO.c_method := obj.AsMethod; +{$ENDIF} + stObject: + begin + if ObjectFindFirst(obj, ite) then + with FO.c_object do + repeat + prop1 := FO.c_object.GetO(ite.key); + if (prop1 <> nil) and (ite.val <> nil) and (prop1.DataType = ite.val.DataType) then + prop1.Merge(ite.val) else + if reference then + PutO(ite.key, ite.val) else + if ite.val <> nil then + PutO(ite.key, ite.val.Clone) else + PutO(ite.key, nil) + + until not ObjectFindNext(ite); + ObjectFindClose(ite); + end; + stArray: + begin + arr := obj.AsArray; + with FO.c_array do + for j := 0 to arr.Length - 1 do + begin + prop1 := GetO(j); + prop2 := arr.GetO(j); + if (prop1 <> nil) and (prop2 <> nil) and (prop1.DataType = prop2.DataType) then + prop1.Merge(prop2) else + if reference then + PutO(j, prop2) else + if prop2 <> nil then + PutO(j, prop2.Clone) else + PutO(j, nil); + end; + end; + end; +end; + +procedure TSuperObject.Merge(const str: SOString); +begin + Merge(TSuperObject.ParseString(PSOChar(str), False), true); +end; + +class function TSuperObject.NewInstance: TObject; +begin + Result := inherited NewInstance; + TSuperObject(Result).FRefCount := 1; +end; + +function TSuperObject.ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject; +begin + Result := ParseString(PSOChar(path), False, True, Self, [foCreatePath], nil, dataType); +end; + +function TSuperObject.Format(const str: SOString; BeginSep: SOChar; EndSep: SOChar): SOString; +var + p1, p2: PSOChar; +begin + Result := ''; + p2 := PSOChar(str); + p1 := p2; + while true do + if p2^ = BeginSep then + begin + if p2 > p1 then + Result := Result + Copy(p1, 0, p2-p1); + inc(p2); + p1 := p2; + while true do + if p2^ = EndSep then Break else + if p2^ = #0 then Exit else + inc(p2); + Result := Result + GetS(copy(p1, 0, p2-p1)); + inc(p2); + p1 := p2; + end + else if p2^ = #0 then + begin + if p2 > p1 then + Result := Result + Copy(p1, 0, p2-p1); + Break; + end else + inc(p2); +end; + +function TSuperObject.GetO(const path: SOString): ISuperObject; +begin + Result := ParseString(PSOChar(path), False, True, Self); +end; + +function TSuperObject.GetA(const path: SOString): TSuperArray; +var + obj: ISuperObject; +begin + obj := ParseString(PSOChar(path), False, True, Self); + if obj <> nil then + Result := obj.AsArray else + Result := nil; +end; + +function TSuperObject.GetB(const path: SOString): Boolean; +var + obj: ISuperObject; +begin + obj := GetO(path); + if obj <> nil then + Result := obj.AsBoolean else + Result := false; +end; + +function TSuperObject.GetD(const path: SOString): Double; +var + obj: ISuperObject; +begin + obj := GetO(path); + if obj <> nil then + Result := obj.AsDouble else + Result := 0.0; +end; + +function TSuperObject.GetC(const path: SOString): Currency; +var + obj: ISuperObject; +begin + obj := GetO(path); + if obj <> nil then + Result := obj.AsCurrency else + Result := 0.0; +end; + +function TSuperObject.GetI(const path: SOString): SuperInt; +var + obj: ISuperObject; +begin + obj := GetO(path); + if obj <> nil then + Result := obj.AsInteger else + Result := 0; +end; + +function TSuperObject.GetDataPtr: Pointer; +begin + Result := FDataPtr; +end; + +function TSuperObject.GetDataType: TSuperType; +begin + Result := FDataType +end; + +function TSuperObject.GetS(const path: SOString): SOString; +var + obj: ISuperObject; +begin + obj := GetO(path); + if obj <> nil then + Result := obj.AsString else + Result := ''; +end; + +function TSuperObject.SaveTo(const FileName: string; indent, escape: boolean): integer; +var + stream: TFileStream; +begin + stream := TFileStream.Create(FileName, fmCreate); + try + Result := SaveTo(stream, indent, escape); + finally + stream.Free; + end; +end; + +function TSuperObject.Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; +begin + Result := Validate(TSuperObject.ParseString(PSOChar(rules), False), TSuperObject.ParseString(PSOChar(defs), False), callback, sender); +end; + +function TSuperObject.Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; +type + TDataType = (dtUnknown, dtStr, dtInt, dtFloat, dtNumber, dtText, dtBool, + dtMap, dtSeq, dtScalar, dtAny); +var + datatypes: ISuperObject; + names: ISuperObject; + + function FindInheritedProperty(const prop: PSOChar; p: ISuperObject): ISuperObject; + var + o: ISuperObject; + e: TSuperAvlEntry; + begin + o := p[prop]; + if o <> nil then + result := o else + begin + o := p['inherit']; + if (o <> nil) and ObjectIsType(o, stString) then + begin + e := names.AsObject.Search(o.AsString); + if (e <> nil) then + Result := FindInheritedProperty(prop, e.Value) else + Result := nil; + end else + Result := nil; + end; + end; + + function FindDataType(o: ISuperObject): TDataType; + var + e: TSuperAvlEntry; + obj: ISuperObject; + begin + obj := FindInheritedProperty('type', o); + if obj <> nil then + begin + e := datatypes.AsObject.Search(obj.AsString); + if e <> nil then + Result := TDataType(e.Value.AsInteger) else + Result := dtUnknown; + end else + Result := dtUnknown; + end; + + procedure GetNames(o: ISuperObject); + var + obj: ISuperObject; + f: TSuperObjectIter; + begin + obj := o['name']; + if ObjectIsType(obj, stString) then + names[obj.AsString] := o; + + case FindDataType(o) of + dtMap: + begin + obj := o['mapping']; + if ObjectIsType(obj, stObject) then + begin + if ObjectFindFirst(obj, f) then + repeat + if ObjectIsType(f.val, stObject) then + GetNames(f.val); + until not ObjectFindNext(f); + ObjectFindClose(f); + end; + end; + dtSeq: + begin + obj := o['sequence']; + if ObjectIsType(obj, stObject) then + GetNames(obj); + end; + end; + end; + + function FindInheritedField(const prop: SOString; p: ISuperObject): ISuperObject; + var + o: ISuperObject; + e: TSuperAvlEntry; + begin + o := p['mapping']; + if ObjectIsType(o, stObject) then + begin + o := o.AsObject.GetO(prop); + if o <> nil then + begin + Result := o; + Exit; + end; + end; + + o := p['inherit']; + if ObjectIsType(o, stString) then + begin + e := names.AsObject.Search(o.AsString); + if (e <> nil) then + Result := FindInheritedField(prop, e.Value) else + Result := nil; + end else + Result := nil; + end; + + function InheritedFieldExist(const obj: ISuperObject; p: ISuperObject; const name: SOString = ''): boolean; + var + o: ISuperObject; + e: TSuperAvlEntry; + j: TSuperAvlIterator; + begin + Result := true; + o := p['mapping']; + if ObjectIsType(o, stObject) then + begin + j := TSuperAvlIterator.Create(o.AsObject); + try + j.First; + e := j.GetIter; + while e <> nil do + begin + if obj.AsObject.Search(e.Name) = nil then + begin + Result := False; + if assigned(callback) then + callback(sender, veFieldNotFound, name + '.' + e.Name); + end; + j.Next; + e := j.GetIter; + end; + + finally + j.Free; + end; + end; + + o := p['inherit']; + if ObjectIsType(o, stString) then + begin + e := names.AsObject.Search(o.AsString); + if (e <> nil) then + Result := InheritedFieldExist(obj, e.Value, name) and Result; + end; + end; + + function getInheritedBool(f: PSOChar; p: ISuperObject; default: boolean = false): boolean; + var + o: ISuperObject; + begin + o := FindInheritedProperty(f, p); + case ObjectGetType(o) of + stBoolean: Result := o.AsBoolean; + stNull: Result := Default; + else + Result := default; + if assigned(callback) then + callback(sender, veRuleMalformated, f); + end; + end; + + procedure GetInheritedFieldList(list: ISuperObject; p: ISuperObject); + var + o: ISuperObject; + e: TSuperAvlEntry; + i: TSuperAvlIterator; + begin + Result := true; + o := p['mapping']; + if ObjectIsType(o, stObject) then + begin + i := TSuperAvlIterator.Create(o.AsObject); + try + i.First; + e := i.GetIter; + while e <> nil do + begin + if list.AsObject.Search(e.Name) = nil then + list[e.Name] := e.Value; + i.Next; + e := i.GetIter; + end; + + finally + i.Free; + end; + end; + + o := p['inherit']; + if ObjectIsType(o, stString) then + begin + e := names.AsObject.Search(o.AsString); + if (e <> nil) then + GetInheritedFieldList(list, e.Value); + end; + end; + + function CheckEnum(o: ISuperObject; p: ISuperObject; name: SOString = ''): boolean; + var + enum: ISuperObject; + i: integer; + begin + Result := false; + enum := FindInheritedProperty('enum', p); + case ObjectGetType(enum) of + stArray: + for i := 0 to enum.AsArray.Length - 1 do + if (o.AsString = enum.AsArray[i].AsString) then + begin + Result := true; + exit; + end; + stNull: Result := true; + else + Result := false; + if assigned(callback) then + callback(sender, veRuleMalformated, ''); + Exit; + end; + + if (not Result) and assigned(callback) then + callback(sender, veValueNotInEnum, name); + end; + + function CheckLength(len: integer; p: ISuperObject; const objpath: SOString): boolean; + var + length, o: ISuperObject; + begin + result := true; + length := FindInheritedProperty('length', p); + case ObjectGetType(length) of + stObject: + begin + o := length.AsObject.GetO('min'); + if (o <> nil) and (o.AsInteger > len) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidLength, objpath); + end; + o := length.AsObject.GetO('max'); + if (o <> nil) and (o.AsInteger < len) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidLength, objpath); + end; + o := length.AsObject.GetO('minex'); + if (o <> nil) and (o.AsInteger >= len) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidLength, objpath); + end; + o := length.AsObject.GetO('maxex'); + if (o <> nil) and (o.AsInteger <= len) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidLength, objpath); + end; + end; + stNull: ; + else + Result := false; + if assigned(callback) then + callback(sender, veRuleMalformated, ''); + end; + end; + + function CheckRange(obj: ISuperObject; p: ISuperObject; const objpath: SOString): boolean; + var + length, o: ISuperObject; + begin + result := true; + length := FindInheritedProperty('range', p); + case ObjectGetType(length) of + stObject: + begin + o := length.AsObject.GetO('min'); + if (o <> nil) and (o.Compare(obj) = cpGreat) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidRange, objpath); + end; + o := length.AsObject.GetO('max'); + if (o <> nil) and (o.Compare(obj) = cpLess) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidRange, objpath); + end; + o := length.AsObject.GetO('minex'); + if (o <> nil) and (o.Compare(obj) in [cpGreat, cpEqu]) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidRange, objpath); + end; + o := length.AsObject.GetO('maxex'); + if (o <> nil) and (o.Compare(obj) in [cpLess, cpEqu]) then + begin + Result := false; + if assigned(callback) then + callback(sender, veInvalidRange, objpath); + end; + end; + stNull: ; + else + Result := false; + if assigned(callback) then + callback(sender, veRuleMalformated, ''); + end; + end; + + + function process(o: ISuperObject; p: ISuperObject; objpath: SOString = ''): boolean; + var + ite: TSuperAvlIterator; + ent: TSuperAvlEntry; + p2, o2, sequence: ISuperObject; + s: SOString; + i: integer; + uniquelist, fieldlist: ISuperObject; + begin + Result := true; + if (o = nil) then + begin + if getInheritedBool('required', p) then + begin + if assigned(callback) then + callback(sender, veFieldIsRequired, objpath); + result := false; + end; + end else + case FindDataType(p) of + dtStr: + case ObjectGetType(o) of + stString: + begin + Result := Result and CheckLength(Length(o.AsString), p, objpath); + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtBool: + case ObjectGetType(o) of + stBoolean: + begin + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtInt: + case ObjectGetType(o) of + stInt: + begin + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtFloat: + case ObjectGetType(o) of + stDouble, stCurrency: + begin + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtMap: + case ObjectGetType(o) of + stObject: + begin + // all objects have and match a rule ? + ite := TSuperAvlIterator.Create(o.AsObject); + try + ite.First; + ent := ite.GetIter; + while ent <> nil do + begin + p2 := FindInheritedField(ent.Name, p); + if ObjectIsType(p2, stObject) then + result := process(ent.Value, p2, objpath + '.' + ent.Name) and result else + begin + if assigned(callback) then + callback(sender, veUnexpectedField, objpath + '.' + ent.Name); + result := false; // field have no rule + end; + ite.Next; + ent := ite.GetIter; + end; + finally + ite.Free; + end; + + // all expected field exists ? + Result := InheritedFieldExist(o, p, objpath) and Result; + end; + stNull: {nop}; + else + result := false; + if assigned(callback) then + callback(sender, veRuleMalformated, objpath); + end; + dtSeq: + case ObjectGetType(o) of + stArray: + begin + sequence := FindInheritedProperty('sequence', p); + if sequence <> nil then + case ObjectGetType(sequence) of + stObject: + begin + for i := 0 to o.AsArray.Length - 1 do + result := process(o.AsArray.GetO(i), sequence, objpath + '[' + IntToStr(i) + ']') and result; + if getInheritedBool('unique', sequence) then + begin + // type is unique ? + uniquelist := TSuperObject.Create(stObject); + try + for i := 0 to o.AsArray.Length - 1 do + begin + s := o.AsArray.GetO(i).AsString; + if (s <> '') then + begin + if uniquelist.AsObject.Search(s) = nil then + uniquelist[s] := nil else + begin + Result := False; + if Assigned(callback) then + callback(sender, veDuplicateEntry, objpath + '[' + IntToStr(i) + ']'); + end; + end; + end; + finally + uniquelist := nil; + end; + end; + + // field is unique ? + if (FindDataType(sequence) = dtMap) then + begin + fieldlist := TSuperObject.Create(stObject); + try + GetInheritedFieldList(fieldlist, sequence); + ite := TSuperAvlIterator.Create(fieldlist.AsObject); + try + ite.First; + ent := ite.GetIter; + while ent <> nil do + begin + if getInheritedBool('unique', ent.Value) then + begin + uniquelist := TSuperObject.Create(stObject); + try + for i := 0 to o.AsArray.Length - 1 do + begin + o2 := o.AsArray.GetO(i); + if o2 <> nil then + begin + s := o2.AsObject.GetO(ent.Name).AsString; + if (s <> '') then + if uniquelist.AsObject.Search(s) = nil then + uniquelist[s] := nil else + begin + Result := False; + if Assigned(callback) then + callback(sender, veDuplicateEntry, objpath + '[' + IntToStr(i) + '].' + ent.name); + end; + end; + end; + finally + uniquelist := nil; + end; + end; + ite.Next; + ent := ite.GetIter; + end; + finally + ite.Free; + end; + finally + fieldlist := nil; + end; + end; + + + end; + stNull: {nop}; + else + result := false; + if assigned(callback) then + callback(sender, veRuleMalformated, objpath); + end; + Result := Result and CheckLength(o.AsArray.Length, p, objpath); + + end; + else + result := false; + if assigned(callback) then + callback(sender, veRuleMalformated, objpath); + end; + dtNumber: + case ObjectGetType(o) of + stInt, + stDouble, stCurrency: + begin + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtText: + case ObjectGetType(o) of + stInt, + stDouble, + stCurrency, + stString: + begin + result := result and CheckLength(Length(o.AsString), p, objpath); + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtScalar: + case ObjectGetType(o) of + stBoolean, + stDouble, + stCurrency, + stInt, + stString: + begin + result := result and CheckLength(Length(o.AsString), p, objpath); + Result := Result and CheckRange(o, p, objpath); + end; + else + if assigned(callback) then + callback(sender, veInvalidDataType, objpath); + result := false; + end; + dtAny:; + else + if assigned(callback) then + callback(sender, veRuleMalformated, objpath); + result := false; + end; + Result := Result and CheckEnum(o, p, objpath) + + end; +var + j: integer; + +begin + Result := False; + datatypes := TSuperObject.Create(stObject); + names := TSuperObject.Create; + try + datatypes.I['str'] := ord(dtStr); + datatypes.I['int'] := ord(dtInt); + datatypes.I['float'] := ord(dtFloat); + datatypes.I['number'] := ord(dtNumber); + datatypes.I['text'] := ord(dtText); + datatypes.I['bool'] := ord(dtBool); + datatypes.I['map'] := ord(dtMap); + datatypes.I['seq'] := ord(dtSeq); + datatypes.I['scalar'] := ord(dtScalar); + datatypes.I['any'] := ord(dtAny); + + if ObjectIsType(defs, stArray) then + for j := 0 to defs.AsArray.Length - 1 do + if ObjectIsType(defs.AsArray[j], stObject) then + GetNames(defs.AsArray[j]) else + begin + if assigned(callback) then + callback(sender, veRuleMalformated, ''); + Exit; + end; + + + if ObjectIsType(rules, stObject) then + GetNames(rules) else + begin + if assigned(callback) then + callback(sender, veRuleMalformated, ''); + Exit; + end; + + Result := process(self, rules); + + finally + datatypes := nil; + names := nil; + end; +end; + +function TSuperObject._AddRef: Integer; stdcall; +begin + Result := InterlockedIncrement(FRefCount); +end; + +function TSuperObject._Release: Integer; stdcall; +begin + Result := InterlockedDecrement(FRefCount); + if Result = 0 then + Destroy; +end; + +function TSuperObject.Compare(const str: SOString): TSuperCompareResult; +begin + Result := Compare(TSuperObject.ParseString(PSOChar(str), False)); +end; + +function TSuperObject.Compare(const obj: ISuperObject): TSuperCompareResult; + function GetIntCompResult(const i: int64): TSuperCompareResult; + begin + if i < 0 then result := cpLess else + if i = 0 then result := cpEqu else + Result := cpGreat; + end; + + function GetDblCompResult(const d: double): TSuperCompareResult; + begin + if d < 0 then result := cpLess else + if d = 0 then result := cpEqu else + Result := cpGreat; + end; + +begin + case DataType of + stBoolean: + case ObjectGetType(obj) of + stBoolean: Result := GetIntCompResult(ord(FO.c_boolean) - ord(obj.AsBoolean)); + stDouble: Result := GetDblCompResult(ord(FO.c_boolean) - obj.AsDouble); + stCurrency:Result := GetDblCompResult(ord(FO.c_boolean) - obj.AsCurrency); + stInt: Result := GetIntCompResult(ord(FO.c_boolean) - obj.AsInteger); + stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString))); + else + Result := cpError; + end; + stDouble: + case ObjectGetType(obj) of + stBoolean: Result := GetDblCompResult(FO.c_double - ord(obj.AsBoolean)); + stDouble: Result := GetDblCompResult(FO.c_double - obj.AsDouble); + stCurrency:Result := GetDblCompResult(FO.c_double - obj.AsCurrency); + stInt: Result := GetDblCompResult(FO.c_double - obj.AsInteger); + stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString))); + else + Result := cpError; + end; + stCurrency: + case ObjectGetType(obj) of + stBoolean: Result := GetDblCompResult(FO.c_currency - ord(obj.AsBoolean)); + stDouble: Result := GetDblCompResult(FO.c_currency - obj.AsDouble); + stCurrency:Result := GetDblCompResult(FO.c_currency - obj.AsCurrency); + stInt: Result := GetDblCompResult(FO.c_currency - obj.AsInteger); + stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString))); + else + Result := cpError; + end; + stInt: + case ObjectGetType(obj) of + stBoolean: Result := GetIntCompResult(FO.c_int - ord(obj.AsBoolean)); + stDouble: Result := GetDblCompResult(FO.c_int - obj.AsDouble); + stCurrency:Result := GetDblCompResult(FO.c_int - obj.AsCurrency); + stInt: Result := GetIntCompResult(FO.c_int - obj.AsInteger); + stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString))); + else + Result := cpError; + end; + stString: + case ObjectGetType(obj) of + stBoolean, + stDouble, + stCurrency, + stInt, + stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString))); + else + Result := cpError; + end; + else + Result := cpError; + end; +end; + +{$IFDEF SUPER_METHOD} +function TSuperObject.AsMethod: TSuperMethod; +begin + if FDataType = stMethod then + Result := FO.c_method else + Result := nil; +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +constructor TSuperObject.Create(m: TSuperMethod); +begin + Create(stMethod); + FO.c_method := m; +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +function TSuperObject.GetM(const path: SOString): TSuperMethod; +var + v: ISuperObject; +begin + v := ParseString(PSOChar(path), False, True, Self); + if (v <> nil) and (ObjectGetType(v) = stMethod) then + Result := v.AsMethod else + Result := nil; +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +procedure TSuperObject.PutM(const path: SOString; Value: TSuperMethod); +begin + ParseString(PSOChar(path), False, True, Self, [foCreatePath, foPutValue], TSuperObject.Create(Value)); +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +function TSuperObject.call(const path: SOString; const param: ISuperObject): ISuperObject; +begin + Result := ParseString(PSOChar(path), False, True, Self, [foCallMethod], param); +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +function TSuperObject.call(const path, param: SOString): ISuperObject; +begin + Result := ParseString(PSOChar(path), False, True, Self, [foCallMethod], TSuperObject.ParseString(PSOChar(param), False)); +end; +{$ENDIF} + +function TSuperObject.GetProcessing: boolean; +begin + Result := FProcessing; +end; + +procedure TSuperObject.SetDataPtr(const Value: Pointer); +begin + FDataPtr := Value; +end; + +procedure TSuperObject.SetProcessing(value: boolean); +begin + FProcessing := value; +end; + +{ TSuperArray } + +function TSuperArray.Add(const Data: ISuperObject): Integer; +begin + Result := FLength; + PutO(Result, data); +end; + +function TSuperArray.Delete(index: Integer): ISuperObject; +begin + if (Index >= 0) and (Index < FLength) then + begin + Result := FArray^[index]; + FArray^[index] := nil; + Dec(FLength); + if Index < FLength then + begin + Move(FArray^[index + 1], FArray^[index], + (FLength - index) * SizeOf(Pointer)); + Pointer(FArray^[FLength]) := nil; + end; + end; +end; + +procedure TSuperArray.Insert(index: Integer; const value: ISuperObject); +begin + if (Index >= 0) then + if (index < FLength) then + begin + if FLength = FSize then + Expand(index); + if Index < FLength then + Move(FArray^[index], FArray^[index + 1], + (FLength - index) * SizeOf(Pointer)); + Pointer(FArray^[index]) := nil; + FArray^[index] := value; + Inc(FLength); + end else + PutO(index, value); +end; + +procedure TSuperArray.Clear(all: boolean); +var + j: Integer; +begin + for j := 0 to FLength - 1 do + if FArray^[j] <> nil then + begin + if all then + FArray^[j].Clear(all); + FArray^[j] := nil; + end; + FLength := 0; +end; + +procedure TSuperArray.Pack(all: boolean); +var + PackedCount, StartIndex, EndIndex, j: Integer; +begin + if FLength > 0 then + begin + PackedCount := 0; + StartIndex := 0; + repeat + while (StartIndex < FLength) and (FArray^[StartIndex] = nil) do + Inc(StartIndex); + if StartIndex < FLength then + begin + EndIndex := StartIndex; + while (EndIndex < FLength) and (FArray^[EndIndex] <> nil) do + Inc(EndIndex); + + Dec(EndIndex); + + if StartIndex > PackedCount then + Move(FArray^[StartIndex], FArray^[PackedCount], (EndIndex - StartIndex + 1) * SizeOf(Pointer)); + + Inc(PackedCount, EndIndex - StartIndex + 1); + StartIndex := EndIndex + 1; + end; + until StartIndex >= FLength; + FillChar(FArray^[PackedCount], (FLength - PackedCount) * sizeof(Pointer), 0); + FLength := PackedCount; + if all then + for j := 0 to FLength - 1 do + FArray^[j].Pack(all); + end; +end; + +constructor TSuperArray.Create; +begin + inherited Create; + FSize := SUPER_ARRAY_LIST_DEFAULT_SIZE; + FLength := 0; + GetMem(FArray, sizeof(Pointer) * FSize); + FillChar(FArray^, sizeof(Pointer) * FSize, 0); +end; + +destructor TSuperArray.Destroy; +begin + Clear; + FreeMem(FArray); + inherited; +end; + +procedure TSuperArray.Expand(max: Integer); +var + new_size: Integer; +begin + if (max < FSize) then + Exit; + if max < (FSize shl 1) then + new_size := (FSize shl 1) else + new_size := max + 1; + ReallocMem(FArray, new_size * sizeof(Pointer)); + FillChar(FArray^[FSize], (new_size - FSize) * sizeof(Pointer), 0); + FSize := new_size; +end; + +function TSuperArray.GetO(const index: Integer): ISuperObject; +begin + if(index >= FLength) then + Result := nil else + Result := FArray^[index]; +end; + +function TSuperArray.GetB(const index: integer): Boolean; +var + obj: ISuperObject; +begin + obj := GetO(index); + if obj <> nil then + Result := obj.AsBoolean else + Result := false; +end; + +function TSuperArray.GetD(const index: integer): Double; +var + obj: ISuperObject; +begin + obj := GetO(index); + if obj <> nil then + Result := obj.AsDouble else + Result := 0.0; +end; + +function TSuperArray.GetI(const index: integer): SuperInt; +var + obj: ISuperObject; +begin + obj := GetO(index); + if obj <> nil then + Result := obj.AsInteger else + Result := 0; +end; + +function TSuperArray.GetS(const index: integer): SOString; +var + obj: ISuperObject; +begin + obj := GetO(index); + if obj <> nil then + Result := obj.AsString else + Result := ''; +end; + +procedure TSuperArray.PutO(const index: Integer; const Value: ISuperObject); +begin + Expand(index); + FArray^[index] := value; + if(FLength <= index) then FLength := index + 1; +end; + +function TSuperArray.GetN(const index: integer): ISuperObject; +begin + Result := GetO(index); + if Result = nil then + Result := TSuperObject.Create(stNull); +end; + +procedure TSuperArray.PutN(const index: integer; const Value: ISuperObject); +begin + if Value <> nil then + PutO(index, Value) else + PutO(index, TSuperObject.Create(stNull)); +end; + +procedure TSuperArray.PutB(const index: integer; Value: Boolean); +begin + PutO(index, TSuperObject.Create(Value)); +end; + +procedure TSuperArray.PutD(const index: integer; Value: Double); +begin + PutO(index, TSuperObject.Create(Value)); +end; + +function TSuperArray.GetC(const index: integer): Currency; +var + obj: ISuperObject; +begin + obj := GetO(index); + if obj <> nil then + Result := obj.AsCurrency else + Result := 0.0; +end; + +procedure TSuperArray.PutC(const index: integer; Value: Currency); +begin + PutO(index, TSuperObject.CreateCurrency(Value)); +end; + +procedure TSuperArray.PutI(const index: integer; Value: SuperInt); +begin + PutO(index, TSuperObject.Create(Value)); +end; + +procedure TSuperArray.PutS(const index: integer; const Value: SOString); +begin + PutO(index, TSuperObject.Create(Value)); +end; + +{$IFDEF SUPER_METHOD} +function TSuperArray.GetM(const index: integer): TSuperMethod; +var + v: ISuperObject; +begin + v := GetO(index); + if (ObjectGetType(v) = stMethod) then + Result := v.AsMethod else + Result := nil; +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +procedure TSuperArray.PutM(const index: integer; Value: TSuperMethod); +begin + PutO(index, TSuperObject.Create(Value)); +end; +{$ENDIF} + +{ TSuperWriterString } + +function TSuperWriterString.Append(buf: PSOChar; Size: Integer): Integer; + function max(a, b: Integer): integer; begin if a > b then Result := a else Result := b end; +begin + Result := size; + if Size > 0 then + begin + if (FSize - FBPos <= size) then + begin + FSize := max(FSize * 2, FBPos + size + 8); + ReallocMem(FBuf, FSize * SizeOf(SOChar)); + end; + // fast move + case size of + 1: FBuf[FBPos] := buf^; + 2: PInteger(@FBuf[FBPos])^ := PInteger(buf)^; + 4: PInt64(@FBuf[FBPos])^ := PInt64(buf)^; + else + move(buf^, FBuf[FBPos], size * SizeOf(SOChar)); + end; + inc(FBPos, size); + FBuf[FBPos] := #0; + end; +end; + +function TSuperWriterString.Append(buf: PSOChar): Integer; +begin + Result := Append(buf, strlen(buf)); +end; + +constructor TSuperWriterString.Create; +begin + inherited; + FSize := 32; + FBPos := 0; + GetMem(FBuf, FSize * SizeOf(SOChar)); +end; + +destructor TSuperWriterString.Destroy; +begin + inherited; + if FBuf <> nil then + FreeMem(FBuf) +end; + +function TSuperWriterString.GetString: SOString; +begin + SetString(Result, FBuf, FBPos); +end; + +procedure TSuperWriterString.Reset; +begin + FBuf[0] := #0; + FBPos := 0; +end; + +procedure TSuperWriterString.TrimRight; +begin + while (FBPos > 0) and (FBuf[FBPos-1] < #256) and (AnsiChar(FBuf[FBPos-1]) in [#32, #13, #10]) do + begin + dec(FBPos); + FBuf[FBPos] := #0; + end; +end; + +{ TSuperWriterStream } + +function TSuperWriterStream.Append(buf: PSOChar): Integer; +begin + Result := Append(buf, StrLen(buf)); +end; + +constructor TSuperWriterStream.Create(AStream: TStream); +begin + inherited Create; + FStream := AStream; +end; + +procedure TSuperWriterStream.Reset; +begin + FStream.Size := 0; +end; + +{ TSuperWriterStream } + +function TSuperAnsiWriterStream.Append(buf: PSOChar; Size: Integer): Integer; +var + Buffer: array[0..1023] of AnsiChar; + pBuffer: PAnsiChar; + i: Integer; +begin + if Size = 1 then + Result := FStream.Write(buf^, Size) else + begin + if Size > SizeOf(Buffer) then + GetMem(pBuffer, Size) else + pBuffer := @Buffer; + try + for i := 0 to Size - 1 do + pBuffer[i] := AnsiChar(buf[i]); + Result := FStream.Write(pBuffer^, Size); + finally + if pBuffer <> @Buffer then + FreeMem(pBuffer); + end; + end; +end; + +{ TSuperUnicodeWriterStream } + +function TSuperUnicodeWriterStream.Append(buf: PSOChar; Size: Integer): Integer; +begin + Result := FStream.Write(buf^, Size * 2); +end; + +{ TSuperWriterFake } + +function TSuperWriterFake.Append(buf: PSOChar; Size: Integer): Integer; +begin + inc(FSize, Size); + Result := FSize; +end; + +function TSuperWriterFake.Append(buf: PSOChar): Integer; +begin + inc(FSize, Strlen(buf)); + Result := FSize; +end; + +constructor TSuperWriterFake.Create; +begin + inherited Create; + FSize := 0; +end; + +procedure TSuperWriterFake.Reset; +begin + FSize := 0; +end; + +{ TSuperWriterSock } + +function TSuperWriterSock.Append(buf: PSOChar; Size: Integer): Integer; +var + Buffer: array[0..1023] of AnsiChar; + pBuffer: PAnsiChar; + i: Integer; +begin + if Size = 1 then +{$IFDEF FPC} + Result := fpsend(FSocket, buf, size, 0) else +{$ELSE} + Result := send(FSocket, buf^, size, 0) else +{$ENDIF} + begin + if Size > SizeOf(Buffer) then + GetMem(pBuffer, Size) else + pBuffer := @Buffer; + try + for i := 0 to Size - 1 do + pBuffer[i] := AnsiChar(buf[i]); +{$IFDEF FPC} + Result := fpsend(FSocket, pBuffer, size, 0); +{$ELSE} + Result := send(FSocket, pBuffer^, size, 0); +{$ENDIF} + finally + if pBuffer <> @Buffer then + FreeMem(pBuffer); + end; + end; + inc(FSize, Result); +end; + +function TSuperWriterSock.Append(buf: PSOChar): Integer; +begin + Result := Append(buf, StrLen(buf)); +end; + +constructor TSuperWriterSock.Create(ASocket: Integer); +begin + inherited Create; + FSocket := ASocket; + FSize := 0; +end; + +procedure TSuperWriterSock.Reset; +begin + FSize := 0; +end; + +{ TSuperTokenizer } + +constructor TSuperTokenizer.Create; +begin + pb := TSuperWriterString.Create; + line := 1; + col := 0; + Reset; +end; + +destructor TSuperTokenizer.Destroy; +begin + Reset; + pb.Free; + inherited; +end; + +procedure TSuperTokenizer.Reset; +var + i: integer; +begin + for i := depth downto 0 do + ResetLevel(i); + depth := 0; + err := teSuccess; +end; + +procedure TSuperTokenizer.ResetLevel(adepth: integer); +begin + stack[adepth].state := tsEatws; + stack[adepth].saved_state := tsStart; + stack[adepth].current := nil; + stack[adepth].field_name := ''; + stack[adepth].obj := nil; + stack[adepth].parent := nil; + stack[adepth].gparent := nil; +end; + +{ TSuperAvlTree } + +constructor TSuperAvlTree.Create; +begin + FRoot := nil; + FCount := 0; +end; + +destructor TSuperAvlTree.Destroy; +begin + Clear; + inherited; +end; + +function TSuperAvlTree.IsEmpty: boolean; +begin + result := FRoot = nil; +end; + +function TSuperAvlTree.balance(bal: TSuperAvlEntry): TSuperAvlEntry; +var + deep, old: TSuperAvlEntry; + bf: integer; +begin + if (bal.FBf > 0) then + begin + deep := bal.FGt; + if (deep.FBf < 0) then + begin + old := bal; + bal := deep.FLt; + old.FGt := bal.FLt; + deep.FLt := bal.FGt; + bal.FLt := old; + bal.FGt := deep; + bf := bal.FBf; + if (bf <> 0) then + begin + if (bf > 0) then + begin + old.FBf := -1; + deep.FBf := 0; + end else + begin + deep.FBf := 1; + old.FBf := 0; + end; + bal.FBf := 0; + end else + begin + old.FBf := 0; + deep.FBf := 0; + end; + end else + begin + bal.FGt := deep.FLt; + deep.FLt := bal; + if (deep.FBf = 0) then + begin + deep.FBf := -1; + bal.FBf := 1; + end else + begin + deep.FBf := 0; + bal.FBf := 0; + end; + bal := deep; + end; + end else + begin + (* "Less than" subtree is deeper. *) + + deep := bal.FLt; + if (deep.FBf > 0) then + begin + old := bal; + bal := deep.FGt; + old.FLt := bal.FGt; + deep.FGt := bal.FLt; + bal.FGt := old; + bal.FLt := deep; + + bf := bal.FBf; + if (bf <> 0) then + begin + if (bf < 0) then + begin + old.FBf := 1; + deep.FBf := 0; + end else + begin + deep.FBf := -1; + old.FBf := 0; + end; + bal.FBf := 0; + end else + begin + old.FBf := 0; + deep.FBf := 0; + end; + end else + begin + bal.FLt := deep.FGt; + deep.FGt := bal; + if (deep.FBf = 0) then + begin + deep.FBf := 1; + bal.FBf := -1; + end else + begin + deep.FBf := 0; + bal.FBf := 0; + end; + bal := deep; + end; + end; + Result := bal; +end; + +function TSuperAvlTree.Insert(h: TSuperAvlEntry): TSuperAvlEntry; +var + unbal, parentunbal, hh, parent: TSuperAvlEntry; + depth, unbaldepth: longint; + cmp: integer; + unbalbf: integer; + branch: TSuperAvlBitArray; + p: Pointer; +begin + inc(FCount); + h.FLt := nil; + h.FGt := nil; + h.FBf := 0; + branch := []; + + if (FRoot = nil) then + FRoot := h + else + begin + unbal := nil; + parentunbal := nil; + depth := 0; + unbaldepth := 0; + hh := FRoot; + parent := nil; + repeat + if (hh.FBf <> 0) then + begin + unbal := hh; + parentunbal := parent; + unbaldepth := depth; + end; + if hh.FHash <> h.FHash then + begin + if hh.FHash < h.FHash then cmp := -1 else + if hh.FHash > h.FHash then cmp := 1 else + cmp := 0; + end else + cmp := CompareNodeNode(h, hh); + if (cmp = 0) then + begin + Result := hh; + //exchange data + p := hh.Ptr; + hh.FPtr := h.Ptr; + h.FPtr := p; + doDeleteEntry(h, false); + dec(FCount); + exit; + end; + parent := hh; + if (cmp > 0) then + begin + hh := hh.FGt; + include(branch, depth); + end else + begin + hh := hh.FLt; + exclude(branch, depth); + end; + inc(depth); + until (hh = nil); + + if (cmp < 0) then + parent.FLt := h else + parent.FGt := h; + + depth := unbaldepth; + + if (unbal = nil) then + hh := FRoot + else + begin + if depth in branch then + cmp := 1 else + cmp := -1; + inc(depth); + unbalbf := unbal.FBf; + if (cmp < 0) then + dec(unbalbf) else + inc(unbalbf); + if cmp < 0 then + hh := unbal.FLt else + hh := unbal.FGt; + if ((unbalbf <> -2) and (unbalbf <> 2)) then + begin + unbal.FBf := unbalbf; + unbal := nil; + end; + end; + + if (hh <> nil) then + while (h <> hh) do + begin + if depth in branch then + cmp := 1 else + cmp := -1; + inc(depth); + if (cmp < 0) then + begin + hh.FBf := -1; + hh := hh.FLt; + end else (* cmp > 0 *) + begin + hh.FBf := 1; + hh := hh.FGt; + end; + end; + + if (unbal <> nil) then + begin + unbal := balance(unbal); + if (parentunbal = nil) then + FRoot := unbal + else + begin + depth := unbaldepth - 1; + if depth in branch then + cmp := 1 else + cmp := -1; + if (cmp < 0) then + parentunbal.FLt := unbal else + parentunbal.FGt := unbal; + end; + end; + end; + result := h; +end; + +function TSuperAvlTree.Search(const k: SOString; st: TSuperAvlSearchTypes): TSuperAvlEntry; +var + cmp, target_cmp: integer; + match_h, h: TSuperAvlEntry; + ha: Cardinal; +begin + ha := TSuperAvlEntry.Hash(k); + + match_h := nil; + h := FRoot; + + if (stLess in st) then + target_cmp := 1 else + if (stGreater in st) then + target_cmp := -1 else + target_cmp := 0; + + while (h <> nil) do + begin + if h.FHash < ha then cmp := -1 else + if h.FHash > ha then cmp := 1 else + cmp := 0; + + if cmp = 0 then + cmp := CompareKeyNode(PSOChar(k), h); + if (cmp = 0) then + begin + if (stEqual in st) then + begin + match_h := h; + break; + end; + cmp := -target_cmp; + end + else + if (target_cmp <> 0) then + if ((cmp xor target_cmp) and SUPER_AVL_MASK_HIGH_BIT) = 0 then + match_h := h; + if cmp < 0 then + h := h.FLt else + h := h.FGt; + end; + result := match_h; +end; + +function TSuperAvlTree.Delete(const k: SOString): ISuperObject; +var + depth, rm_depth: longint; + branch: TSuperAvlBitArray; + h, parent, child, path, rm, parent_rm: TSuperAvlEntry; + cmp, cmp_shortened_sub_with_path, reduced_depth, bf: integer; + ha: Cardinal; +begin + ha := TSuperAvlEntry.Hash(k); + cmp_shortened_sub_with_path := 0; + branch := []; + + depth := 0; + h := FRoot; + parent := nil; + while true do + begin + if (h = nil) then + exit; + if h.FHash < ha then cmp := -1 else + if h.FHash > ha then cmp := 1 else + cmp := 0; + + if cmp = 0 then + cmp := CompareKeyNode(k, h); + if (cmp = 0) then + break; + parent := h; + if (cmp > 0) then + begin + h := h.FGt; + include(branch, depth) + end else + begin + h := h.FLt; + exclude(branch, depth) + end; + inc(depth); + cmp_shortened_sub_with_path := cmp; + end; + rm := h; + parent_rm := parent; + rm_depth := depth; + + if (h.FBf < 0) then + begin + child := h.FLt; + exclude(branch, depth); + cmp := -1; + end else + begin + child := h.FGt; + include(branch, depth); + cmp := 1; + end; + inc(depth); + + if (child <> nil) then + begin + cmp := -cmp; + repeat + parent := h; + h := child; + if (cmp < 0) then + begin + child := h.FLt; + exclude(branch, depth); + end else + begin + child := h.FGt; + include(branch, depth); + end; + inc(depth); + until (child = nil); + + if (parent = rm) then + cmp_shortened_sub_with_path := -cmp else + cmp_shortened_sub_with_path := cmp; + + if cmp > 0 then + child := h.FLt else + child := h.FGt; + end; + + if (parent = nil) then + FRoot := child else + if (cmp_shortened_sub_with_path < 0) then + parent.FLt := child else + parent.FGt := child; + + if parent = rm then + path := h else + path := parent; + + if (h <> rm) then + begin + h.FLt := rm.FLt; + h.FGt := rm.FGt; + h.FBf := rm.FBf; + if (parent_rm = nil) then + FRoot := h + else + begin + depth := rm_depth - 1; + if (depth in branch) then + parent_rm.FGt := h else + parent_rm.FLt := h; + end; + end; + + if (path <> nil) then + begin + h := FRoot; + parent := nil; + depth := 0; + while (h <> path) do + begin + if (depth in branch) then + begin + child := h.FGt; + h.FGt := parent; + end else + begin + child := h.FLt; + h.FLt := parent; + end; + inc(depth); + parent := h; + h := child; + end; + + reduced_depth := 1; + cmp := cmp_shortened_sub_with_path; + while true do + begin + if (reduced_depth <> 0) then + begin + bf := h.FBf; + if (cmp < 0) then + inc(bf) else + dec(bf); + if ((bf = -2) or (bf = 2)) then + begin + h := balance(h); + bf := h.FBf; + end else + h.FBf := bf; + reduced_depth := integer(bf = 0); + end; + if (parent = nil) then + break; + child := h; + h := parent; + dec(depth); + if depth in branch then + cmp := 1 else + cmp := -1; + if (cmp < 0) then + begin + parent := h.FLt; + h.FLt := child; + end else + begin + parent := h.FGt; + h.FGt := child; + end; + end; + FRoot := h; + end; + if rm <> nil then + begin + Result := rm.GetValue; + doDeleteEntry(rm, false); + dec(FCount); + end; +end; + +procedure TSuperAvlTree.Pack(all: boolean); +var + node1, node2: TSuperAvlEntry; + list: TList; + i: Integer; +begin + node1 := FRoot; + list := TList.Create; + while node1 <> nil do + begin + if (node1.FLt = nil) then + begin + node2 := node1.FGt; + if (node1.FPtr = nil) then + list.Add(node1) else + if all then + node1.Value.Pack(all); + end + else + begin + node2 := node1.FLt; + node1.FLt := node2.FGt; + node2.FGt := node1; + end; + node1 := node2; + end; + for i := 0 to list.Count - 1 do + Delete(TSuperAvlEntry(list[i]).FName); + list.Free; +end; + +procedure TSuperAvlTree.Clear(all: boolean); +var + node1, node2: TSuperAvlEntry; +begin + node1 := FRoot; + while node1 <> nil do + begin + if (node1.FLt = nil) then + begin + node2 := node1.FGt; + doDeleteEntry(node1, all); + end + else + begin + node2 := node1.FLt; + node1.FLt := node2.FGt; + node2.FGt := node1; + end; + node1 := node2; + end; + FRoot := nil; + FCount := 0; +end; + +function TSuperAvlTree.CompareKeyNode(const k: SOString; h: TSuperAvlEntry): integer; +begin + Result := StrComp(PSOChar(k), PSOChar(h.FName)); +end; + +function TSuperAvlTree.CompareNodeNode(node1, node2: TSuperAvlEntry): integer; +begin + Result := StrComp(PSOChar(node1.FName), PSOChar(node2.FName)); +end; + +{ TSuperAvlIterator } + +(* Initialize depth to invalid value, to indicate iterator is +** invalid. (Depth is zero-base.) It's not necessary to initialize +** iterators prior to passing them to the "start" function. +*) + +constructor TSuperAvlIterator.Create(tree: TSuperAvlTree); +begin + FDepth := not 0; + FTree := tree; +end; + +procedure TSuperAvlIterator.Search(const k: SOString; st: TSuperAvlSearchTypes); +var + h: TSuperAvlEntry; + d: longint; + cmp, target_cmp: integer; + ha: Cardinal; +begin + ha := TSuperAvlEntry.Hash(k); + h := FTree.FRoot; + d := 0; + FDepth := not 0; + if (h = nil) then + exit; + + if (stLess in st) then + target_cmp := 1 else + if (stGreater in st) then + target_cmp := -1 else + target_cmp := 0; + + while true do + begin + if h.FHash < ha then cmp := -1 else + if h.FHash > ha then cmp := 1 else + cmp := 0; + + if cmp = 0 then + cmp := FTree.CompareKeyNode(k, h); + if (cmp = 0) then + begin + if (stEqual in st) then + begin + FDepth := d; + break; + end; + cmp := -target_cmp; + end + else + if (target_cmp <> 0) then + if ((cmp xor target_cmp) and SUPER_AVL_MASK_HIGH_BIT) = 0 then + FDepth := d; + if cmp < 0 then + h := h.FLt else + h := h.FGt; + if (h = nil) then + break; + if (cmp > 0) then + include(FBranch, d) else + exclude(FBranch, d); + FPath[d] := h; + inc(d); + end; +end; + +procedure TSuperAvlIterator.First; +var + h: TSuperAvlEntry; +begin + h := FTree.FRoot; + FDepth := not 0; + FBranch := []; + while (h <> nil) do + begin + if (FDepth <> not 0) then + FPath[FDepth] := h; + inc(FDepth); + h := h.FLt; + end; +end; + +procedure TSuperAvlIterator.Last; +var + h: TSuperAvlEntry; +begin + h := FTree.FRoot; + FDepth := not 0; + FBranch := [0..SUPER_AVL_MAX_DEPTH - 1]; + while (h <> nil) do + begin + if (FDepth <> not 0) then + FPath[FDepth] := h; + inc(FDepth); + h := h.FGt; + end; +end; + +function TSuperAvlIterator.MoveNext: boolean; +begin + if FDepth = not 0 then + First else + Next; + Result := GetIter <> nil; +end; + +function TSuperAvlIterator.GetIter: TSuperAvlEntry; +begin + if (FDepth = not 0) then + begin + result := nil; + exit; + end; + if FDepth = 0 then + Result := FTree.FRoot else + Result := FPath[FDepth - 1]; +end; + +procedure TSuperAvlIterator.Next; +var + h: TSuperAvlEntry; +begin + if (FDepth <> not 0) then + begin + if FDepth = 0 then + h := FTree.FRoot.FGt else + h := FPath[FDepth - 1].FGt; + + if (h = nil) then + repeat + if (FDepth = 0) then + begin + FDepth := not 0; + break; + end; + dec(FDepth); + until (not (FDepth in FBranch)) + else + begin + include(FBranch, FDepth); + FPath[FDepth] := h; + inc(FDepth); + while true do + begin + h := h.FLt; + if (h = nil) then + break; + exclude(FBranch, FDepth); + FPath[FDepth] := h; + inc(FDepth); + end; + end; + end; +end; + +procedure TSuperAvlIterator.Prior; +var + h: TSuperAvlEntry; +begin + if (FDepth <> not 0) then + begin + if FDepth = 0 then + h := FTree.FRoot.FLt else + h := FPath[FDepth - 1].FLt; + if (h = nil) then + repeat + if (FDepth = 0) then + begin + FDepth := not 0; + break; + end; + dec(FDepth); + until (FDepth in FBranch) + else + begin + exclude(FBranch, FDepth); + FPath[FDepth] := h; + inc(FDepth); + while true do + begin + h := h.FGt; + if (h = nil) then + break; + include(FBranch, FDepth); + FPath[FDepth] := h; + inc(FDepth); + end; + end; + end; +end; + +procedure TSuperAvlTree.doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); +begin + Entry.Free; +end; + +function TSuperAvlTree.GetEnumerator: TSuperAvlIterator; +begin + Result := TSuperAvlIterator.Create(Self); +end; + +{ TSuperAvlEntry } + +constructor TSuperAvlEntry.Create(const AName: SOString; Obj: Pointer); +begin + FName := AName; + FPtr := Obj; + FHash := Hash(FName); +end; + +function TSuperAvlEntry.GetValue: ISuperObject; +begin + Result := ISuperObject(FPtr) +end; + +class function TSuperAvlEntry.Hash(const k: SOString): Cardinal; +var + h: cardinal; + i: Integer; +begin + h := 0; + for i := 1 to Length(k) do + h := h*129 + ord(k[i]) + $9e370001; + Result := h; +end; + +procedure TSuperAvlEntry.SetValue(const val: ISuperObject); +begin + ISuperObject(FPtr) := val; +end; + +{ TSuperTableString } + +function TSuperTableString.GetValues: ISuperObject; +var + ite: TSuperAvlIterator; + obj: TSuperAvlEntry; +begin + Result := TSuperObject.Create(stArray); + ite := TSuperAvlIterator.Create(Self); + try + ite.First; + obj := ite.GetIter; + while obj <> nil do + begin + Result.AsArray.Add(obj.Value); + ite.Next; + obj := ite.GetIter; + end; + finally + ite.Free; + end; +end; + +function TSuperTableString.GetNames: ISuperObject; +var + ite: TSuperAvlIterator; + obj: TSuperAvlEntry; +begin + Result := TSuperObject.Create(stArray); + ite := TSuperAvlIterator.Create(Self); + try + ite.First; + obj := ite.GetIter; + while obj <> nil do + begin + Result.AsArray.Add(TSuperObject.Create(obj.FName)); + ite.Next; + obj := ite.GetIter; + end; + finally + ite.Free; + end; +end; + +procedure TSuperTableString.doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); +begin + if Entry.Ptr <> nil then + begin + if all then Entry.Value.Clear(true); + Entry.Value := nil; + end; + inherited; +end; + +function TSuperTableString.Find(const k: SOString; var value: ISuperObject): Boolean; +var + e: TSuperAvlEntry; +begin + e := Search(k); + if e <> nil then + begin + value := e.Value; + Result := True; + end else + Result := False; +end; + +function TSuperTableString.GetO(const k: SOString): ISuperObject; +var + e: TSuperAvlEntry; +begin + e := Search(k); + if e <> nil then + Result := e.Value else + Result := nil +end; + +procedure TSuperTableString.PutO(const k: SOString; const value: ISuperObject); +var + entry: TSuperAvlEntry; +begin + entry := Insert(TSuperAvlEntry.Create(k, Pointer(value))); + if entry.FPtr <> nil then + ISuperObject(entry.FPtr)._AddRef; +end; + +procedure TSuperTableString.PutS(const k: SOString; const value: SOString); +begin + PutO(k, TSuperObject.Create(Value)); +end; + +function TSuperTableString.GetS(const k: SOString): SOString; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj.AsString else + Result := ''; +end; + +procedure TSuperTableString.PutI(const k: SOString; value: SuperInt); +begin + PutO(k, TSuperObject.Create(Value)); +end; + +function TSuperTableString.GetI(const k: SOString): SuperInt; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj.AsInteger else + Result := 0; +end; + +procedure TSuperTableString.PutD(const k: SOString; value: Double); +begin + PutO(k, TSuperObject.Create(Value)); +end; + +procedure TSuperTableString.PutC(const k: SOString; value: Currency); +begin + PutO(k, TSuperObject.CreateCurrency(Value)); +end; + +function TSuperTableString.GetC(const k: SOString): Currency; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj.AsCurrency else + Result := 0.0; +end; + +function TSuperTableString.GetD(const k: SOString): Double; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj.AsDouble else + Result := 0.0; +end; + +procedure TSuperTableString.PutB(const k: SOString; value: Boolean); +begin + PutO(k, TSuperObject.Create(Value)); +end; + +function TSuperTableString.GetB(const k: SOString): Boolean; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj.AsBoolean else + Result := False; +end; + +{$IFDEF SUPER_METHOD} +procedure TSuperTableString.PutM(const k: SOString; value: TSuperMethod); +begin + PutO(k, TSuperObject.Create(Value)); +end; +{$ENDIF} + +{$IFDEF SUPER_METHOD} +function TSuperTableString.GetM(const k: SOString): TSuperMethod; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj.AsMethod else + Result := nil; +end; +{$ENDIF} + +procedure TSuperTableString.PutN(const k: SOString; const value: ISuperObject); +begin + if value <> nil then + PutO(k, TSuperObject.Create(stNull)) else + PutO(k, value); +end; + +function TSuperTableString.GetN(const k: SOString): ISuperObject; +var + obj: ISuperObject; +begin + obj := GetO(k); + if obj <> nil then + Result := obj else + Result := TSuperObject.Create(stNull); +end; + + +{$IFDEF HAVE_RTTI} + +{ TSuperAttribute } + +constructor TSuperAttribute.Create(const AName: string); +begin + FName := AName; +end; + +{ TSuperRttiContext } + +constructor TSuperRttiContext.Create; +begin + Context := TRttiContext.Create; + SerialFromJson := TDictionary.Create; + SerialToJson := TDictionary.Create; + + SerialFromJson.Add(TypeInfo(Boolean), serialfromboolean); + SerialFromJson.Add(TypeInfo(TDateTime), serialfromdatetime); + SerialFromJson.Add(TypeInfo(TGUID), serialfromguid); + SerialToJson.Add(TypeInfo(Boolean), serialtoboolean); + SerialToJson.Add(TypeInfo(TDateTime), serialtodatetime); + SerialToJson.Add(TypeInfo(TGUID), serialtoguid); +end; + +destructor TSuperRttiContext.Destroy; +begin + SerialFromJson.Free; + SerialToJson.Free; + Context.Free; +end; + +class function TSuperRttiContext.GetFieldName(r: TRttiField): string; +var + o: TCustomAttribute; +begin + for o in r.GetAttributes do + if o is SOName then + Exit(SOName(o).Name); + Result := r.Name; +end; + +class function TSuperRttiContext.GetFieldDefault(r: TRttiField; const obj: ISuperObject): ISuperObject; +var + o: TCustomAttribute; +begin + if not ObjectIsType(obj, stNull) then Exit(obj); + for o in r.GetAttributes do + if o is SODefault then + Exit(SO(SODefault(o).Name)); + Result := obj; +end; + +function TSuperRttiContext.AsType(const obj: ISuperObject): T; +var + ret: TValue; +begin + if FromJson(TypeInfo(T), obj, ret) then + Result := ret.AsType else + raise exception.Create('Marshalling error'); +end; + +function TSuperRttiContext.AsJson(const obj: T; const index: ISuperObject = nil): ISuperObject; +var + v: TValue; +begin + TValue.Make(@obj, TypeInfo(T), v); + if index <> nil then + Result := ToJson(v, index) else + Result := ToJson(v, so); +end; + +function TSuperRttiContext.FromJson(TypeInfo: PTypeInfo; const obj: ISuperObject; + var Value: TValue): Boolean; + + procedure FromChar; + begin + if ObjectIsType(obj, stString) and (Length(obj.AsString) = 1) then + begin + Value := string(AnsiString(obj.AsString)[1]); + Result := True; + end else + Result := False; + end; + + procedure FromWideChar; + begin + if ObjectIsType(obj, stString) and (Length(obj.AsString) = 1) then + begin + Value := obj.AsString[1]; + Result := True; + end else + Result := False; + end; + + procedure FromInt64; + var + i: Int64; + begin + case ObjectGetType(obj) of + stInt: + begin + TValue.Make(nil, TypeInfo, Value); + TValueData(Value).FAsSInt64 := obj.AsInteger; + Result := True; + end; + stString: + begin + if TryStrToInt64(obj.AsString, i) then + begin + TValue.Make(nil, TypeInfo, Value); + TValueData(Value).FAsSInt64 := i; + Result := True; + end else + Result := False; + end; + else + Result := False; + end; + end; + + procedure FromInt(const obj: ISuperObject); + var + TypeData: PTypeData; + i: Integer; + o: ISuperObject; + begin + case ObjectGetType(obj) of + stInt, stBoolean: + begin + i := obj.AsInteger; + TypeData := GetTypeData(TypeInfo); + if TypeData.MaxValue > TypeData.MinValue then + Result := (i >= TypeData.MinValue) and (i <= TypeData.MaxValue) else + Result := (i >= TypeData.MinValue) and (i <= Int64(PCardinal(@TypeData.MaxValue)^)); + if Result then + TValue.Make(@i, TypeInfo, Value); + end; + stString: + begin + o := SO(obj.AsString); + if not ObjectIsType(o, stString) then + FromInt(o) else + Result := False; + end; + else + Result := False; + end; + end; + + procedure fromSet; + var + i: Integer; + begin + case ObjectGetType(obj) of + stInt: + begin + TValue.Make(nil, TypeInfo, Value); + TValueData(Value).FAsSLong := obj.AsInteger; + Result := True; + end; + stString: + begin + if TryStrToInt(obj.AsString, i) then + begin + TValue.Make(nil, TypeInfo, Value); + TValueData(Value).FAsSLong := i; + Result := True; + end else + Result := False; + end; + else + Result := False; + end; + end; + + procedure FromFloat(const obj: ISuperObject); + var + o: ISuperObject; + begin + case ObjectGetType(obj) of + stInt, stDouble, stCurrency: + begin + TValue.Make(nil, TypeInfo, Value); + case GetTypeData(TypeInfo).FloatType of + ftSingle: TValueData(Value).FAsSingle := obj.AsDouble; + ftDouble: TValueData(Value).FAsDouble := obj.AsDouble; + ftExtended: TValueData(Value).FAsExtended := obj.AsDouble; + ftComp: TValueData(Value).FAsSInt64 := obj.AsInteger; + ftCurr: TValueData(Value).FAsCurr := obj.AsCurrency; + end; + Result := True; + end; + stString: + begin + o := SO(obj.AsString); + if not ObjectIsType(o, stString) then + FromFloat(o) else + Result := False; + end + else + Result := False; + end; + end; + + procedure FromString; + begin + case ObjectGetType(obj) of + stObject, stArray: + Result := False; + stnull: + begin + Value := ''; + Result := True; + end; + else + Value := obj.AsString; + Result := True; + end; + end; + + procedure FromClass; + var + f: TRttiField; + v: TValue; + begin + case ObjectGetType(obj) of + stObject: + begin + Result := True; + if Value.Kind <> tkClass then + Value := GetTypeData(TypeInfo).ClassType.Create; + for f in Context.GetType(Value.AsObject.ClassType).GetFields do + if f.FieldType <> nil then + begin + v := TValue.Empty; + Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v); + if Result then + f.SetValue(Value.AsObject, v) else + Exit; + end; + end; + stNull: + begin + Value := nil; + Result := True; + end + else + // error + Value := nil; + Result := False; + end; + end; + + procedure FromRecord; + var + f: TRttiField; + p: Pointer; + v: TValue; + begin + Result := True; + TValue.Make(nil, TypeInfo, Value); + for f in Context.GetType(TypeInfo).GetFields do + begin + if ObjectIsType(obj, stObject) and (f.FieldType <> nil) then + begin +{$IFDEF VER210} + p := IValueData(TValueData(Value).FHeapData).GetReferenceToRawData; +{$ELSE} + p := TValueData(Value).FValueData.GetReferenceToRawData; +{$ENDIF} + Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v); + if Result then + f.SetValue(p, v) else + begin + Writeln(f.Name); + Exit; + end; + end else + begin + Result := False; + Exit; + end; + end; + end; + + procedure FromDynArray; + var + i: Integer; + p: Pointer; + pb: PByte; + val: TValue; + typ: PTypeData; + el: PTypeInfo; + begin + case ObjectGetType(obj) of + stArray: + begin + i := obj.AsArray.Length; + p := nil; + DynArraySetLength(p, TypeInfo, 1, @i); + pb := p; + typ := GetTypeData(TypeInfo); + if typ.elType <> nil then + el := typ.elType^ else + el := typ.elType2^; + + Result := True; + for i := 0 to i - 1 do + begin + Result := FromJson(el, obj.AsArray[i], val); + if not Result then + Break; + val.ExtractRawData(pb); + val := TValue.Empty; + Inc(pb, typ.elSize); + end; + if Result then + TValue.MakeWithoutCopy(@p, TypeInfo, Value) else + DynArrayClear(p, TypeInfo); + end; + stNull: + begin + TValue.MakeWithoutCopy(nil, TypeInfo, Value); + Result := True; + end; + else + i := 1; + p := nil; + DynArraySetLength(p, TypeInfo, 1, @i); + pb := p; + typ := GetTypeData(TypeInfo); + if typ.elType <> nil then + el := typ.elType^ else + el := typ.elType2^; + + Result := FromJson(el, obj, val); + val.ExtractRawData(pb); + val := TValue.Empty; + + if Result then + TValue.MakeWithoutCopy(@p, TypeInfo, Value) else + DynArrayClear(p, TypeInfo); + end; + end; + + procedure FromArray; + var + ArrayData: PArrayTypeData; + idx: Integer; + function ProcessDim(dim: Byte; const o: ISuperobject): Boolean; + var + i: Integer; + v: TValue; + a: PTypeData; + begin + if ObjectIsType(o, stArray) and (ArrayData.Dims[dim-1] <> nil) then + begin + a := @GetTypeData(ArrayData.Dims[dim-1]^).ArrayData; + if (a.MaxValue - a.MinValue + 1) <> o.AsArray.Length then + begin + Result := False; + Exit; + end; + Result := True; + if dim = ArrayData.DimCount then + for i := a.MinValue to a.MaxValue do + begin + Result := FromJson(ArrayData.ElType^, o.AsArray[i], v); + if not Result then + Exit; + Value.SetArrayElement(idx, v); + inc(idx); + end + else + for i := a.MinValue to a.MaxValue do + begin + Result := ProcessDim(dim + 1, o.AsArray[i]); + if not Result then + Exit; + end; + end else + Result := False; + end; + var + i: Integer; + v: TValue; + begin + TValue.Make(nil, TypeInfo, Value); + ArrayData := @GetTypeData(TypeInfo).ArrayData; + idx := 0; + if ArrayData.DimCount = 1 then + begin + if ObjectIsType(obj, stArray) and (obj.AsArray.Length = ArrayData.ElCount) then + begin + Result := True; + for i := 0 to ArrayData.ElCount - 1 do + begin + Result := FromJson(ArrayData.ElType^, obj.AsArray[i], v); + if not Result then + Exit; + Value.SetArrayElement(idx, v); + v := TValue.Empty; + inc(idx); + end; + end else + Result := False; + end else + Result := ProcessDim(1, obj); + end; + + procedure FromClassRef; + var + r: TRttiType; + begin + if ObjectIsType(obj, stString) then + begin + r := Context.FindType(obj.AsString); + if r <> nil then + begin + Value := TRttiInstanceType(r).MetaclassType; + Result := True; + end else + Result := False; + end else + Result := False; + end; + + procedure FromUnknown; + begin + case ObjectGetType(obj) of + stBoolean: + begin + Value := obj.AsBoolean; + Result := True; + end; + stDouble: + begin + Value := obj.AsDouble; + Result := True; + end; + stCurrency: + begin + Value := obj.AsCurrency; + Result := True; + end; + stInt: + begin + Value := obj.AsInteger; + Result := True; + end; + stString: + begin + Value := obj.AsString; + Result := True; + end + else + Value := nil; + Result := False; + end; + end; + + procedure FromInterface; + const soguid: TGuid = '{4B86A9E3-E094-4E5A-954A-69048B7B6327}'; + var + o: ISuperObject; + begin + if CompareMem(@GetTypeData(TypeInfo).Guid, @soguid, SizeOf(TGUID)) then + begin + if obj <> nil then + TValue.Make(@obj, TypeInfo, Value) else + begin + o := TSuperObject.Create(stNull); + TValue.Make(@o, TypeInfo, Value); + end; + Result := True; + end else + Result := False; + end; +var + Serial: TSerialFromJson; +begin + if TypeInfo <> nil then + begin + if not SerialFromJson.TryGetValue(TypeInfo, Serial) then + case TypeInfo.Kind of + tkChar: FromChar; + tkInt64: FromInt64; + tkEnumeration, tkInteger: FromInt(obj); + tkSet: fromSet; + tkFloat: FromFloat(obj); + tkString, tkLString, tkUString, tkWString: FromString; + tkClass: FromClass; + tkMethod: ; + tkWChar: FromWideChar; + tkRecord: FromRecord; + tkPointer: ; + tkInterface: FromInterface; + tkArray: FromArray; + tkDynArray: FromDynArray; + tkClassRef: FromClassRef; + else + FromUnknown + end else + begin + TValue.Make(nil, TypeInfo, Value); + Result := Serial(Self, obj, Value); + end; + end else + Result := False; +end; + +function TSuperRttiContext.ToJson(var value: TValue; const index: ISuperObject): ISuperObject; + procedure ToInt64; + begin + Result := TSuperObject.Create(SuperInt(Value.AsInt64)); + end; + + procedure ToChar; + begin + Result := TSuperObject.Create(string(Value.AsType)); + end; + + procedure ToInteger; + begin + Result := TSuperObject.Create(TValueData(Value).FAsSLong); + end; + + procedure ToFloat; + begin + case Value.TypeData.FloatType of + ftSingle: Result := TSuperObject.Create(TValueData(Value).FAsSingle); + ftDouble: Result := TSuperObject.Create(TValueData(Value).FAsDouble); + ftExtended: Result := TSuperObject.Create(TValueData(Value).FAsExtended); + ftComp: Result := TSuperObject.Create(TValueData(Value).FAsSInt64); + ftCurr: Result := TSuperObject.CreateCurrency(TValueData(Value).FAsCurr); + end; + end; + + procedure ToString; + begin + Result := TSuperObject.Create(string(Value.AsType)); + end; + + procedure ToClass; + var + o: ISuperObject; + f: TRttiField; + v: TValue; + begin + if TValueData(Value).FAsObject <> nil then + begin + o := index[IntToStr(Integer(Value.AsObject))]; + if o = nil then + begin + Result := TSuperObject.Create(stObject); + index[IntToStr(Integer(Value.AsObject))] := Result; + for f in Context.GetType(Value.AsObject.ClassType).GetFields do + if f.FieldType <> nil then + begin + v := f.GetValue(Value.AsObject); + Result.AsObject[GetFieldName(f)] := ToJson(v, index); + end + end else + Result := o; + end else + Result := nil; + end; + + procedure ToWChar; + begin + Result := TSuperObject.Create(string(Value.AsType)); + end; + + procedure ToVariant; + begin + Result := SO(Value.AsVariant); + end; + + procedure ToRecord; + var + f: TRttiField; + v: TValue; + begin + Result := TSuperObject.Create(stObject); + for f in Context.GetType(Value.TypeInfo).GetFields do + begin +{$IFDEF VER210} + v := f.GetValue(IValueData(TValueData(Value).FHeapData).GetReferenceToRawData); +{$ELSE} + v := f.GetValue(TValueData(Value).FValueData.GetReferenceToRawData); +{$ENDIF} + Result.AsObject[GetFieldName(f)] := ToJson(v, index); + end; + end; + + procedure ToArray; + var + idx: Integer; + ArrayData: PArrayTypeData; + + procedure ProcessDim(dim: Byte; const o: ISuperObject); + var + dt: PTypeData; + i: Integer; + o2: ISuperObject; + v: TValue; + begin + if ArrayData.Dims[dim-1] = nil then Exit; + dt := GetTypeData(ArrayData.Dims[dim-1]^); + if Dim = ArrayData.DimCount then + for i := dt.MinValue to dt.MaxValue do + begin + v := Value.GetArrayElement(idx); + o.AsArray.Add(toJSon(v, index)); + inc(idx); + end + else + for i := dt.MinValue to dt.MaxValue do + begin + o2 := TSuperObject.Create(stArray); + o.AsArray.Add(o2); + ProcessDim(dim + 1, o2); + end; + end; + var + i: Integer; + v: TValue; + begin + Result := TSuperObject.Create(stArray); + ArrayData := @Value.TypeData.ArrayData; + idx := 0; + if ArrayData.DimCount = 1 then + for i := 0 to ArrayData.ElCount - 1 do + begin + v := Value.GetArrayElement(i); + Result.AsArray.Add(toJSon(v, index)) + end + else + ProcessDim(1, Result); + end; + + procedure ToDynArray; + var + i: Integer; + v: TValue; + begin + Result := TSuperObject.Create(stArray); + for i := 0 to Value.GetArrayLength - 1 do + begin + v := Value.GetArrayElement(i); + Result.AsArray.Add(toJSon(v, index)); + end; + end; + + procedure ToClassRef; + begin + if TValueData(Value).FAsClass <> nil then + Result := TSuperObject.Create(string( + TValueData(Value).FAsClass.UnitName + '.' + + TValueData(Value).FAsClass.ClassName)) else + Result := nil; + end; + + procedure ToInterface; +{$IFNDEF VER210} + var + intf: IInterface; +{$ENDIF} + begin +{$IFDEF VER210} + if TValueData(Value).FHeapData <> nil then + TValueData(Value).FHeapData.QueryInterface(ISuperObject, Result) else + Result := nil; +{$ELSE} + if TValueData(Value).FValueData <> nil then + begin + intf := IInterface(PPointer(TValueData(Value).FValueData.GetReferenceToRawData)^); + if intf <> nil then + intf.QueryInterface(ISuperObject, Result) else + Result := nil; + end else + Result := nil; +{$ENDIF} + end; + +var + Serial: TSerialToJson; +begin + if not SerialToJson.TryGetValue(value.TypeInfo, Serial) then + case Value.Kind of + tkInt64: ToInt64; + tkChar: ToChar; + tkSet, tkInteger, tkEnumeration: ToInteger; + tkFloat: ToFloat; + tkString, tkLString, tkUString, tkWString: ToString; + tkClass: ToClass; + tkWChar: ToWChar; + tkVariant: ToVariant; + tkRecord: ToRecord; + tkArray: ToArray; + tkDynArray: ToDynArray; + tkClassRef: ToClassRef; + tkInterface: ToInterface; + else + result := nil; + end else + Result := Serial(Self, value, index); +end; + +{ TSuperObjectHelper } + +constructor TSuperObjectHelper.FromJson(const obj: ISuperObject; ctx: TSuperRttiContext = nil); +var + v: TValue; + ctxowned: Boolean; +begin + if ctx = nil then + begin + ctx := TSuperRttiContext.Create; + ctxowned := True; + end else + ctxowned := False; + try + v := Self; + if not ctx.FromJson(v.TypeInfo, obj, v) then + raise Exception.Create('Invalid object'); + finally + if ctxowned then + ctx.Free; + end; +end; + +constructor TSuperObjectHelper.FromJson(const str: string; ctx: TSuperRttiContext = nil); +begin + FromJson(SO(str), ctx); +end; + +function TSuperObjectHelper.ToJson(ctx: TSuperRttiContext = nil): ISuperObject; +var + v: TValue; + ctxowned: boolean; +begin + if ctx = nil then + begin + ctx := TSuperRttiContext.Create; + ctxowned := True; + end else + ctxowned := False; + try + v := Self; + Result := ctx.ToJson(v, SO); + finally + if ctxowned then + ctx.Free; + end; +end; + +{$ENDIF} + +{$IFDEF DEBUG} +initialization + +finalization + Assert(debugcount = 0, 'Memory leak'); +{$ENDIF} +end. + diff --git a/云翔一码通/util_utf8.pas b/云翔一码通/util_utf8.pas new file mode 100644 index 0000000..f01d6b1 --- /dev/null +++ b/云翔一码通/util_utf8.pas @@ -0,0 +1,85 @@ +unit util_utf8; + +interface + +uses Windows; + +type + UTF8String = AnsiString; + + function AnsiToWide(const S: AnsiString): WideString; + function WideToUTF8(const WS: WideString): UTF8String; + function AnsiToUTF8(const S: AnsiString): UTF8String; + function UTF8ToWide(const US: UTF8String): WideString; + function WideToAnsi(const WS: WideString): AnsiString; + function UTF8ToAnsi(const S: UTF8String): AnsiString; + +implementation + +function AnsiToWide(const S: AnsiString): WideString; +var + len: integer; + ws: WideString; +begin + Result:=''; + if (Length(S) = 0) then + exit; + len:=MultiByteToWideChar(CP_ACP, 0, PChar(s), -1, nil, 0); + SetLength(ws, len); + MultiByteToWideChar(CP_ACP, 0, PChar(s), -1, PWideChar(ws), len); + Result:=ws; +end; + +function WideToUTF8(const WS: WideString): UTF8String; +var + len: integer; + us: UTF8String; +begin + Result:=''; + if (Length(WS) = 0) then + exit; + len:=WideCharToMultiByte(CP_UTF8, 0, PWideChar(WS), -1, nil, 0, nil, nil); + SetLength(us, len); + WideCharToMultiByte(CP_UTF8, 0, PWideChar(WS), -1, PChar(us), len, nil, nil); + Result:=us; +end; + +function AnsiToUTF8(const S: AnsiString): UTF8String; +begin + Result:=WideToUTF8(AnsiToWide(S)); +end; + +function UTF8ToWide(const US: UTF8String): WideString; +var + len: integer; + ws: WideString; +begin + Result:=''; + if (Length(US) = 0) then + exit; + len:=MultiByteToWideChar(CP_UTF8, 0, PChar(US), -1, nil, 0); + SetLength(ws, len); + MultiByteToWideChar(CP_UTF8, 0, PChar(US), -1, PWideChar(ws), len); + Result:=ws; +end; + +function WideToAnsi(const WS: WideString): AnsiString; +var + len: integer; + s: AnsiString; +begin + Result:=''; + if (Length(WS) = 0) then + exit; + len:=WideCharToMultiByte(CP_ACP, 0, PWideChar(WS), -1, nil, 0, nil, nil); + SetLength(s, len); + WideCharToMultiByte(CP_ACP, 0, PWideChar(WS), -1, PChar(s), len, nil, nil); + Result:=s; +end; + +function UTF8ToAnsi(const S: UTF8String): AnsiString; +begin + Result:=WideToAnsi(UTF8ToWide(S)); +end; + +end. diff --git a/云翔生产管理(MYSC.dll)/U_KuWeiList.dfm b/云翔生产管理(MYSC.dll)/U_KuWeiList.dfm index 3289f5e..bc7c80e 100644 --- a/云翔生产管理(MYSC.dll)/U_KuWeiList.dfm +++ b/云翔生产管理(MYSC.dll)/U_KuWeiList.dfm @@ -7,7 +7,7 @@ object frmKuWeiList: TfrmKuWeiList Color = clBtnFace Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -13 + Font.Height = -12 Font.Name = #23435#20307 Font.Style = [] OldCreateOrder = False @@ -15,12 +15,12 @@ object frmKuWeiList: TfrmKuWeiList OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow - PixelsPerInch = 107 - TextHeight = 13 + PixelsPerInch = 96 + TextHeight = 12 object ToolBar1: TToolBar Left = 0 Top = 0 - Width = 1199 + Width = 1207 AutoSize = True ButtonHeight = 30 ButtonWidth = 65 @@ -139,14 +139,14 @@ object frmKuWeiList: TfrmKuWeiList end object cxGrid1: TcxGrid Left = 0 - Top = 84 - Width = 1199 - Height = 513 + Top = 80 + Width = 1207 + Height = 526 Align = alClient PopupMenu = PopupMenu1 TabOrder = 1 object Tv1: TcxGridDBTableView - NavigatorButtons.ConfirmDelete = False + Navigator.Buttons.CustomButtons = <> OnCellDblClick = Tv1CellDblClick DataController.DataSource = DataSource1 DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost] @@ -185,11 +185,12 @@ object frmKuWeiList: TfrmKuWeiList Styles.Footer = DataLink_MYSC.Default10 Styles.Header = DataLink_MYSC.Default10 object v1Column4: TcxGridDBColumn - Caption = #25171#21360#36873#25321 + Caption = #36873#25321 DataBinding.FieldName = 'SSel' PropertiesClassName = 'TcxCheckBoxProperties' Properties.ImmediatePost = True Properties.NullStyle = nssUnchecked + HeaderAlignmentHorz = taCenter Width = 74 end object v1Column1: TcxGridDBColumn @@ -235,87 +236,87 @@ object frmKuWeiList: TfrmKuWeiList object Panel1: TPanel Left = 0 Top = 32 - Width = 1199 - Height = 52 + Width = 1207 + Height = 48 Align = alTop BevelInner = bvRaised BevelOuter = bvLowered Color = clSkyBlue TabOrder = 2 object Label2: TLabel - Left = 21 - Top = 17 - Width = 34 - Height = 16 + Left = 19 + Top = 16 + Width = 32 + Height = 15 Caption = #21306#22495 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label1: TLabel - Left = 142 - Top = 17 - Width = 34 - Height = 16 + Left = 131 + Top = 16 + Width = 32 + Height = 15 Caption = #20998#21306 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label5: TLabel - Left = 263 - Top = 17 - Width = 17 - Height = 16 + Left = 243 + Top = 16 + Width = 16 + Height = 15 Caption = #25490 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label6: TLabel - Left = 468 - Top = 17 - Width = 68 - Height = 16 + Left = 432 + Top = 16 + Width = 64 + Height = 15 Caption = #24211#20301#21517#31216 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object Label7: TLabel - Left = 367 - Top = 17 - Width = 17 - Height = 16 + Left = 339 + Top = 16 + Width = 16 + Height = 15 Caption = #23618 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False end object QuYu: TEdit Tag = 2 - Left = 57 - Top = 13 - Width = 65 + Left = 53 + Top = 12 + Width = 60 Height = 24 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False @@ -324,13 +325,13 @@ object frmKuWeiList: TfrmKuWeiList end object FenQu: TEdit Tag = 2 - Left = 179 - Top = 13 - Width = 65 + Left = 165 + Top = 12 + Width = 60 Height = 24 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False @@ -339,13 +340,13 @@ object frmKuWeiList: TfrmKuWeiList end object Pai: TEdit Tag = 2 - Left = 283 - Top = 13 - Width = 65 + Left = 261 + Top = 12 + Width = 60 Height = 24 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False @@ -354,13 +355,13 @@ object frmKuWeiList: TfrmKuWeiList end object KWName: TEdit Tag = 2 - Left = 538 - Top = 13 - Width = 165 + Left = 497 + Top = 12 + Width = 152 Height = 24 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False @@ -369,13 +370,13 @@ object frmKuWeiList: TfrmKuWeiList end object Ceng: TEdit Tag = 2 - Left = 387 - Top = 13 - Width = 65 + Left = 357 + Top = 12 + Width = 60 Height = 24 Font.Charset = GB2312_CHARSET Font.Color = clWindowText - Font.Height = -16 + Font.Height = -15 Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False diff --git a/云翔生产管理(MYSC.dll)/U_KuWeiList.pas b/云翔生产管理(MYSC.dll)/U_KuWeiList.pas index af2383d..82db966 100644 --- a/云翔生产管理(MYSC.dll)/U_KuWeiList.pas +++ b/云翔生产管理(MYSC.dll)/U_KuWeiList.pas @@ -6,11 +6,24 @@ uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB, - cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses, - cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView, - cxGridDBTableView, cxGrid, DBClient, cxCheckBox, cxCalendar, cxSplitter, - RM_Dataset, RM_System, RM_Common, RM_Class, RM_GridReport, RM_e_Xls, - Menus, cxButtonEdit, cxDropDownEdit, cxPC, Buttons; + cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses, cxControls, + cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, + cxGrid, DBClient, cxCheckBox, cxCalendar, cxSplitter, RM_Dataset, RM_System, + RM_Common, RM_Class, RM_GridReport, RM_e_Xls, Menus, cxButtonEdit, + cxDropDownEdit, cxPC, Buttons, cxLookAndFeels, cxLookAndFeelPainters, + dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, + dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle, + dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, + dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, + dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins, + dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green, + dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black, + dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, + dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, + dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, + dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld, + dxSkinsDefaultPainters, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, + dxSkinXmas2008Blue, dxSkinscxPCPainter, cxNavigator; type TfrmKuWeiList = class(TForm) @@ -76,19 +89,17 @@ type procedure cxTabControl1Change(Sender: TObject); procedure ZJStatusChange(Sender: TObject); procedure ToolButton4Click(Sender: TObject); - procedure Tv1CellDblClick(Sender: TcxCustomGridTableView; - ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; - AShift: TShiftState; var AHandled: Boolean); + procedure Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); private - canshu1:string; - DQdate:TDateTime; + canshu1: string; + DQdate: TDateTime; procedure InitGrid(); procedure InitForm(); - function DelData():Boolean; - procedure PrtData(KWID:String); + function DelData(): Boolean; + procedure PrtData(KWID: string); { Private declarations } public - FFInt,FCloth:Integer; + FFInt, FCloth: Integer; { Public declarations } end; @@ -97,31 +108,31 @@ var frmKuWeiList: TfrmKuWeiList; implementation + uses - U_DataLink,U_RTFun,U_ZDYHelp,U_KuWeiInPutCeng; + U_DataLink, U_RTFun, U_ZDYHelp, U_KuWeiInPutCeng; {$R *.dfm} procedure TfrmKuWeiList.FormDestroy(Sender: TObject); begin - frmKuWeiList:=nil; + frmKuWeiList := nil; end; -procedure TfrmKuWeiList.FormClose(Sender: TObject; - var Action: TCloseAction); +procedure TfrmKuWeiList.FormClose(Sender: TObject; var Action: TCloseAction); begin - Action:=caFree; + Action := caFree; end; procedure TfrmKuWeiList.FormCreate(Sender: TObject); begin - cxgrid1.Align:=alClient; - canshu1:=Trim(DParameters1); + cxgrid1.Align := alClient; + canshu1 := Trim(DParameters1); end; procedure TfrmKuWeiList.TBCloseClick(Sender: TObject); begin - WriteCxGrid('λб',Tv1,'λ'); + WriteCxGrid('λб', Tv1, 'λ'); Close; end; @@ -131,62 +142,71 @@ begin ADOQueryMain.DisableControls; with ADOQueryMain do begin - Filtered:=False; + Filtered := False; Close; sql.Clear; sql.Add(' select A.* '); sql.Add(' from KuWei A where KWType=''GG'' and Valid=''Y'' '); Open; end; - SCreateCDS20(ADOQueryMain,Order_Main); - SInitCDSData20(ADOQueryMain,Order_Main); + SCreateCDS20(ADOQueryMain, Order_Main); + SInitCDSData20(ADOQueryMain, Order_Main); finally ADOQueryMain.EnableControls; end; end; - procedure TfrmKuWeiList.InitForm(); begin - ReadCxGrid('λб',Tv1,'λ'); + ReadCxGrid('λб', Tv1, 'λ'); InitGrid(); end; procedure TfrmKuWeiList.TBFindClick(Sender: TObject); begin - if ADOQueryMain.Active=False then Exit; - SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2)); - SCreateCDS20(ADOQueryMain,Order_Main); - SInitCDSData20(ADOQueryMain,Order_Main); + if ADOQueryMain.Active = False then + Exit; + SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2)); + SCreateCDS20(ADOQueryMain, Order_Main); + SInitCDSData20(ADOQueryMain, Order_Main); end; procedure TfrmKuWeiList.TBDelClick(Sender: TObject); begin - if Order_Main.IsEmpty then Exit; - if Application.MessageBox('ȷҪɾ','ʾ',32+4)<>IDYES then Exit; + if Order_Main.IsEmpty then + Exit; + if Order_Main.Locate('SSel', True, []) = False then + begin + application.MessageBox('ѡݣ', 'ʾϢ'); + exit; + end; + if Application.MessageBox('ȷҪɾ', 'ʾ', 32 + 4) <> IDYES then + Exit; + + if DelData() then begin //Order_Main.Delete; end; end; -function TfrmKuWeiList.DelData():Boolean; +function TfrmKuWeiList.DelData(): Boolean; begin try - Result:=false; + Result := false; ADOQueryCmd.Connection.BeginTrans; Order_Main.DisableControls; with Order_Main do begin - //First; - // while Order_Main.Locate('SSel',True,[]) do + First; + while Order_Main.Locate('SSel',True,[]) do begin with ADOQueryCmd do begin Close; sql.Clear; - sql.Add(' UPdate KuWei Set Valid=''N'', DelTime=getdate(),DelerCode='''+Trim(DCode)+''',Deler='''+Trim(DName)+''''); - sql.Add(' where KWID='''+Trim(Order_Main.fieldbyname('KWID').AsString)+''''); + sql.Add(' UPdate KuWei Set Valid=''N'', DelTime=getdate(),DelerCode=''' + Trim(DCode) + ''',Deler=''' + Trim(DName) + ''''); + sql.Add(' where KWID=''' + Trim(Order_Main.fieldbyname('KWID').AsString) + ''''); ExecSQL; end; Order_Main.Delete; @@ -194,20 +214,20 @@ begin end; Order_Main.EnableControls; - ADOQueryCmd.Connection.CommitTrans; - Result:=True; + Result := True; except ADOQueryCmd.Connection.RollbackTrans; - Result:=False; - Application.MessageBox('ɾ쳣','ʾ',0); + Result := False; + Application.MessageBox('ɾ쳣', 'ʾ', 0); end; end; procedure TfrmKuWeiList.TBExportClick(Sender: TObject); begin - if ADOQueryMain.IsEmpty then Exit; - TcxGridToExcel(Self.Caption,cxGrid1); + if ADOQueryMain.IsEmpty then + Exit; + TcxGridToExcel(Self.Caption, cxGrid1); end; procedure TfrmKuWeiList.TBRafreshClick(Sender: TObject); @@ -218,10 +238,10 @@ end; procedure TfrmKuWeiList.TBAddClick(Sender: TObject); begin try - frmKuWeiInPutCeng:=TfrmKuWeiInPutCeng.Create(Application); + frmKuWeiInPutCeng := TfrmKuWeiInPutCeng.Create(Application); with frmKuWeiInPutCeng do begin - if ShowModal=1 then + if ShowModal = 1 then begin InitGrid(); end; @@ -248,20 +268,21 @@ end; procedure TfrmKuWeiList.CustomerNoNameChange(Sender: TObject); begin - if ADOQueryMain.Active=False then Exit; - SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2)); - SCreateCDS20(ADOQueryMain,Order_Main); - SInitCDSData20(ADOQueryMain,Order_Main); + if ADOQueryMain.Active = False then + Exit; + SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2)); + SCreateCDS20(ADOQueryMain, Order_Main); + SInitCDSData20(ADOQueryMain, Order_Main); end; procedure TfrmKuWeiList.N2Click(Sender: TObject); begin - SelOKNo(Order_Main,false); + SelOKNo(Order_Main, false); end; procedure TfrmKuWeiList.N1Click(Sender: TObject); begin - SelOKNo(Order_Main,True); + SelOKNo(Order_Main, True); end; procedure TfrmKuWeiList.cxTabControl1Change(Sender: TObject); @@ -276,86 +297,88 @@ end; procedure TfrmKuWeiList.ToolButton4Click(Sender: TObject); begin - if Order_Main.IsEmpty then Exit; - if Trim(ComboBox1.Text)='' then + if Order_Main.IsEmpty then + Exit; + if Trim(ComboBox1.Text) = '' then begin - Application.MessageBox('Ϊգ','ʾ',0); + Application.MessageBox('Ϊգ', 'ʾ', 0); Exit; end; - if Order_Main.Locate('SSel',True,[])=False then + if Order_Main.Locate('SSel', True, []) = False then begin - Application.MessageBox('ûѡ!','ʾ',0); + Application.MessageBox('ûѡ!', 'ʾ', 0); Exit; end; Order_Main.DisableControls; with Order_Main do begin First; - while Locate('SSel',True,[]) do + while Locate('SSel', True, []) do begin PrtData(Trim(Order_Main.fieldbyname('KWID').AsString)); Edit; - FieldByName('SSel').Value:=False; + FieldByName('SSel').Value := False; end; end; Order_Main.EnableControls; end; -procedure TfrmKuWeiList.PrtData(KWID:String); + +procedure TfrmKuWeiList.PrtData(KWID: string); var - fPrintFile,Txt,fImagePath:string; - i,j:Integer; - Moudle: THandle; - Makebar:TMakebar; - Mixtext:TMixtext; + fPrintFile, Txt, fImagePath: string; + i, j: Integer; + Moudle: THandle; + Makebar: TMakebar; + Mixtext: TMixtext; begin - fPrintFile:= ExtractFilePath(Application.ExeName) + 'Report\λǩ.rmf'; - if FileExists(fPrintFile)=False then + fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\λǩ.rmf'; + if FileExists(fPrintFile) = False then begin - Application.MessageBox(PChar('û'+ExtractFilePath(Application.ExeName)+'Report\λǩ.rmf'),'ʾ',0); + Application.MessageBox(PChar('û' + ExtractFilePath(Application.ExeName) + 'Report\λǩ.rmf'), 'ʾ', 0); exit; end; with ADOQueryTemp do begin Close; SQL.Clear; - sql.Add('select * from KuWei where KWID='''+Trim(KWID)+''''); + sql.Add('select * from KuWei where KWID=''' + Trim(KWID) + ''''); Open; end; - SCreateCDS20(ADOQueryTemp,CDS_PRT); - SInitCDSData20(ADOQueryTemp,CDS_PRT); + SCreateCDS20(ADOQueryTemp, CDS_PRT); + SInitCDSData20(ADOQueryTemp, CDS_PRT); try - Moudle:=LoadLibrary('MakeQRBarcode.dll'); - @Makebar:=GetProcAddress(Moudle,'Make'); - @Mixtext:=GetProcAddress(Moudle,'MixText'); - Txt:=Trim(KWID); - fImagePath:=ExtractFilePath(Application.ExeName)+'image\temp.bmp'; - if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName)+'image')) then - CreateDirectory(pchar(ExtractFilePath(Application.ExeName)+'image'),nil); - if FileExists(fImagePath) then DeleteFile(fImagePath); - Makebar(pchar(Txt),Length(Txt),3,3,0,PChar(fImagePath),3); + Moudle := LoadLibrary('MakeQRBarcode.dll'); + @Makebar := GetProcAddress(Moudle, 'Make'); + @Mixtext := GetProcAddress(Moudle, 'MixText'); + Txt := Trim(KWID); + fImagePath := ExtractFilePath(Application.ExeName) + 'image\temp.bmp'; + if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then + CreateDirectory(pchar(ExtractFilePath(Application.ExeName) + 'image'), nil); + if FileExists(fImagePath) then + DeleteFile(fImagePath); + Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3); except - application.MessageBox('άʧܣ','ʾϢ',MB_ICONERROR); + application.MessageBox('άʧܣ', 'ʾϢ', MB_ICONERROR); exit; end; - RMVariables['QRBARCODE']:=fImagePath; - if Trim(ComboBox1.Text)='' then + RMVariables['QRBARCODE'] := fImagePath; + if Trim(ComboBox1.Text) = '' then begin - RMVariables['FangXiang']:=''; - end else - if Trim(ComboBox1.Text)='' then + RMVariables['FangXiang'] := ''; + end + else if Trim(ComboBox1.Text) = '' then begin - RMVariables['FangXiang']:=''; + RMVariables['FangXiang'] := ''; end; RM1.LoadFromFile(fPrintFile); //RM1.ShowReport; RM1.PrintReport; end; -procedure TfrmKuWeiList.Tv1CellDblClick(Sender: TcxCustomGridTableView; - ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; - AShift: TShiftState; var AHandled: Boolean); +procedure TfrmKuWeiList.Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); begin - ModalResult:=1; + ModalResult := 1; end; end. +