unit Delphi;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms, DateUtils,
  Registry, ActiveX, SHDocVw, MSHTML, ShellAPI, WinInet, IdHTTP, Math;

type
   TCalendarOrient = (Horz, Vert);
   TDUMMYUNIONNAME = record
   case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT);
   end;
   TNotifyIconDataNew = record
      cbSize: DWORD;
      Wnd: HWND;
      uID: UINT;
      uFlags: UINT;
      uCallbackMessage: UINT;
      hIcon: HICON;
      szTip: array[0..127] of Char;
      dwState: DWORD;
      dwStateMask: DWORD;
      szInfo: array[0..255] of Char;
      DUMMYUNIONNAME: TDUMMYUNIONNAME;
      szInfoTitle: array[0..63] of Char;
      dwInfoFlags: DWORD;
   end;

procedure Calendar(Canvas: TCanvas; Left, Top, dx, dy, MonthLeft, Year, Month,
   FontSize: integer; BrushColor, FontColor: array of TColor; D31,
   YearVis: boolean; Orient: TCalendarOrient; Now: TDateTime; Rest: string;
   Festive, Shortened, AddRest, AddWork: array of byte; Move: byte = 0;
   Short: byte = 0);
function CreateDirNew(Dir: string): boolean;
function Easter(Year: word): TDateTime;
function FileCopy(OldFile, NewFile: string): boolean;
procedure FileSystem(Dir, FileName: string; var sl: TStringList);
function FormatSecond(Sec: real): string;
procedure IconTreeChange(Form: TForm; Icon: TIcon; ID: integer; Hint: string);
procedure IconTreeCreate(Form: TForm; Icon: TIcon; ID: integer; Hint: string);
procedure IconTreeDestroy(Form: TForm; ID: integer);
function IconTreeHint(s: string): string;
procedure IconTreeMessage(Form: TForm; Icon: TIcon; ID: integer; ImagePicture: DWORD; Caption, Text: string);
function Points(a, b: real; a0, b0, c0, r: integer; var x, y: integer): boolean;
function Random1(Range: integer): integer;
function Random2(Range: integer): integer;
function Random3: extended;
function Random4: extended;
procedure Randomize1;
function slLoadFromFile(var sl: TStringList; f: string): boolean;
function slSaveToFile(var sl: TStringList; f: string): boolean;
procedure Sphere(Canvas: TCanvas; a0, b0, c0, r, x0, y0: integer);
function TimeZone: real;
function URLDownLoad1(URL, f: string): boolean;
function URLDownLoad2(URL, f: string): boolean;
procedure WebBrowserAbout1(var WebBrowser: TWebBrowser);
procedure WebBrowserAbout2(var WebBrowser: TWebBrowser);
procedure WebBrowserText1(var WebBrowser: TWebBrowser; HTMLText: string);
procedure WebBrowserText2(var WebBrowser: TWebBrowser; HTMLText: string);
function WeekOfTheYearNew(DateTime: TDateTime): word;
function WinComputerName: string;
function WinInfo: string;
function WinUserName: string;

const
   MonthArr: array[1..12] of string = ('Январь', 'Февраль', 'Март', 'Апрель',
      'Май', 'Июнь', 'Июль', 'Август', 'Сентябрь', 'Октябрь', 'Ноябрь', 'Декабрь');
   WeekDayArr: array[1..7] of string = ('Пн', 'Вт', 'Ср', 'Чт', 'Пт', 'Сб', 'Вс');

implementation

procedure Calendar(Canvas: TCanvas; Left, Top, dx, dy, MonthLeft, Year, Month,
   FontSize: integer; BrushColor, FontColor: array of TColor; D31,
   YearVis: boolean; Orient: TCalendarOrient; Now: TDateTime; Rest: string;
   Festive, Shortened, AddRest, AddWork: array of byte; Move, Short: byte);
