//根据万一的博客做了个桌面电子钟

//根据万一的博客做了个桌面电子钟

 

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.

posted @ 2013-12-20 13:07  delphichm  阅读(390)  评论(0编辑  收藏  举报