函数

unit SunLib; interface uses Windows,SysUtils,forms,comctrls,classes,dbtables,shDBGrids,graphics,DB,shline; type TTextStyle=(tsRaised,tsLowered); procedure WriteStringToFile(pathfilename,strings:string); function FindFileString(pathfilename,strings:string):boolean; procedure DeleteFileString(pathfilename,strings:string); function strLeft(ss:string;count:integer):string; {从字符串左边返回字符串} function strRight(ss:string;count:integer):string; {从字符串右边返回字符串} function Space(count:integer):string; {返回空格字符串} function Replicate(char: string;count:integer):string; {返回重复字符串} function shsjh:string; {返回随机数} function GetRandom:string; {返回随机数} function GetRandomA:string; {返回随机数} function MonthMaxDay(year,month:integer):integer; function DeleteAllFile(filename:string):integer; {删除所有指定匹配的文件} function iif(const cstj:boolean;const cs1,cs2:variant):variant; function GetLeftString(strings,char:string):string;//返回char以左的字串 function NumberToCN(num0:currency):string; //人民币金额大写 function MessageWaitBox(aviname,mess:string):TForm; function Calendarbook(var datetime:TDatetime;YearEnabled,MonthEnabled,DayEnabled:boolean;x,y:integer):boolean; //日历 function InputStringBox(title,mess:string;var value:string):boolean; //输入框 function InputStringBoxA(title,mess,editmask:string;var value:string):boolean; procedure shBoxmessage(ss:string;left0,top0:integer); procedure shBoxmessagePos(ss:string;left0,top0,width0,height0:integer); procedure GetFieldLabel(xtdh:string;table1,tableDict:TTable); procedure CreateGrid(dbgrid1:TshDBGrid;LineColor:TColor); function GetPing(ss:string):string; procedure Draw3dText(canvas:TCanvas;rect:TRect;text:string;Text3DStyle:TTextStyle;Alignment: TAlignment); function ServerDateTime:TDatetime; function GetSerial(no:string):string; function GetSerialE(no:string;year,month:word):string; procedure WriteParamString(section,symbol,value:string); procedure WriteParamInteger(section,symbol:string;value:integer); procedure WriteParamBoolean(section,symbol:string;value:boolean); procedure WriteParamFloat(section,symbol:string;value:real); function ReadParamString(section,symbol,value:string):string; function ReadParamInteger(section,symbol:string;value:integer):integer; function ReadParamBoolean(section,symbol:string;value:boolean):boolean; function ReadParamFloat(section,symbol:string;value:real):real; implementation uses Sunlib_wait,SunLib_Calendar,Shinputbox,shmessagebox,shconsts; // mtdb, function strLeft(ss:string;count:integer):string; begin result:=copy(ss,1,count); end; function strRight(ss:string;count:integer):string; begin if length(ss)<=count then result:=ss else result:=copy(ss,length(ss)-count+1,count); end; function Space(count:integer):string; begin if count<=200 then //12345678901234567890123456789012345678901234567890 result:=copy(' '+ ' '+ ' '+ ' ' ,1,count) else result:=space(200)+space(count-200); end; function Replicate(char:string;count:integer):string; var moCount:integer; moRetstring:string; begin moRetstring:='; for moCount:=1 to count do moRetstring:=moRetstring+char; result:=moRetstring; end; function shsjh:string; var motime:Tsystemtime; j:integer; a1,a2,A3:dword; getstr:STRING; begin A3:=GetTickCount(); WHILE (A3=GetTickCount()) DO ; A3:=GetTickCount(); getsystemtime(motime); a1:=(motime.wyear*12+motime.wmonth)*31+motime.wday; a2:=(motime.whour*3600+motime.wminute*60+motime.wsecond)*1000+A3 mod 1000; getstr:='; while a2>36 do begin j:=a2 mod 36; if j<10 then getstr:=inttostr(j)+getstr else getstr:=chr(j+55)+getstr; a2:=a2 div 36; end; a1:=a1*100+a2; while a1>0 do begin j:=a1 mod 36; if j<10 then getstr:=inttostr(j)+getstr else getstr:=chr(j+55)+getstr; a1:=a1 div 36 end; result:=copy(getstr,1,10); end; function MonthMaxDay(year,month:integer):integer; begin case month of 1,3,5,7,8,10,12: result:=31; 2: if (year mod 4=0) and (year mod 100<>0) or (year mod 400=0) then result:=29 else result:=28; 4,6,11: result:=30; else result:=30; end; end; function DeleteAllFile(filename:string):integer; var moFileindex:integer; moFilename:TSearchRec; moPath:string; begin moPath:=extractfilepath(filename); result:=0; //moFileindex:= FindFirst(filename,faReadOnly + faSysFile+faHidden+faArchive+faAnyFile+faVolumeID, mofilename); moFileindex:= FindFirst(filename,0, mofilename); while moFileindex=0 do begin deletefile(moPath+mofilename.name); moFileindex:= FindNext(mofilename); result:=result+1; end; FindClose(mofilename); end; function iif(const cstj:boolean;const cs1,cs2:variant):variant; begin if cstj then iif:=cs1 else iif:=cs2; end; function GetLeftString(strings,char:string):string; var p:integer; begin result:=strings; p:=pos(char,strings); if p>0 then result:=copy(strings,1,p-1); end; function NumberToCN(num0:currency):string; var char1,char,dxmc,dxm,mc:string; a:integer; begin dxm:='零壹贰叁肆伍陆柒捌玖'; char1:=StrRight(space(14)+floattostrf(abs(num0),ffFixed,13,2),13); a:=1; dxmc:='; mc:='; while a<=length(char1) do begin char:=copy(char1,a,1); if (a=11) or (char='0') or (char=' ') then begin a:=a+1; continue; end; case a of 1:begin dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'拾'; mc:='拾亿'; end; 2:begin dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'亿'; mc:='亿'; end; 3:begin if (mc<>'亿') and (length(mc)<>0) then dxmc:=dxmc+'亿零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'仟'; mc:='仟万'; end; 4:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if mc='亿' then dxmc:=dxmc+'零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'佰'; mc:='佰万'; end; 5:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if mc='亿' then dxmc:=dxmc+'零'; if mc='仟万' then dxmc:=dxmc+'零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'拾'; mc:='拾万'; end; 6:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if mc='亿' then dxmc:=dxmc+'零'; if (mc='仟万') or (mc='佰万') then dxmc:=dxmc+'零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'万'; mc:='万'; end; 7:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if mc='亿' then dxmc:=dxmc+'零'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'仟'; mc:='仟'; end; 8:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万零'; if (mc='亿') or (mc='万') then dxmc:=dxmc+'零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'佰'; mc:='佰'; end; 9:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万零'; if (mc='亿') or (mc='万') or (mc='仟') then dxmc:=dxmc+'零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'拾'; mc:='拾'; end; 10:begin if mc='拾亿' then dxmc:=dxmc+'亿零'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万零'; if (mc='亿') or (mc='万') or (mc='仟') or (mc='佰') then dxmc:=dxmc+'零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'元'; mc:='元'; end; 12:begin if mc='拾亿' then dxmc:=dxmc+'亿元零'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万元零'; if (mc='亿') or (mc='万') or (mc='仟') or (mc='佰') or (mc='拾') then dxmc:=dxmc+'元零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'角'; mc:='角'; end; 13:begin if mc='拾亿' then dxmc:=dxmc+'亿元零'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万元零'; if (mc='亿') or (mc='万') or (mc='仟') or (mc='佰') or (mc='拾') or (mc='元') then dxmc:=dxmc+'元零'; dxmc:=dxmc+copy(dxm,strtoint(char)*2+1,2)+'分'; mc:='分'; end; end; a:=a+1; end; if mc='拾亿' then dxmc:=dxmc+'亿元'; if (mc='仟万') or (mc='佰万') or (mc='拾万') then dxmc:=dxmc+'万元'; if (mc='亿') or (mc='万') or (mc='仟') or (mc='佰') or (mc='拾') then dxmc:=dxmc+'元'; if pos(mc,'角分')=0 then dxmc:=dxmc+'正'; if num0=0 then dxmc:=' else if num0<0 then dxmc:='负'+dxmc; result:=dxmc; end; function MessageWaitBox(aviname,mess:string):TForm; begin Application.CreateForm(TFormSunlib_wait,FormSunlib_wait); with FormSunlib_wait do begin if length(mess)>0 then panelMessage.caption:=mess; aviname:=uppercase(aviname); if aviname='FINDCOMPUTER' then animate1.commonavi:=aviFindComputer else if aviname='FINDFILE' then animate1.commonavi:=aviFindFile else if aviname='FINDFOLDER' then animate1.commonavi:=aviFindFolder else if aviname='FINDFILE' then animate1.commonavi:=aviFindFile else animate1.commonavi:=aviFindComputer; show; update; end; result:=FormSunlib_wait; end; function Calendarbook(var datetime:TDatetime;YearEnabled,MonthEnabled,DayEnabled:boolean;x,y:integer):boolean; //日历 var yy,mm,dd:word; datetime0:TDatetime; begin decodedate(datetime,yy,mm,dd); result:=false; with TformSunLib_Calendar.create(nil) do begin if X>0 then left:=X; if Y>0 then top:=Y; if (x>0) or (y>0) then position:=poDesigned; if dd>monthmaxday(yy,mm) then dd:=monthmaxday(yy,mm); calendar1.day:=dd ; calendar1.year:=yy; calendar1.month:=mm; calendar1.enabled:=dayenabled; if not yearenabled then labelYear.tag:=1; if not monthenabled then labelMonth.tag:=1; speedbuttonLeft.enabled:=monthenabled; speedbuttonRight.enabled:=monthenabled; labelYear.caption:=inttostr(calendar1.year); LabelMonth.caption:=MonthName[calendar1.month]; showmodal; if tag=1 then begin datetime0:=encodedate(calendar1.year, calendar1.month,calendar1.day); if datetime0<>datetime then begin datetime:=datetime0; result:=true; end; end; free; end; end; function InputStringBox(title,mess:string;var value:string):boolean; begin with TFormShinputbox.create(nil) do begin caption:=title; labelMess.caption:=mess; editValue.AutoSelect:=false; editValue.text:=trim(value); editValue.MaxLength:=length(value); editValue.SelStart:=0; showmodal; value:=editValue.text; result:=returncs; free; end; end; function InputStringBoxA(title,mess,editmask:string;var value:string):boolean; begin with TFormShinputbox.create(nil) do begin caption:=title; labelMess.caption:=mess; editValue.AutoSelect:=false; editValue.editmask:=editmask; editValue.text:=trim(value); editValue.MaxLength:=length(value); editValue.SelStart:=0; showmodal; value:=editValue.text; result:=returncs; free; end; end; procedure shBoxmessagePos(ss:string;left0,top0,width0,height0:integer); var ss2,mess,ss1:string; hs,p:integer; begin mess:='; hs:=1; ss2:='; p:=pos('|',ss); if p=0 then begin mess:=ss; end else while length(ss)>0 do begin ss1:=copy(ss,1,p-1); if length(ss1)>length(ss2) then ss2:=ss1; mess:=mess+ss1; delete(ss,1,p); if length(ss)>0 then begin hs:=hs+1; mess:=mess+chr(13); p:=pos('|',ss); if p=0 then p:=length(ss)+1; end; end; //top0:=top0+application.MainForm.Top; with TFormShmessagebox.create(nil) do begin StaticText1.width:=Canvas.TextWidth(ss2); StaticText1.Height:=Canvas.TextHeight('h')*hs; StaticText1.caption:=mess; width:=StaticText1.width+(panel1.BevelWidth+panel1.BorderWidth)*2+(panel2.BevelWidth+panel2.BorderWidth)*2+2; height:=StaticText1.Height+(panel1.BevelWidth+panel1.BorderWidth)*2+(panel2.BevelWidth+panel2.BorderWidth)*2+2; left:=left0+(width0-width) div 2; top:=top0+height0-height-10; showmodal; free; end; end; procedure shBoxmessage(ss:string;left0,top0:integer); var ss2,mess,ss1:string; hs,p:integer; begin mess:='; hs:=1; ss2:='; p:=pos('|',ss); if p=0 then begin mess:=ss; end else while length(ss)>0 do begin ss1:=copy(ss,1,p-1); if length(ss1)>length(ss2) then ss2:=ss1; mess:=mess+ss1; delete(ss,1,p); if length(ss)>0 then begin hs:=hs+1; mess:=mess+chr(13); p:=pos('|',ss); if p=0 then p:=length(ss)+1; end; end; with TFormShmessagebox.create(nil) do begin StaticText1.width:=Canvas.TextWidth(ss2); StaticText1.Height:=Canvas.TextHeight('h')*hs; StaticText1.caption:=mess; width:=StaticText1.width+(panel1.BevelWidth+panel1.BorderWidth)*2+(panel2.BevelWidth+panel2.BorderWidth)*2+2; height:=StaticText1.Height+(panel1.BevelWidth+panel1.BorderWidth)*2+(panel2.BevelWidth+panel2.BorderWidth)*2+2; if top0<0 then top:=screen.Height-height-50 else top:=top0; case left0 of -1:left:=screen.width-width-5; -2:left:=(screen.width-width-5) div 2; else left:=left0; end; showmodal; free; end; end; procedure WriteStringToFile(pathfilename,strings:string); var fh:Textfile; isNew:boolean; begin {$I-} assignfile(fh,pathfilename); isNew:=not fileexists(pathfilename); if isNew then rewrite(fh) else append(fh); writeln(fh,strings); flush(fh); closefile(fh); {$I+} end; function FindFileString(pathfilename,strings:string):boolean; var fh:Textfile; tstr:string; begin result:=false; if not fileexists(pathfilename) then exit; {$I-} assignfile(fh,pathfilename); reset(fh); {$I+} while not eof(fh) do begin readln(fh,tstr); if tstr=strings then begin result:=true; break; end; end; closefile(fh); end; procedure DeleteFileString(pathfilename,strings:string); var stringlist:TStringlist; i:integer; begin if not fileexists(pathfilename) then exit; stringlist:=TStringlist.create; stringlist.Sorted:=true; i:=fileopen(pathfilename,fmOpenReadWrite); if i>0 then begin fileclose(i); stringlist.LoadFromFile(pathfilename); if stringlist.Count>0 then begin i:=-1; if stringlist.Find(strings,i) then begin stringlist.Delete(i); stringlist.SaveToFile(pathfilename); end; end; end; stringlist.Free; end; procedure GetFieldLabel(xtdh:string;table1,tableDict:TTable); var i:integer; wjdh,fieldname:string; begin wjdh:=uppercase(table1.TableName); for i:=0 to table1.FieldCount-1 do begin fieldname:=uppercase(table1.Fields[i].fieldname); if tableDict.FindKey([wjdh,fieldname]) then table1.Fields[i].DisplayLabel:=tableDict.fieldbyname('f3').asstring; end; end; procedure CreateGrid(dbgrid1:TshDBGrid;LineColor:TColor); var zw,t,w,i:integer; Line:TShline; begin //加竖线 t:=0; if dgTitles in dbgrid1.Options then t:=dbgrid1.DefaultRowHeight+1; w:=0; for i:=0 to dbgrid1.Columns.Count-1 do begin w:=w+dbgrid1.Columns[i].width; Line:=TShline.Create(nil); Line.Parent:=dbGrid1; line.Pen.Color:=LineColor;//clSilver; line.Top:=t; line.left:=w; line.height:=dbgrid1.height; w:=w+1; end; zw:=w; //加横线 if dgTitles in dbgrid1.Options then w:=dbgrid1.DefaultRowHeight else w:=0; if dgTitles in dbgrid1.Options then w:=w+1; w:=w+dbgrid1.DefaultRowHeight; while w='芭') and (ss1<='怖') then ss0:=ss0+'b' else if (ss1>='擦') and (ss1<='错') then ss0:=ss0+'c' else if (ss1>='搭') and (ss1<='堕') then ss0:=ss0+'d' else if (ss1>='蛾') and (ss1<='贰') then ss0:=ss0+'e' else if (ss1>='发') and (ss1<='咐') then ss0:=ss0+'f' else if (ss1>='噶') and (ss1<='过') then ss0:=ss0+'g' else if (ss1>='哈') and (ss1<='祸') then ss0:=ss0+'h' else if (ss1>='击') and (ss1<='骏') then ss0:=ss0+'j' else if (ss1>='喀') and (ss1<='阔') then ss0:=ss0+'k' else if (ss1>='垃') and (ss1<='络') then ss0:=ss0+'l' else if (ss1>='好') and (ss1<='穆') then ss0:=ss0+'m' else if (ss1>='拿') and (ss1<='诺') then ss0:=ss0+'n' else if (ss1>='哦') and (ss1<='沤') then ss0:=ss0+'o' else if (ss1>='啪') and (ss1<='瀑') then ss0:=ss0+'p' else if (ss1>='期') and (ss1<='群') then ss0:=ss0+'q' else if (ss1>='然') and (ss1<='弱') then ss0:=ss0+'r' else if (ss1>='撒') and (ss1<='所') then ss0:=ss0+'s' else if (ss1>='塌') and (ss1<='唾') then ss0:=ss0+'t' else if (ss1>='挖') and (ss1<='误') then ss0:=ss0+'w' else if (ss1>='昔') and (ss1<='迅') then ss0:=ss0+'x' else if (ss1>='压') and (ss1<='孕') then ss0:=ss0+'y' else if (ss1>='匝') and (ss1<='座') then ss0:=ss0+'z' else ss0:=ss0+ss1; i:=i+1; end else begin ss0:=ss0+c1+c2; i:=i+1; end; end else begin ss0:=ss0+c1; i:=i+1; end; end; result:=ss0; end; function GetSerialE(no:string;year,month:word):string; var ss:string; i:integer; begin ss:=formatdatetime('yyyymm',encodedate(year,month,1)); //if copy(no,1,6)>=ss then ss:=copy(no,1,6); //ss:=copy(ss,1,6); if no=' then result:=ss+'00001' else try delete(no,1,6); i:=strtoint(no)+1; result:=ss+strright('00000'+inttostr(i),5); except result:=ss+'00001'; end; end; function GetSerial(no:string):string; var ss:string; i:integer; begin ss:=formatdatetime('yyyymmdd',ServerDateTime); if copy(no,1,8)<ss then result:=ss+'0001' else try ss:=copy(no,1,8); delete(no,1,8); i:=strtoint(no)+1; result:=ss+strright('0000'+inttostr(i),4); except result:=ss+'0001'; end; end; procedure WriteParamString(section,symbol,value:string); var queryParameter:TQuery; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if QueryParameter.IsEmpty then begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('insert into uparameter (usection,usymbol,uvalue) values'); QueryParameter.sql.add('("'+section+'","'+symbol+'","'+value+'")'); end else begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('update uparameter set uvalue="'+value+'" '); QueryParameter.sql.add('where usection="'+section+'" and uSymbol="'+symbol+'"'); end; QueryParameter.ExecSQL; end; queryParameter.free; end; procedure WriteParamInteger(section,symbol:string;value:integer); var queryParameter:TQuery; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if QueryParameter.IsEmpty then begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('insert into uparameter (usection,usymbol,uvalue) values'); QueryParameter.sql.add('("'+section+'","'+symbol+'","'+inttostr(value)+'")'); end else begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('update uparameter set uvalue="'+inttostr(value)+'"'); QueryParameter.sql.add('where usection="'+section+'" and uSymbol="'+symbol+'"'); end; QueryParameter.ExecSQL; {if not QueryParameter.locate('usection;usymbol',vararrayof([section,symbol]),[loCaseInsensitive]) then begin QueryParameter.append; QueryParameter.edit; QueryParameter.FieldByName('usection').asstring:=section; QueryParameter.FieldByName('usymbol').asstring:=symbol; end else QueryParameter.edit; QueryParameter.FieldByName('uvalue').asinteger:=value; QueryParameter.post; try if not pUserDatabase.InTransaction then pUserDatabase.StartTransaction; QueryParameter.CommitUpdates; pUserDatabase.Commit; except pUserDatabase.Rollback; end;} end; queryParameter.free; end; procedure WriteParamFloat(section,symbol:string;value:real); var queryParameter:TQuery; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if QueryParameter.IsEmpty then begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('insert into uparameter (usection,usymbol,uvalue) values'); QueryParameter.sql.add('("'+section+'","'+symbol+'","'+floattostr(value)+'")'); end else begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('update uparameter set uvalue="'+floattostr(value)+'"'); QueryParameter.sql.add('where usection="'+section+'" and uSymbol="'+symbol+'"'); end; QueryParameter.ExecSQL; end; queryParameter.free; end; procedure WriteParamBoolean(section,symbol:string;value:boolean); var ss:string; queryParameter:TQuery; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); if value then ss:='1' else ss:='0'; //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; //if not QueryParameter.locate('usection;usymbol',vararrayof([section,symbol]),[loCaseInsensitive]) then if QueryParameter.IsEmpty then begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('insert into uparameter (usection,usymbol,uvalue) values'); QueryParameter.sql.add('("'+section+'","'+symbol+'","'+ss+'")'); {QueryParameter.append; QueryParameter.edit; QueryParameter.FieldByName('usection').asstring:=section; QueryParameter.FieldByName('usymbol').asstring:=symbol;} end else begin QueryParameter.close; QueryParameter.sql.clear; QueryParameter.sql.add('update uparameter set uvalue="'+ss+'"'); QueryParameter.sql.add('where usection="'+section+'" and uSymbol="'+symbol+'"'); {QueryParameter.edit; QueryParameter.FieldByName('uvalue').asboolean:=value; QueryParameter.post;} end; QueryParameter.ExecSQL; end; queryParameter.free; end; function ReadParamString(section,symbol,value:string):string; var queryParameter:TQuery; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if not QueryParameter.IsEmpty then value:=trim(QueryParameter.FieldByName('uvalue').asstring); result:=value; queryParameter.free; end; function ReadParamInteger(section,symbol:string;value:integer):integer; var queryParameter:TQuery; ss:string; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); result:=value; //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if not QueryParameter.IsEmpty then try ss:=trim(QueryParameter.FieldByName('uvalue').asstring); result:=strtoint(ss); except result:=value; end; end; queryParameter.free; end; function ReadParamFloat(section,symbol:string;value:real):real; var queryParameter:TQuery; ss:string; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); section:=uppercase(section); symbol:=uppercase(symbol); result:=value; //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if not QueryParameter.IsEmpty then try ss:=trim(QueryParameter.FieldByName('uvalue').asstring); result:=strtofloat(ss); except result:=value; end; end; queryParameter.free; end; function ReadParamBoolean(section,symbol:string;value:boolean):Boolean; var queryParameter:TQuery; begin queryParameter:=Tquery.create(nil); queryParameter.DatabaseName:=ReadValue(psUserDataBaseName); //pUserdataBase:=readdatabase(psUserdataBase); //QueryParameter.DatabaseName:=pUserdataBase.DatabaseName; section:=uppercase(section); symbol:=uppercase(symbol); result:=value; //with DMparameter do begin QueryParameter.close; QueryParameter.sql.text:='select * from uParameter where usection="'+section+'" and uSymbol="'+symbol+'"'; QueryParameter.open; if not QueryParameter.IsEmpty then try result:=QueryParameter.FieldByName('uvalue').asstring='1'; except result:=value; end; end; queryParameter.free; end; function ServerDateTime:TDatetime; var query1:TQuery; begin query1:=Tquery.create(nil); query1.DatabaseName:=ReadValue(psUserDataBaseName); query1.sql.text:='select getdate() as date0'; query1.open; result:=query1.fieldbyname('date0').asDatetime; query1.free; end; function GetRandom:string; {返回随机数} var j:integer; getstr:STRING; begin Randomize; getstr:='; for j:=0 to 9 do getstr:=getstr+inttostr(random(10)); result:=getstr; end; function GetRandomA:string; {返回随机数} var j:integer; getstr:STRING; n:word; begin Randomize; n:=ord('A'); getstr:='; for j:=0 to 9 do getstr:=getstr+char(n+random(25)); result:=getstr; end; procedure Draw3dText(canvas:TCanvas;rect:TRect;text:string;Text3DStyle:TTextStyle;Alignment: TAlignment); begin with canvas do begin brush.style:=bsClear; font.color:=clHighlightText; case Alignment of taLeftJustify:DrawText(handle,pchar(text),-1,rect,DT_LEFT+dt_vcenter+dt_singleline); taCenter:DrawText(handle,pchar(text),-1,rect,dt_center+dt_vcenter+dt_singleline); taRightJustify:DrawText(handle,pchar(text),-1,rect, DT_RIGHT+dt_vcenter+dt_singleline); end; if Text3DStyle=tsRaised then begin inc(rect.left); inc(rect.top); end else begin dec(rect.left); dec(rect.top); end; font.color:=clWindowText; case Alignment of taLeftJustify:DrawText(handle,pchar(text),-1,rect,DT_LEFT+dt_vcenter+dt_singleline); taCenter:DrawText(handle,pchar(text),-1,rect,dt_center+dt_vcenter+dt_singleline); taRightJustify:DrawText(handle,pchar(text),-1,rect, DT_RIGHT+dt_vcenter+dt_singleline); end; end; end; end. ----------------------------------------------