var x1, x2, y1, y2, PosX, PosY: integer;
    i, dw, r: byte;
    s: string;
    DT: TDateTime;
    BC, FC: TColor;

   procedure Bounds(s: string; var Width, Height: integer);
   var R: TRect;
   begin
      R:=Rect(0, 0, 0, 0);
      DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_EXPANDTABS or DT_CALCRECT);
      Width:=R.Right-R.Left;
      Height:=R.Bottom-R.Top;
   end;

   procedure CanvasTextOut(x, y: integer; s: string; CenterX: boolean = true);
   var Width, Height, d: integer;
   begin
      Bounds(s, Width, Height);
      d:=(dx-Width) div 2;
      if d<1 then
         d:=1;
      if CenterX then
         x:=x+d;
      d:=(dy-Height) div 2;
      if d<1 then
         d:=1;
      y:=y+d;
      Canvas.TextOut(x, y, s);
   end;

   function ColorRead(Color: array of TColor; n: byte; Color0: TColor): TColor;
   begin
      Result:=Color0;
      if n<=High(Color) then
         Result:=Color[n];
   end;

   function StrDiv(var s: string; c: char): string;
   var p: integer;
   begin
      p:=Pos(c, s);
      if p>0 then
      begin
         Result:=Copy(s, 1, p-1);
         Delete(s, 1, p);
      end else
      begin
         Result:=s;
         s:='';
      end;
   end;

   function RestDay: boolean;
   var i: integer;
       s, s1, s2: string;
       arr: array[1..7] of boolean;
   begin
      for i:=Low(arr) to High(arr) do
         arr[i]:=i>=6; // сб и вс - выходные дни
      s:=Rest;
      while s<>'' do
      begin
         s1:=StrDiv(s, '|'); //36526:3,6,7
         s2:=StrDiv(s1, ':'); //36526 (s1 = 3,6,7)
         i:=StrToInt(s2);
         if i<=DT then
         begin
            for i:=Low(arr) to High(arr) do
               arr[i]:=false;
            while s1<>'' do
            begin
               s2:=StrDiv(s1, ','); //3 (s1 = 6,7)
               i:=StrToInt(s2);
               if (i>=Low(arr)) and (i<=High(arr)) then
                  arr[i]:=true;
            end;
         end;
      end;
      Result:=arr[dw];
   end;

   function Affiliation(n: byte; p: array of byte): boolean;
   var i: integer;
   begin
      Result:=false;
      for i:=Low(p) to High(p) do
         if n=p[i] then
         begin
            Result:=true;
            Exit;
         end;
   end;

