//根据万一的博客做了个桌面电子钟
//根据万一的博客做了个桌面电子钟
unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Winapi.msxml,
System.DateUtils,
Vcl.ExtCtrls;
//Psock,
//NMsmtp;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
//实时获取网络时间的函数, 得到的是格林威治时间; 默认从 sohu 服务器获取, 因为它最快, 平均只需 15 毫秒
function GetNetTime(aUrl: WideString = 'http://www.sohu.com'): string;
begin
with CoXMLHTTP.Create do
begin
open('Post', aUrl, False, EmptyParam, EmptyParam);
send(EmptyParam);
Result := getResponseHeader('Date');
end;
end;
//在真正实用中, 我把 GMT2BjDateTime 函数换成了:
function GMT2BjDateTime(const GMT: string): TDateTime;
var
A : TArray < string > ;
Y, M, D, H, N, S : Word;
begin
A := GMT.Split([',', ' ', ':'], ExcludeEmpty);
with TStringList.Create do
begin
CommaText :=
'Jan=1,Feb=2,Mar=3,Apr=4,May=5,Jun=6,Jul=7,Aug=8,Sep=9,Oct=10,Nov=11,Dec=12';
A[2] := Values[A[2]];
Free;
end;
Y := StrToIntDef(A[3], YearOf(Now));
M := StrToIntDef(A[2], MonthOf(Now));
D := StrToIntDef(A[1], DayOf(Now));
H := StrToIntDef(A[4], HourOf(Now));
N := StrToIntDef(A[5], MinuteOf(Now));
S := StrToIntDef(A[6], SecondOf(Now));
Result := EncodeDateTime(Y, M, D, H, N, S, 0);
Result := Result + 8 / 24; //换算成北京时间
end;
////格林威治时间(字符串)转换到北京时间
//function GMT2BjDateTime(const GMT: string): TDateTime;
//var
// A: TArray<string>;
//begin
// A := GMT.Split([',', ' '], ExcludeEmpty); //XE4 支持
//
// with TStringList.Create do begin
// CommaText := 'Jan=1,Feb=2,Mar=3,Apr=4,May=5,Jun=6,Jul=7,Aug=8,Sep=9,Oct=10,Nov=11,Dec=12';
// A[2] := Values[A[2]];
// Free;
// end;
//
// Result := StrToDateTime(Format('%s/%s/%s %s', [A[3], A[2], A[1], A[4]]), FormatSettings.Create(2052));
// Result := Result + 8/24; //换算成北京时间
//end;
//测试
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and not
WS_CAPTION);
Height := ClientHeight;
Width := ClientWidth;
end;
//移动无标题栏的窗口
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
strGMT : string;
bjDateTime : TDateTime;
begin
strGMT := GetNetTime();
bjDateTime := GMT2BjDateTime(strGMT);
//ShowMessageFmt('%s'#13#10'%s', [strGMT, DateTimeToStr(bjDateTime)]);
Label1.Caption := '北京时间:' + DateTimeToStr(bjDateTime);
//Caption := '北京时间 : ' + DateTimeToStr(bjDateTime);
// form1.Height:=0;
// form1.Repaint;
form1.Width := Label1.Width + 20;
Form1.FormStyle := fsStayOnTOp;
end;
end.