double length=TDateTime::CurrentDateTime()-(double)OldTime;怎么将时间换成分钟

stiwin 2003-10-17 12:13:07

double length=TDateTime::CurrentDateTime()-(double)OldTime;怎么将时间换成分钟

...全文

42 1 打赏收藏转发到动态举报

写回复

1 条回复

切换为时间正序

请发表友善的回复…

发表回复

ljianq 2003-10-17

打赏
举报

回复

可以使用MinutesBetween（）；

首先十分感谢你的使用. 同时也希望你能对这个功能包进行扩充...发布你的扩充后的版本. --------------------------------------------------------- ^^ 声明这个组件包只能在delphi7上正常安装. 如果您用的是delphi6.则会在安装时出错。 ------------------------------------------------- 作者：李金浩 QQ:67260745 E-mail:lijinjie2793311@163.com 功能包中的大部分功能模块为本人自己所写。。部分收录我的网友的作品及网上比较精典的程序段。　　 Function HexBCDToint(sHexBCD:Byte):integer; 　　　Function IntToBCD(Int:Byte):word; 　　　Function MinuteToTime(Minute:Double):TdateTime;overload;//分钟到标准时间的转换　　　Function MinuteToTime(Minute:Double;var DayCount:integer):TdateTime;overload; //------------------------------------------------------------------------------ 　　　Function GetWeekOfChina(dDay:TdateTime):string;//得到星期　　　Function GetWeekOfNum(dDay:TdateTime):integer; //------------------------------------------------------------------------------ 　　　Function IsStrAsNumber(NumStr:string):Bool;//判断字符串是不是有效数字在字符串　　　Function IsStrInOtherStr(mainStr,FindStr:string):Bool;//检测在一个字符串中是否包括另一个字符串　　　function IsCOMClassRegistered(GUID:TGUID):Boolean;//判断一个COM对像是否已注册　　　Function IsBDEInstalled:boolean;//查看ＢＤＥ是否安装　　　function GetPYIndexChar( hzchar:string):char;//得到汉字的首字母　　　Function Squ(X,Y:integer):integer;overload;//计算x的Y次方　　　Function Squ(X:Double;Y:integer):Double;overload;//计算x的Y次方　　　Function　RandomNumByGUID:String; 　//--------------系统功能------------ 　　　Function　AppRunOnce:Boolean;//让程序只能运行一个实例　　　procedure AutoRunByReg(FileName:string='');//让程序自动运行　　　procedure DelAutoRunByReg(KeyName:string='');//删除一个自启动项　　　procedure MoveWindow(handle:Thandle);overload;//托动无标题窗体　　　Function　GetAppPath(AddLastName:string=''):string;//得到程序的当前目录　　　Procedure ReMoveWinTitle(Form:Tform);//移去窗体的Title; 　　　procedure BeepEx(Freq:Word;MSecs:LongInt); //DoBeep调用　　　procedure ClickStartMenu;//通过代码击活开始菜单　　　procedure OpenScreenSave;//打开屏幕保护　　//　procedure DelTree(DirName:String);//删除目录　　　procedure DeleteDir(SourcePath: String); //删除指定文件夹(含子文件夹),文件夹及其夹内文件可以具有只读或隐藏属性　　　procedure DelSelfApp;//程序在运行完后就删除自己　　　(*-----------------*) 　　　procedure HideTaskBar(bHide:boolean=False);//显示或掩藏TaskBar 　　　procedure DisplayOFFON(SW: boolean);//关闭和打开显示器　　　procedure HideDesktop(sw:Boolean=false);//显示和隐藏桌面　　　procedure HideDesktopAndTaskBar(sw:Boolean=false);//同时隐藏桌面和任务栏　　　procedure HideTrayNotify(sw:Boolean=false);//隐藏系统通知区域　　　procedure HideWinButton(sw:Boolean=false);//隐藏开始按钮　　　procedure HideQuickLaunchBar(sw:Boolean=false);//隐藏快速启动按钮栏　 //　 procedure HideAppInTastWin(sw:Boolean=False);//使程序在任务管理器中隐藏　　　procedure DisbleQuikKey(sw:boolean=false);//屏蔽ALT+F4和ALT+Ctrl+Del 　　　Function GetTaskBarHeight:integer;//得到任务栏的高度 //------------------------------------------------------------------------------ 　　　function GetDesktopListViewHandle: THandle;　{　得到桌面列表试图的句柄 } 　　　procedure MinWinAll;//最小化所有的窗体　　　procedure CloseWinAll;//关闭所有窗体　　　procedure DrawWindowRect(handle: Thandle;wColor: Tcolor=clBlack;PenWidth:integer=1);//给窗体加个边框　　　Procedure SetParentWinDefFont(Sender:TObject;const defFont:Tfont=nil);//设置parent窗体的默认字体　　　{得到memo中光标所在的位置，行号，行长} 　　　procedure GetMemoMousePos(m:Tmemo;var posValue:TmemoPos);overload; 　　　procedure GetMemoMousePos(m:TRichEdit;var posValue:TmemoPos);overload; 　　 //Memo翻页　　　procedure setScrollPos(MHandle:Thandle;const pos:TClickType=PageDown);overload; 　　　//得到指定窗体的大小　　　procedure GetWinRect(const WinHandle:HWND;var winRect:TwinRect); 　　　procedure TimeDelay(DT:Dword);//精确毫秒级延时　　　procedure SetIPaddress(SIP: TNetValue;const isAuto:boolean=false);//设定网络Ip地址　　　Function GetLocalIP:string;//得到本机的IP地址　　　Procedure OpenURL(URL:string);//打开1个web URL //============================================================================== // 这一部分的函数摘自其他作者处.姓名不详 //============================================================================== 　　　function GetDisplayFrequency: Integer;　//获取显示刷新率　　　function GetIdeSerialNumber: String; //获取第一个硬盘的序列号　　　function GetCPUSpeed: Double;　//获取当前CPU速率　　　Function GetCPUID:string;　//获取CPU ID 　　　Function GetCPUVendor: string;　//获取CPU 类型　　　Function GetFileLastAccessTime(sFileName:string):TDateTime; //获取文件最后访问日期和时间　　　Function GetFileCreateTime(const strFileName:string):TDateTime; //获取文件创建时间　　　Function GetFileModifyTime(const strFileName:string):TDateTime; //获取文件修改时间　　　Function GetDNSTOIP(DNSName:String):String; //把域名转化为IP地址　　　Function GetDNSName(IPAddress:String):String; //把IP地址转化为域名