begin
   with Canvas do
   begin
      Inc(Left);
      Inc(Top);
      if FontSize<8 then
         FontSize:=8;
      Font.Size:=FontSize;
      Bounds('Пн', x1, y1);
      y1:=y1+3;
      if dx<x1 then
         dx:=x1;
      if dy<y1 then
         dy:=y1;
      if dx<dy+2 then
         dx:=dy+2;
      Pen.Width:=1;
      Pen.Color:=clWhite;
      Brush.Color:=clWhite;
      Rectangle(Left-1, Top-1, Left+8*dx+2, Top+8*dy+2);
      { рисование чисел }
      PosX:=1; // для Vert
      PosY:=2; // для Horz
      for i:=1 to 31 do
      begin
         if not TryEncodeDate(Year, Month, i, DT) then
            Break;
         dw:=DayOfWeek(DT);
         Dec(dw);
         if dw=0 then
            dw:=7;
         if (dw=1) and (i>1) then
         begin
            Inc(PosX);
            Inc(PosY);
         end;
         if (PosX=6) and D31 { перенести "31" в первый (левый) ряд } then
            PosX:=1;
         if (PosY=7) and D31 { перенести "31" в первый (верхний) ряд } then
            PosY:=2;
         BC:=ColorRead(BrushColor, 2, clWhite);
         FC:=ColorRead(FontColor, 2, clBlack);
         if RestDay then
         begin
            BC:=ColorRead(BrushColor, 4, $FF66FF);
            FC:=ColorRead(FontColor, 4, clBlack);
         end;
         if Affiliation(i, AddWork) then
         begin
            BC:=ColorRead(BrushColor, 2, clWhite);
            FC:=ColorRead(FontColor, 2, clBlack);
         end;
         if Affiliation(i, AddRest) then
         begin
            BC:=ColorRead(BrushColor, 4, $FF66FF);
            FC:=ColorRead(FontColor, 4, clBlack);
         end;
         if Trunc(DT)=Trunc(Now) then
         begin
            BC:=ColorRead(BrushColor, 3, clLime);
            FC:=ColorRead(FontColor, 3, clBlack);
         end;
         if Affiliation(i, Festive) then
         begin
            BC:=ColorRead(BrushColor, 5, clRed);
            FC:=ColorRead(FontColor, 5, clBlack);
         end;
         if i=Move then
         begin
            BC:=ColorRead(BrushColor, 6, clYellow);
            FC:=ColorRead(FontColor, 6, clBlack);
         end;
         Pen.Color:=BC;
         Brush.Color:=BC;
         x1:=Left+(dw-1)*dx;
         y1:=Top+PosY*dy;
         x2:=Left+dw*dx;
         y2:=Top+(PosY+1)*dy;
         if Orient=Vert then
         begin
            x1:=Left+PosX*dx;
            y1:=Top+dw*dy;
            x2:=Left+(PosX+1)*dx;
            y2:=Top+(dw+1)*dy;
         end;
         Rectangle(x1, y1, x2+1, y2+1);
         if Affiliation(i, Shortened) then
         begin
            BC:=ColorRead(BrushColor, 7, $FF66FF);
            FC:=ColorRead(FontColor, 7, clBlack);
            Pen.Color:=BC;
            Brush.Color:=BC;
            case Short of
            0: // треугольник
            begin
               r:=dx div 3;
               Polygon([Point(x2-r, y1), Point(x2, y1), Point(x2, y1+r)]);
            end;
            1: // кружок
            begin
               r:=dx div 8;
               x2:=x2-r-1;
               y2:=y1+r+2;
               Ellipse(x2-r, y2-r, x2+r, y2+r);
            end;
            end;
         end;
         Font.Color:=FC;
         Brush.Style:=bsClear;
         CanvasTextOut(x1, y1+1, IntToStr(i));
      end;
      { границы календаря }
      Inc(PosX);
      if D31 then
         PosX:=6;
      if Orient=Horz then
         PosX:=7;
      Inc(PosY);
      if D31 then
         PosY:=7;
      if Orient=Vert then
         PosY:=8;
      Pen.Color:=1;
      Pen.Width:=2;
      x2:=Left+PosX*dx+1;
      y2:=Top+PosY*dy+1;
      MoveTo(Left, Top);
      LineTo(x2, Top);
      LineTo(x2, y2);
      LineTo(Left, y2);
      LineTo(Left, Top-1);
      { названия дней недели }
      Brush.Color:=ColorRead(BrushColor, 1, clYellow);
      Font.Color:=ColorRead(FontColor, 1, clBlack);
      x2:=PosX*dx;
      y2:=2*dy;
      if Orient=Vert then
      begin
         x2:=dx;
         y2:=PosY*dy+1;
      end;
      Rectangle(Left, Top+dy, Left+x2+2, Top+y2+1);
      for i:=0 to 6 do
      begin
         x1:=Left+i*dx;
         y1:=Top+dy;
         if Orient=Vert then
         begin
            x1:=Left;
            y1:=Top+(i+1)*dy+1;
         end;
         CanvasTextOut(x1, y1, WeekDayArr[i+1]);
      end;
      { название месяца (и года) }
      Brush.Color:=ColorRead(BrushColor, 0, clWhite);
      Font.Color:=ColorRead(FontColor, 0, clBlack);
      Rectangle(Left, Top, Left+PosX*dx+2, Top+dy+1);
      s:='';
      if (Month>=1) and (Month<=12) then
         s:=MonthArr[Month];
      if YearVis then
         s:=Format('%s - %d год', [s, Year]);
      CanvasTextOut(Left+MonthLeft, Top, s, false);
      { сетка }
      Pen.Width:=1;
      x1:=1;
      x2:=6;
      y1:=3;
      y2:=PosY-1;
      if Orient=Vert then
      begin
         x1:=2;
         x2:=PosX-1;
         y1:=2;
         y2:=7;
      end;
      for i:=x1 to x2 do
      begin
         MoveTo(Left+i*dx, Top+dy);
         LineTo(Left+i*dx, Top+PosY*dy);
      end;
      for i:=y1 to y2 do
      begin
         MoveTo(Left, Top+i*dy);
         LineTo(Left+PosX*dx, Top+i*dy);
      end;
   end;
end;

function CreateDirNew(Dir: string): boolean;
var i: integer;
begin
   for i:=1 to Length(Dir) do
      if Dir[i]=PathDelim then
         CreateDir(Copy(Dir, 1, i-1));
   Result:=CreateDir(Dir);
end;

function Easter(Year: word): TDateTime;
var a, b, c: integer;
begin
   a:=Year mod 19;
   b:=Year mod 4;
   c:=Year mod 7;
   a:=(19*a + 15) mod 30;
   b:=(2*b + 4*c + 6*a + 6) mod 7;
   a:=a+b;
   b:=-2 + Year div 100 - Year div 400;
   if TryEncodeDate(Year, 3, 22, Result) then
      Result:=Result+a+b else
      Result:=0;
end;

function FileCopy(OldFile, NewFile: string): boolean;
const MaxBufSize = $F000;
var H1, H2, Count: integer;
    Buffer: pChar;
begin
   Result:=false;
   H1:=FileOpen(OldFile, fmShareDenyNone);
   if H1<0 then
      Exit;
   H2:=FileCreate(NewFile);
   if H2<0 then
   begin
      FileClose(H1);
      Exit;
   end;
   Result:=true;
   { Процесс копирования }
   FileSeek(H1, 0, 0);
   GetMem(Buffer, MaxBufSize);
   try
   repeat
      Count:=FileRead(H1, Buffer^, MaxBufSize);
      if Count>0 then
         FileWrite(H2, Buffer^, Count);
   until Count<=0;
   finally
      FreeMem(Buffer, MaxBufSize);
      FileClose(H1);
      FileClose(H2);
   end;
   { Копирование атрибутов (свойств) файла }
   if FileExists(NewFile) then
   begin
      H1:=FileAge(OldFile);
      FileSetDate(NewFile, H1);
      H1:=FileGetAttr(OldFile);
      FileSetAttr(NewFile, H1);
   end;
end;

procedure FileSystem(Dir, FileName: string; var sl: TStringList);
var F: TSearchRec;
    s: string;

   function Directory(Attr: integer): boolean;
   begin
      Result:=Attr and faDirectory = faDirectory;
   end;

begin
   ChDir(Dir);
   if IOResult<>0 then
      Exit;
   if Dir[Length(Dir)]<>'\' then
      Dir:=Dir+'\';
   if FindFirst(FileName, faAnyFile, F)=0 then
   repeat
      if not Directory(F.Attr) then
      begin
         s:=FormatDateTime('dd.mm.yyyy hh:nn:ss', FileDateToDateTime(F.Time));
         sl.Add(Format('%s%s: размер - %d, дата изменения - %s',
            [Dir, F.Name, F.Size, s]));
      end;
   until FindNext(F)<>0;
   if FindFirst('*', faAnyFile, F)=0 then
   repeat
      if Directory(F.Attr) then
         if not (F.Name='.') and not (F.Name='..') then
         begin
            FileSystem(Dir+F.Name, FileName, sl);
            ChDir(Dir);
         end;
   until FindNext(F)<>0;
   FindClose(F);