unit CnDigits;{-------------------------------------------------------------------- 货币数字转为为中文大写的组件 Version 1.31 by SNAKEJIAO 2003.4.13简介: 可以转化整数，浮点数，及时间日期型数据配合别名列表可以进行语音合成，主要用于东进中继卡中的PlayPrompt提示语音的合成用于电话系统中播放金额，日期及时间还有输入的数字序列，同时更多的应用于显示销售系统中的打印发票时的中文大写金额字段email: jiaoguoqing26＠21cn.com来自：爱数星星的猫, 时间：2003-9-17 没有习惯，有规定。给你看看人民银行的规定吧（说不定你还得改改^_^）。正确填写票据和结算凭证的基本规定银行、单位和个人填写的各种票据和结算凭证是办理支付结算和现金收付的重要依据，直接关系到支付结算的准确、及时和安全。票据和结算凭证是银行、单位和个人凭以记载账务的会计凭证，是记载经济业务和明确经济责任的一种书面证明。因此，填写票据和结算凭证，必须做到标准化、规范化，要要素齐全、数字正确、字迹清晰、不错漏、不潦草，防止涂改。一、中文大写金额数字应用正楷或行书填写，如壹（壹）、贰（贰）、叁、肆（肆）、伍（伍）、陆（陆）、柒、捌、玖、拾、佰、仟、万（万）、亿、元、角、分、零、整（正）等字样。不得用一、二（两）、三、四、五、六、七、八、九、十、念、毛、另（或0）填写，不得自造简化字。如果金额数字书写中使用繁体字，如貳、陸、億、萬、圓的，也应受理。二、中文大写金额数字到“元”为止的，在“元”之后，应写“整”（或“正”）字，在“角”之后可以不写“整”（或“正”）字。大写金额数字有“分”的，“分”后面不写“整”（或“正”）字。三、中文大写金额数字前应标明“人民币”字样，大写金额数字应紧接“人民币”字样填写，不得留有空白。大写金额数字前未印“人民币”字样的，应加填“人民币”三字。在票据和结算凭证大写金额栏内不得预印固定的“仟、佰、拾、万、仟、伯、拾、元、角、分”字样。四、阿拉伯小写金额数字中有“0”时，中文大写应按照汉语语言规律、金额数字构成和防止涂改的要求进行书写。举例如下：（一）阿拉伯数字中间有“O”时，中文大写金额要写“零”字。如￥1，409．50，应写成人民币壹仟肆佰零玖元伍角。（二）阿拉伯数字中间连续有几个“0”时，中文大写金额中间可以只写一个“零”字。如￥6，007．14，应写成人民币陆仟零柒元壹角肆分。（三）阿拉伯金额数字万位或元位是“0”，或者数字中间连续有几个“0”，万位、元位也是“0’，但千位、角位不是“0”时，中文大写金额中可以只写一个零字，也可以不写“零”字。如￥1，680．32，应写成人民币壹仟陆佰捌拾元零叁角贰分，或者写成人民币壹仟陆佰捌拾元叁角贰分；又如￥107，000．53，应写成人民币壹拾万柒仟元零伍角叁分，或者写成人民币壹拾万零柒仟元伍角叁分。（四）阿拉伯金额数字角位是“0”，而分位不是“0”时，中文大写金额 “元”后面应写“零”字。如￥16，409.02，应写成人民币壹万陆仟肆佰零玖元零贰分；又如￥325．04，应写成人民币叁佰贰拾伍元零肆分。五、阿拉伯小写金额数字前面，均应填写入民币符号“￥”（或草写：）。阿拉伯小写金额数字要认真填写，不得连写分辨不清。六、票据的出票日期必须使用中文大写。为防止变造票据的出禀日期，在填写月、日时，月为壹、贰和壹拾的，日为壹至玖和壹拾、贰拾和叁抬的，应在其前加“零”；日为抬壹至拾玖的，应在其前加“壹”。如1月15日，应写成零壹月壹拾伍日。再如10月20日，应写成零壹拾月零贰拾日。七、票据出票日期使用小写填写的，银行不予受理。大写日期未按要求规范填写的，银行可予受理，但由此造成损失的，由出票入自行承担。--------------------------------------------------------------------}{ ‘NOTICE: uncomment following line to discard unused code !‘}{ ‘注意: 去掉下面这一行，可以抛弃收集的其它代码‘}// { discard_other_code}interfaceuses Windows, Messages, SysUtils, Classes, Math;type //类型定义 TDate = TDateTime; TTime = TDateTime; { 中文数字大写组件 by lichaohui } TCnDigits = class(TComponent) private Fda: Boolean; procedure SetDA(const Value: Boolean); procedure SetCnUP(const Value: String); protected FCurrVa: Currency; FCnUpDigits: String; FAlias: TStrings; procedure SetCurrVa(const Value: Currency); procedure SetAlias(const Value: TStrings); public { discard_other_code} //下面是肖杨的商场管理源码中的代码 //返加人民币的中文数值 class function other_RMB(NN:real):string; //其它的两个方法 class function other_SmallTOBig(small: real): string; class function other_XD(xx: currency): string; {} //下面是lichaohui的工具函数 class function LzhFmtInt(IntValue: Int64; IsYear: Boolean = False; SoftTone: Boolean = False): String; class function LzhFmtDigits(Digits: String): String; class function LzhFmtFloat(FloatValue: Extended; RoundPos: Integer = 8): String; class function LzhFmtCurrency(AValue: Currency): String; overload; class function LzhFmtCurrency(AValue: Int64): String; overload; class function LzhFmtDate(AValue: TDate; DigitsYear: Boolean = False): String; class function StdFmtDate(AValue: TDate; DigitsYear: Boolean = False): String; class function LzhFmtTime(AValue: TTime; HasSecond: Boolean = False): String; class function LzhFmtDateTime(AValue: TDateTime; DigitsYear: Boolean = False): String; class function StdFmtDateTime(AValue: TDateTime; DigitsYear: Boolean = False): String; //常用方法调用接口 function ChineseUpper(Curr: Currency): String; function ChineseDate(ADate: TDate; DigitsYear: Boolean = False): String; function ChineseTime(ATime: TTime; HasSecond: Boolean = False): String; //等价别名转化 function StrToAlias(S: String): String; function StrToAlias2(S: String): String; //构造和析构函数 constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property CurrencyValue: Currency read FCurrVa write SetCurrVa; property CnUpperDigits: String read FCnUpDigits write SetCnUP stored False; property Alias: TStrings read FAlias write SetAlias; property DefaultAlias: Boolean read Fda write SetDA; end;const DP: WideString = ‘零壹贰叁肆伍陆柒捌玖两负‘; DN: WideString = ‘点拾佰仟万拾佰仟亿拾佰仟万拾佰仟兆拾佰仟‘; CrNa: WideString = ‘元角分整‘; DtNa: WideString = ‘年月日时分秒‘;procedure Register;implementationprocedure Register;begin RegisterComponents(‘System‘, [TCnDigits]);end;{ TCnDigits }{ discard_other_code}class function TCnDigits.other_RMB(NN: real): string;var HZ, NS, NW, NA, N1, N2:string; LA, X, Nk:integer;begin //此行代码是为了修正小数位多于两位时生成的结果的错误 NN := Int(NN * 100) / 100; //下面的代码被lichaohui格式化整理 if NN > 9999999999999.99 then begin //MessageDlg(‘金额溢出。‘,mtError,[mbOk], 0); HZ := ‘‘; Result := HZ; exit; end; if NN = 0 then begin HZ := ‘零元‘; result := HZ; exit; end; NS := ‘零壹贰叁肆伍陆柒捌玖‘; NW := ‘分角元拾佰仟万拾佰仟亿拾佰仟万‘; NA := FloatToStr(NN * 100); LA := length(NA); X := 1; HZ := ‘‘; while X<=LA do begin NK := Ord(NA[x]) - Ord(‘0‘); N1 := Copy(NS, NK * 2 + 1, 2); N2 := Copy(NW, LA * 2 + 1 - X * 2, 2); if (NK = 0) AND ((N2 = ‘亿‘) OR( N2 = ‘万‘) OR( N2 = ‘元‘))then begin if copy(HZ,Length(HZ)-1,2) = ‘零‘ then HZ := copy(HZ, 1, length(HZ) - 2); if copy(HZ, Length(HZ) - 1, 2) = ‘亿‘ then if N2 = ‘元‘ then begin N1 := N2; N2 := ‘零‘; end else N2 := ‘‘ else begin N1 := N2; N2 := ‘零‘; end end else if NK=0 then begin if copy(HZ, length(HZ) - 1, 2)=‘零‘ then N1 := ‘‘; if N2=‘分‘ then begin if copy(HZ, length(HZ) - 1, 2)=‘零‘ then HZ := copy(HZ, 1, length(HZ) - 2) + ‘整‘ else HZ := HZ + ‘整‘; N1 := ‘‘; end; N2 := ‘‘; end; HZ := HZ + N1 + N2; X := X + 1 end; {end of while statement} Result := HZ;end;class function TCnDigits.other_SmallTOBig(small: real): string;var SmallMonth,BigMonth:string; wei1,qianwei1:string[2]; qianwei,dianweizhi,qian:integer;begin {------- 修改参数令值更精确 -------} {小数点后的位数，需要的话也可以改动该值} qianwei:=-2; {转换成货币形式，需要的话小数点后加多几个零} Smallmonth:=formatfloat(‘0.00‘,small); {---------------------------------} dianweizhi :=pos(‘.‘,Smallmonth);{小数点的位置} {循环小写货币的每一位，从小写的右边位置到左边} for qian:=length(Smallmonth) downto 1 do begin {如果读到的不是小数点就继续} if qiandianweizhi then begin {位置上的数转换成大写} case strtoint(copy(Smallmonth,qian,1)) of 1:wei1:=‘壹‘; 2:wei1:=‘贰‘; 3:wei1:=‘叁‘; 4:wei1:=‘肆‘; 5:wei1:=‘伍‘; 6:wei1:=‘陆‘; 7:wei1:=‘柒‘; 8:wei1:=‘捌‘; 9:wei1:=‘玖‘; 0:wei1:=‘零‘; end; {判断大写位置，可以继续增大到real类型的最大值，可是谁有那么多钱} case qianwei of -3:qianwei1:=‘厘‘; -2:qianwei1:=‘分‘; -1:qianwei1:=‘角‘; 0 :qianwei1:=‘元‘; 1 :qianwei1:=‘拾‘; 2 :qianwei1:=‘佰‘; 3 :qianwei1:=‘千‘; 4 :qianwei1:=‘万‘; 5 :qianwei1:=‘拾‘; 6 :qianwei1:=‘佰‘; 7 :qianwei1:=‘千‘; 8 :qianwei1:=‘亿‘; 9 :qianwei1:=‘拾‘; 10:qianwei1:=‘佰‘; 11:qianwei1:=‘千‘; end; inc(qianwei); BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额} end; end; Result := BigMonth;end;class function TCnDigits.other_XD(xx: currency): string;var dx,ws:string; i,cd:integer; int:currency;begin int:=trunc(abs(xx)+0.005*100); cd:=length(currtostr(int)); dx:=‘零壹贰叁肆伍陆柒捌玖‘; ws:=‘分角元拾佰仟万拾佰仟亿拾佰仟‘; result:=‘‘; i:=1; while i 0) and (FracPart >= 10) then rs := rs + DP[1]; if (IntPart = 0) and (FracPart 0) then rs := ‘‘; if FracPart >= 10 then begin if FracPart mod 10 = 0 then rs := rs + DP[Jiao + 1] + CrNa[2] + CrNa[4] else rs := rs + DP[Jiao + 1] + CrNa[2] + DP[Fen + 1] + CrNa[3]; end else if FracPart > 0 then begin if IntPart = 0 then rs := rs + DP[Fen + 1] + CrNa[3] else rs := rs + DP[1] + DP[Fen + 1] + CrNa[3]; end else begin rs := rs + CrNa[4]; end; if AValue 0) and (FracPart >= 10) then rs := rs + DP[1]; if (IntPart = 0) and (FracPart 0) then rs := ‘‘; if FracPart >= 10 then begin if FracPart mod 10 = 0 then rs := rs + DP[Jiao + 1] + CrNa[2] + CrNa[4] else rs := rs + DP[Jiao + 1] + CrNa[2] + DP[Fen + 1] + CrNa[3]; end else if FracPart > 0 then begin if IntPart = 0 then rs := rs + DP[Fen + 1] + CrNa[3] else rs := rs + DP[1] + DP[Fen + 1] + CrNa[3]; end else begin rs := rs + CrNa[4]; end; if AValue = ‘0‘) and (Digits[i] 1e15) or (FloatValue 16 then rps := 16; beit := IntPower(10, rps); FraPart := Round(Frac(FloatValue) * beit); rs := LzhFmtInt(IntPart); if FraPart > 0 then begin Digits := IntToStr(FraPart); len := Length(Digits); while (len > 0) and (Digits[len] = ‘0‘) do len := len - 1; Digits := Copy(Digits, 1, len); rs := rs + DN[1] + LzhFmtDigits(Digits); end; if FloatValue < 0 then rs := DP[12] + rs; Result := rs;end;class function TCnDigits.LzhFmtInt(IntValue: Int64; IsYear: Boolean; SoftTone: Boolean): String;var i, n, t: Integer; bi: WideString; LastBt: WideChar; rs: WideString; reach: Boolean; LastHit: Integer;begin //限制为18位数 if IntValue 8000000000000000000 then begin Result := ‘‘; Exit; end; bi := IntToStr(IntValue); //格式化为 bi := StringOfChar(‘0‘, 20 - Length(bi)) + bi; //从左侧开始格式化 LastBt := ‘ ‘; LastHit := 0; reach := False; for i := 1 to 20 do begin //如果非0 if (bi[i] >= ‘1‘) and (bi[i] <= ‘9‘) then begin //如果前一位是0,又不到分界位，补零 if reach and (LastBt = ‘0‘) and (i mod 4 1) then begin rs := rs + DP[1]; end; reach := True; //转换数字,如果是十位，且前一位为0 if SoftTone and (i mod 4 = 3) and (LastBt = ‘0‘) and ((not reach) or (bi[i] = ‘1‘)) then else begin rs := rs + DP[(Ord(bi[i]) - Ord(‘0‘)) mod 10 + 1]; end; //添加位名 n := (20 - i) mod 20 + 1; if n > 1 then begin rs := rs + DN[n]; end; LastHit := 20 - i; end; //分界名 if (bi[i] = ‘0‘) and (i mod 4 = 0) and reach then begin //特殊分界处的显示原则，8位前为空的不显示分界名 //不是8位处的，4位前为空不显示分界名 n := (20 - i) mod 20 + 1; t := n - 1; if (n > 1) and ( ((t mod 8 = 0) and (LastHit - t < 8)) or (((t - 12) mod 8 = 0) and (LastHit - t = 0 then if Result = ‘‘ then Result := FAlias.Values[Ws[i]] else Result := Result + ‘,‘ + FAlias.Values[Ws[i]] else if Result = ‘‘ then Result := Ws[i] else Result := Result + Ws[i]; end;end;function TCnDigits.StrToAlias2(S: String): String;var Ws: WideString; i: Integer; t: Integer;begin Ws := S; for i := 1 to Length(Ws) do begin t := TStringList(FAlias).IndexOfName(Ws[i]); if t >= 0 then Result := Result + FAlias.Values[Ws[i]] else Result := Result + Ws[i]; end;end;constructor TCnDigits.Create(AOwner: TComponent);begin inherited; FAlias := TStringList.Create; TStringList(FAlias).Sorted := True; TStringList(FAlias).Duplicates := dupIgnore;end;destructor TCnDigits.Destroy;begin FAlias.Free; inherited;end;procedure TCnDigits.SetDA(const Value: Boolean);var Ws: WideString; i: Integer; sv: String;begin if Value then begin Ws := DP + DN + CrNa + DtNa; for i := 1 to Length(Ws) do begin sv := Ws[i]; FAlias.Add(sv + ‘=‘ + FAlias.Values[Ws[i]]); end; end else begin for i := FAlias.Count - 1 downto 0 do begin sv := FAlias[i]; if Trim(sv) = ‘‘ then FAlias.Delete(i) else if (Length(sv) > 0) and (sv[Length(sv)] = ‘=‘) then FAlias.Delete(i); end; end; Fda := Value;end;procedure TCnDigits.SetCnUP(const Value: String);begin //FCnUpDigits := Value;end;class function TCnDigits.StdFmtDate(AValue: TDate; DigitsYear: Boolean): String;var yy, mm, dd: Word; ys: WideString; rs: WideString;begin DecodeDate(AValue, yy, mm, dd); if DigitsYear then ys := LzhFmtDigits(IntToStr(yy)) + DtNa[1] else ys := LzhFmtInt(yy, True) + DtNa[1]; rs := ys; if (mm <= 2) or (mm = 10) then rs := rs + DP[1]; rs := rs + LzhFmtInt(mm) + DtNa[2]; if (dd < 10) or (dd mod 10 = 0) then rs := rs + DP[1]; rs := rs + LzhFmtInt(dd) + DtNa[3]; Result := rs;end;class function TCnDigits.StdFmtDateTime(AValue: TDateTime; DigitsYear: Boolean): String;var dt: TDate; tm: TTime;begin dt := AValue; tm := AValue; Result := StdFmtDate(dt, DigitsYear) + LzhFmtTime(tm);end;end.附例子Demo