end;

function FormatSecond(Sec: real): string;
var d, ch, min, s, ms: integer;
begin
   ms:=Trunc(Frac(Sec)*1000);
   Sec:=Trunc(Sec);
   s:=Trunc(Sec) mod 60;
   Sec:=Trunc(Sec/60);
   min:=Trunc(Sec) mod 60;
   Sec:=Trunc(Sec/60);
   ch:=Trunc(Sec) mod 24;
   Sec:=Trunc(Sec/24);
   d:=Trunc(Sec);
   Result:='';
   if d>0 then
      Result:=Format('%d дн. ', [d]);
   Result:=Format('%s%d:%.2d:%.2d', [Result, ch, min, s]);
   if ms>0 then
      Result:=Format('%s,%.3d', [Result, ms]);
end;

procedure IconTreeChange(Form: TForm; Icon: TIcon; ID: integer; Hint: string);
var NID: TNotifyIconDataNew;
begin
   Hint:=IconTreeHint(Hint);
   with NID do
   begin
      cbSize:=SizeOf(NID);
      Wnd:=Form.Handle;
      uID:=ID;
      uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
      uCallBackMessage:=WM_USER;
      hIcon:=Icon.Handle;
      StrPCopy(szTip, Hint);
   end;
   Shell_NotifyIcon(NIM_MODIFY, @NID);
end;

procedure IconTreeCreate(Form: TForm; Icon: TIcon; ID: integer; Hint: string);
var NID: TNotifyIconDataNew;
begin
   Hint:=IconTreeHint(Hint);
   with NID do
   begin
      cbSize:=SizeOf(NID);
      Wnd:=Form.Handle;
      uID:=ID;
      uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
      uCallBackMessage:=WM_USER;
      hIcon:=Icon.Handle;
      StrPCopy(szTip, Hint);
   end;
   Shell_NotifyIcon(NIM_ADD, @NID);
end;

procedure IconTreeDestroy(Form: TForm; ID: integer);
var NID: TNotifyIconDataNew;
begin
   with NID do
   begin
      cbSize:=SizeOf(NID);
      Wnd:=Form.Handle;
      uID:=ID;
   end;
   Shell_NotifyIcon(NIM_DELETE, @NID);
end;

function IconTreeHint(s: string): string;
begin
   if Length(s)>63 then
      s:=Copy(s, 1, 60)+'...';
   Result:=s;
end;

procedure IconTreeMessage(Form: TForm; Icon: TIcon; ID: integer; ImagePicture: DWORD; Caption, Text: string);
var NID: TNotifyIconDataNew;
begin
   Caption:=IconTreeHint(Caption);
   with NID do
   begin
      cbSize:=SizeOf(NID);
      Wnd:=Form.Handle;
      uID:=ID;
      uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP or $10;
      uCallBackMessage:=WM_USER;
      hIcon:=Icon.Handle;
      StrPCopy(szInfo, Text);
      StrPCopy(szInfoTitle, Caption);
      dwInfoFlags:=ImagePicture;
   end;
   Shell_NotifyIcon(NIM_ADD, @NID);
   Shell_NotifyIcon(NIM_MODIFY, @NID);
end;

function Points(a, b: real; a0, b0, c0, r: integer; var x, y: integer): boolean;
const da = 90;
var a1, a2, b1, r0, corn, xr, yr: real;

   function Degree(a, a0: real): real;
   var d: integer;

      procedure da;
      begin
         d:=0;
         if a<a0 then
            d:=360;
         if a>=360+a0 then
            d:=-360;
      end;

   begin
      da;
      while d<>0 do
      begin
         a:=a+d;
         da;
      end;
      Result:=a;
   end;

   function b90(b0: integer): integer;
   begin
      if b0>90 then
         b0:=180-b0;
      if b0<-90 then
         b0:=-180-b0;
      Result:=b0;
   end;

begin
   b0:=Round(Degree(b0, -180));
   if Abs(b0)<=90 then
      a:=Degree(a+da-a0, -90) else
      a:=Degree(a+da-a0, 90);
   b:=Degree(b, -180);
   c0:=Round(Degree(c0, -180));
   Result:=true;
   if (b<=b90(b0)-90) or (b>=b90(b0)+90) then
      Result:=false;
   b1:=90-Abs(b0);
   if Abs(b)<Abs(b1) then
   begin
      if b90(b0)=0 then
         b1:=0 else
         b1:=Power(Abs(b/b1), 1+Abs(b/b90(b0)))*90;
      if b<0 then
         b1:=-b1;
      if b0<0 then
         b1:=-b1;
      a1:=-b1;
      a2:=180+b1;
      if Abs(b0)>90 then
      begin
         a1:=a1+180;
         a2:=a2+180;
      end;
      if (a<a1) or (a>a2) then
         Result:=false;
   end;
   r0:=r*Cos(b*pi/180);
   xr:=r0*Cos(a*pi/180);
   yr:=-r0*Sin(a*pi/180)*Sin(b0*pi/180)+r*Sin(b*pi/180)*Cos(b0*pi/180);
   corn:=ArcTan(yr/xr)*180/pi;
   if xr<0 then
      corn:=corn+180;
   corn:=corn-c0;
   r0:=Sqrt(xr*xr+yr*yr);
   xr:=r0*Cos(corn*pi/180);
   yr:=r0*Sin(corn*pi/180);
   x:=Round(xr);
   y:=-Round(yr);
end;

function Random1(Range: integer): integer;
var z: int64;
begin
   RandSeed:=RandSeed*$8088405 + 1;
   z:=RandSeed;
   if z<0 then
      z:=z+$100000000;
   z:=z*Range;
   Result:=z div $100000000;
end;

function Random2(Range: integer): integer;
asm
   MOV EAX, Range
   IMUL EDX, RandSeed, $8088405
   INC EDX
   MOV RandSeed, EDX
   MUL EDX
   MOV Result, EDX
end;

function Random3: extended;
const two2neg32 = 1/$100000000; // 2^-32
var z: int64;
begin
   RandSeed:=RandSeed*$8088405 + 1;
   z:=RandSeed;
   if z<0 then
      z:=z+$100000000;
   Result:=z*two2neg32;
end;

function Random4: extended;
const two2neg32: double = 1/$100000000; // 2^-32
asm
   IMUL EDX, RandSeed, $8088405
   INC EDX
   MOV RandSeed, EDX
   FLD QWORD PTR two2neg32
   PUSH $0
   PUSH EDX
   FILD QWORD PTR [ESP]
   ADD ESP, $4
   POP EDX
   FMULP
   FSTP TBYTE PTR Result
end;

procedure Randomize1;
var SystemTime: TSystemTime;
begin
   GetSystemTime(SystemTime);
   with SystemTime do
      RandSeed:=((wHour*60 + wMinute)*60 + wSecond)*1000 + wMilliseconds;
end;

function slLoadFromFile(var sl: TStringList; f: string): boolean;
const MaxBufSize = $F000;
var H, Count: integer;
    Buffer: PAnsiChar;
    Text: AnsiString;
begin
   Result:=false;
   sl.Clear;
   H:=FileOpen(f, fmShareDenyNone);
   if H<0 then
      Exit;
   Result:=true;
   Text:='';
   FileSeek(H, 0, 0);
   GetMem(Buffer, MaxBufSize);
   repeat
      Count:=FileRead(H, Buffer^, MaxBufSize);
      if Count>0 then
         Text:=Text+Copy(Buffer, 1, Count);
   until Count<=0;
   FreeMem(Buffer, MaxBufSize);
   FileClose(H);
   sl.Text:=String(Text);