procedure TFRM_Date.DateChange(MyTime: TDateTime); var i, S: integer; StarNo: integer; Present: TDateTime; Year, Month, Day: Word; begin Label20.Caption := IntToStr(DateUtils.YearOf(Mytime)); Label17.Caption := IntToStr(DateUtils.MonthOf(Mytime)); Label16.Caption := Label17.Caption; Label1.Caption := IntToStr(DateUtils.YearOf(Mytime)); Label21.Caption := Copy(CnSkyStemOfYear(Mytime), 1, 2) + CnanimalOfYear(Mytime); lbl1.Caption := '选定日期为：'+DateToStr(Mytime); lbl2.Caption := Copy(CnSkyStemOfYear(Mytime), 1, 2) + Copy(CnanimalOfYear(Mytime),1,2)+'年'+CnMonthOfDate(Mytime)+CnDayOfDate(Mytime); lbl3.Caption := GetLunarHolDay(Mytime)+CnDayOfDateJr(Mytime)+Holiday(Mytime,DayOf(Mytime)); for i := 1 to 37 do begin CnDate[i].Visible := false; ChnDate[i].Visible := false; CnDate[i].Font.Size := 11; CnDate[i].Color := self.Color; ChnDate[i].Color := self.Color; if (((i) mod 7) = 0) or (((i) mod 7) = 1) then begin CnDate[i].Font.Color := clRed; ChnDate[i].Font.Color := clRed; end else begin CnDate[i].Font.Color := clBlack; ChnDate[i].Font.Color := Cnday.Font.Color; end; end; DecodeDate(MyTime, Year, Month, Day); Present := EncodeDate(Year, Month, 1); StarNo := dayofweek(Present); s := starno + DayOfMonth(Present) - 1; try for i := StarNo to s do begin Present := EncodeDate(Year, Month, i - StarNo + 1); CnDate[i].Caption := IntToStr(i - StarNo + 1); CnDate[i].Tag := i - StarNo + 1; ChnDate[i].Tag := CnDate[i].Tag; ChnDate[i].Caption := CnDayOfDate(Present); if ChnDate[i].Caption = '初一' then begin ChnDate[i].Caption := CnMonthOfDate(Present); ChnDate[i].Font.Color := clRed; end ; if length(Holiday(MyTime, i - StarNo + 1)) > 3 then begin ChnDate[i].Caption := Holiday(MyTime, i - StarNo + 1); ChnDate[i].Font.Color := $000080FF; end; if DateCn.GetLunarHolDay(Present) <> '' then begin ChnDate[i].Caption := GetLunarHolDay(Present); ChnDate[i].Font.Color := $00FF5353; end; if DateCn.CnDayOfDateJr(Present) <> '' then begin ChnDate[i].Caption := CnDayOfDateJr(Present); ChnDate[i].Font.Color := $000080FF; end; if i - StarNo + 1 = day then begin Shape2.Left := CnDate[i].left - 1; Shape2.Top := CnDate[i].top + 1; Label22.Caption := Constellation(Present, day); end; CnDate[i].Visible := true; ChnDate[i].Visible := true; end; except on EConvertError do begin exit; end else exit; end; end;