end;

function slSaveToFile(var sl: TStringList; f: string): boolean;
const MaxBufSize = $F000;
var H, Count: integer;
    Buffer: PAnsiChar;
    Text: AnsiString;
begin
   Result:=false;
   H:=FileCreate(f);
   if H<0 then
      Exit;
   Result:=true;
   Text:=AnsiString(sl.Text);
   FileSeek(H, 0, 0);
   repeat
      Buffer:=PAnsiChar(Copy(Text, 1, MaxBufSize));
      Count:=Length(Buffer);
      if Count>0 then
      begin
         FileWrite(H, Buffer^, Count);
         Text:=Copy(Text, Count+1, Length(Text));
      end;
   until Count<=0;
   FileClose(H);
end;

procedure Sphere(Canvas: TCanvas; a0, b0, c0, r, x0, y0: integer);
var a, b, x, y: integer;
    vis, visp: boolean;
begin
   Canvas.Ellipse(x0-r, y0-r, x0+r+1, y0+r+1);
   for b:=-90 to 90 do
   begin
      if b mod 10 <> 0 then
         Continue;
      if b=0 then
         Canvas.Pen.Width:=2 else
         Canvas.Pen.Width:=1;
      vis:=false;
      for a:=0 to 360 do
      begin
         visp:=Points(a, b, a0, b0, c0, r, x, y);
         if visp then
            if not vis then
            begin
               vis:=true;
               Canvas.MoveTo(x0+x, y0+y);
            end else
               Canvas.LineTo(x0+x, y0+y) else
               vis:=false;
      end;
   end;
   for a:=0 to 360 do
   begin
      if a mod 15 <> 0 then
         Continue;
      if a=0 then
         Canvas.Pen.Width:=2 else
         Canvas.Pen.Width:=1;
      vis:=false;
      for b:=-90 to 90 do
      begin
         visp:=Points(a, b, a0, b0, c0, r, x, y);
         if visp then
            if not vis then
            begin
               vis:=true;
               Canvas.MoveTo(x0+x, y0+y);
            end else
               Canvas.LineTo(x0+x, y0+y) else
               vis:=false;
      end;
   end;
end;

function TimeZone: real;
var lp: TTimeZoneInformation;
begin
   GetTimeZoneInformation(lp);
   Result:=-lp.Bias/60;
end;

function URLDownLoad1(URL, f: string): boolean;
const MaxBuffer = $10000;
var H1, H2: pointer;
    H3: integer;
    Buffer: array[1..MaxBuffer] of char;
    Count: cardinal;
begin
   Result:=true;
   H1:=InternetOpen('', 0, nil, nil, 0);
   try
   H2:=InternetOpenURL(H1, PChar(URL), nil, 0, 0, 0);
   if H2=nil then
   begin
      Result:=false;
      InternetCloseHandle(H1);
      Exit;
   end;
   try
   H3:=FileCreate(f);
   if H3<0 then
   begin
      Result:=false;
      InternetCloseHandle(H1);
      Exit;
   end;
   Count:=0;
   try
   repeat
      InternetReadFile(H2, @Buffer, SizeOf(Buffer), Count);
      Count:=FileWrite(H3, Buffer, Count);
   until Count<=0;
   finally
      FileClose(H3);
   end;
   finally
      InternetCloseHandle(H2);
   end;
   finally
      InternetCloseHandle(H1);
   end;
end;

function URLDownLoad2(URL, f: string): boolean;
const MaxBuffer = $10000;
var Stream: TMemoryStream;
    idHTTP1: TIdHTTP;
    H3: integer;
    Count: cardinal;
    Buffer: array[1..MaxBuffer] of char;
begin
   Result:=true;
   Stream:=TMemoryStream.Create;
   idHTTP1:=TIdHTTP.Create(Application);
   try
   idHTTP1.Get(URL, Stream);
   except
      Result:=false;
      Stream.Free;
      idHTTP1.Free;
      Exit;
   end;
   H3:=FileCreate(f);
   if H3<0 then
   begin
      Result:=false;
      Stream.Free;
      idHTTP1.Free;
      Exit;
   end;
   FileSeek(H3, 0, 0);
   Stream.Seek(0, 0);
   repeat
      Count:=Stream.Read(Buffer, MaxBuffer);
      if Count>0 then
         FileWrite(H3, Buffer, Count);
   until Count<=0;
   FileClose(H3);
   Stream.Free;
   idHTTP1.Free;
end;

procedure WebBrowserAbout1(var WebBrowser: TWebBrowser);
var OLEHtmlText: OLEVariant;
begin
   OLEHtmlText:='about:';
   WebBrowser.Navigate2(OLEHtmlText);
end;

procedure WebBrowserAbout2(var WebBrowser: TWebBrowser);
begin
   WebBrowser.Navigate('about:');
end;

procedure WebBrowserText1(var WebBrowser: TWebBrowser; HTMLText: string);
var sl: TStringList;
    ms: TStream;
begin
   if Assigned(WebBrowser.Document) then
   begin
      sl:=TStringList.Create;
      ms:=TMemoryStream.Create;
      sl.Text:=HTMLText;
      sl.SaveToStream(ms);
      ms.Seek(0, 0);
      (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
      FreeAndNil(ms);
      FreeAndNil(sl);
   end;
end;

procedure WebBrowserText2(var WebBrowser: TWebBrowser; HTMLText: string);
var Document: IHTMLDocument2;
    V: OleVariant;
begin
   Document:=WebBrowser.Document as IHtmlDocument2;
   V:=VarArrayCreate([0, 0], varVariant);
   V[0]:=HTMLText;
   Document.write(PSafeArray(TVarData(V).VArray));
   Document.close;
end;

function WeekOfTheYearNew(DateTime: TDateTime): word;
var Year, Month, Day, Week: word;
    Date0: TDateTime;
begin
   DecodeDate(DateTime, Year, Month, Day);
   Date0:=EncodeDate(Year, 1, 1);
   Week:=DayOfTheWeek(Date0);
   Date0:=Date0-Week+1;
   Week:=Trunc(DateTime-Date0);
   Result:=Week div 7+1;
end;

function WinComputerName: string;
var i: cardinal;
begin
   SetLength(Result, 16);
   GetComputerName(PChar(Result), i);
   SetLength(Result, i);
   while (Result<>'') and (Result[Length(Result)]=#0) do
      Delete(Result, Length(Result), 1);
end;

function WinInfo: string;
var Registry: TRegistry;
    rd: TRegDataType;
    Key_Open, Key_Read: string;
begin
   Key_Open:='Software\Microsoft\Windows\CurrentVersion';
   if (GetVersion and $80000000)=0 then
      Key_Open:='Software\Microsoft\Windows NT\CurrentVersion';
   Key_Read:='ProductName';
   Registry:=TRegistry.Create;
   try
   Registry.RootKey:=HKEY_LOCAL_MACHINE;
   Registry.OpenKey(Key_Open, false);
   rd:=Registry.GetDataType(Key_Read);
   if (rd=rdString) or (rd=rdExpandString) then
      Result:=Registry.ReadString(Key_Read) else
      Result:='';
   finally
      Registry.Free;
   end;
end;

function WinUserName: string;
var i: cardinal;
begin
   SetLength(Result, 255);
   GetUserName(PChar(Result), i);
   SetLength(Result, i);
   while (Result<>'') and (Result[Length(Result)]=#0) do
      Delete(Result, Length(Result), 1);
end;

end.