unit uTimeZonesMgr; interface uses Windows, SysUtils, Classes, Registry, DateUtils; type {* 用于读取时区注册表TZI（长度为44）的属性值，存储时区信息 *} PRegTZIInfo = ^TRegTZIInfo; TRegTZIInfo = record Bias: Longint; StandardBias: Longint; DaylightBias: Longint; StandardDate: TSystemTime; DaylightDate: TSystemTime; end; {* 单个时区管理对象 *} TTimeZone = class private FTimeZoneName: string; //时区的显示名 FDisplay: string; //夏令时的名字 FDlt: string; //时区标准名字 FStd: string; //是Time zone information的缩写，描述时区的一些重要信息 FTZI: PRegTZIInfo; function GetSelfTimeZoneInformation: TTimeZoneInformation; public constructor Create; destructor Destroy; override; function UTCToLocalDateTime(const AUTC: TDateTime; var ALocalDateTime: TDateTime): Boolean; function LocalDateTimeToUTC(const ALocalDateTime: TDateTime; var AUTC: TDateTime): Boolean; public property TimeZoneName: string read FTimeZoneName write FTimeZoneName; property Display: string read FDisplay write FDisplay; property Dlt: string read FDlt write FDlt; property Std: string read FStd write FStd; property TZI: PRegTZIInfo read FTZI write FTZI; end; {* 所有时区管理对象 *} TTimeZones = class private FTimeZoneKeyPath: string; FTimeZoneList: TStringList; FDefaultTimeZone: TTimeZone; procedure CollectTimeZone; procedure DestoryTimeZones; procedure CheckISDefaultTimeZone(ATimeZone: TTimeZone); public constructor Create; destructor Destroy; override; function FindTimeZone(const ADisplay: string): TTimeZone; public property TimeZoneList: TStringList read FTimeZoneList; property DefaultTimeZone: TTimeZone read FDefaultTimeZone; end; implementation { TTimeZones } procedure TTimeZones.CheckISDefaultTimeZone(ATimeZone: TTimeZone); var DefaultTimeZone: TTimeZoneInformation; begin GetTimeZoneInformation(DefaultTimeZone); if (ATimeZone.TZI.Bias = DefaultTimeZone.Bias) and (ATimeZone.Std = DefaultTimeZone.StandardName) then FDefaultTimeZone := ATimeZone; end; procedure TTimeZones.CollectTimeZone; var reg, tempReg: TRegistry; tempKeyPath: string; tempTimeZoneStrings: TStrings; iCir: Integer; tempTimeZone: TTimeZone; begin reg := TRegistry.Create; try reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey(FTimeZoneKeyPath, False); tempTimeZoneStrings := TStringList.Create; try reg.GetKeyNames(tempTimeZoneStrings); for iCir := 0 to tempTimeZoneStrings.Count - 1 do begin tempKeyPath := FTimeZoneKeyPath + '\' + tempTimeZoneStrings.Strings[iCir]; tempReg := TRegistry.Create; try tempReg.RootKey := HKEY_LOCAL_MACHINE; tempReg.OpenKey(tempKeyPath, False); tempTimeZone := TTimeZone.Create; tempTimeZone.TimeZoneName := tempTimeZoneStrings.Strings[iCir]; tempTimeZone.Display := tempReg.ReadString('Display'); tempTimeZone.Std := tempReg.ReadString('Std'); tempTimeZone.Dlt := tempReg.ReadString('Dlt'); tempReg.ReadBinaryData('TZI', tempTimeZone.TZI^, SizeOf(TRegTZIInfo)); FTimeZoneList.AddObject(tempTimeZone.Display, tempTimeZone); if FDefaultTimeZone = nil then CheckISDefaultTimeZone(tempTimeZone); finally tempReg.CloseKey; tempReg.Free; end; end; finally tempTimeZoneStrings.Free; end; finally reg.CloseKey; reg.Free; end; end; constructor TTimeZones.Create; begin FTimeZoneKeyPath := '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones'; FTimeZoneList := TStringList.Create; FTimeZoneList.Sorted := True; FDefaultTimeZone := nil; CollectTimeZone; end; procedure TTimeZones.DestoryTimeZones; var iCir: Integer; tempTimeZone: TTimeZone; begin for iCir := 0 to FTimeZoneList.Count - 1 do begin tempTimeZone := TTimeZone(FTimeZoneList.Objects[iCir]); tempTimeZone.Free; end; FTimeZoneList.Clear; FTimeZoneList.Free; end; destructor TTimeZones.Destroy; begin DestoryTimeZones(); inherited; end; function TTimeZones.FindTimeZone(const ADisplay: string): TTimeZone; var iIndex: Integer; begin Result := nil; FTimeZoneList.Sort; if FTimeZoneList.Find(ADisplay, iIndex) then begin Result := TTimeZone(FTimeZoneList.Objects[iIndex]); end; end; { TTimeZone } constructor TTimeZone.Create; begin FTZI := GetMemory(SizeOf(TRegTZIInfo)); FillMemory(FTZI, SizeOf(TRegTZIInfo), 0); end; destructor TTimeZone.Destroy; begin FreeMemory(FTZI); inherited; end; function TTimeZone.GetSelfTimeZoneInformation: TTimeZoneInformation; begin GetTimeZoneInformation(Result); Result.Bias := TZI^.Bias; Result.StandardBias := TZI^.StandardBias; Result.StandardDate := TZI^.StandardDate; Result.DaylightBias := TZI^.DaylightBias; Result.DaylightDate := TZI^.DaylightDate; end; function TTimeZone.LocalDateTimeToUTC(const ALocalDateTime: TDateTime; var AUTC: TDateTime): Boolean; var tempLocalToLocal: TDateTime; iMilliSecond: Int64; begin Result := UTCToLocalDateTime(ALocalDateTime, tempLocalToLocal); if Result then begin if tempLocalToLocal > ALocalDateTime then begin iMilliSecond := MilliSecondsBetween(tempLocalToLocal, ALocalDateTime); AUTC := IncMilliSecond(ALocalDateTime, iMilliSecond * -1); end else begin iMilliSecond := MilliSecondsBetween(ALocalDateTime, tempLocalToLocal); AUTC := IncMilliSecond(ALocalDateTime, iMilliSecond); end; Result := True; end; end; function TTimeZone.UTCToLocalDateTime(const AUTC: TDateTime; var ALocalDateTime: TDateTime): Boolean; var TimeZone: TTimeZoneInformation; stUTC, stLC: SYSTEMTIME; begin Result := False; TimeZone := GetSelfTimeZoneInformation; DateTimeToSystemTime(AUTC, stUTC); if SystemTimeToTzSpecificLocalTime(@TimeZone, stUTC, stLC) then begin ALocalDateTime := SystemTimeToDateTime(stLC); Result := True; end; end; end.

在Delphi中使用日期选择器用于数据库查询，用户搜索满足选定日期条件中的数据，使用日期选择器可很好的提高日期格式的准确性，避免数据库出错和查询不到数据的情况，本例的运行效果请参见测试截图。相关代码如下：　　procedure TForm1.Button1Click(Sender: TObject); 　　var mydate:tdatetime; 　　Begin 　　 ADOquery1.Close; 　　 ADOquery1.SQL.Clear; 　　 ADOquery1.SQL.Add('Select * From xsd where 录入日期 =:a'); 　　 ADOquery1.Parameters.ParamByName('a').Value :=FormatDateTime('yyyy-MM-dd',DateTimePicker1.Date); 　　 ADOquery1.Open; 　　end; 　　procedure TForm1.Button2Click(Sender: TObject); 　　begin 　　 close; 　　end;

13,825

社区成员

102,679

社区内容

发帖

与我相关

我的任务

社区管理员

加入社区

近7日
近30日
至今

加载中

查看更多榜单

社区公告

暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章