unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    Beenden1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
  private
    { Private-Deklarationen }
      dt: TSystemTime;
      WinRGN: HRGN;
      procedure CreateRegions;
      procedure DrawBinTime;
  public
    { Public-Deklarationen }
    procedure CreateParams(var Params: TCreateParams); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  Radius = 5;
  XYStep = (Radius * 2) + 2;
  Digits = 6;

  SetToDesktop = TRUE;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  if SetToDesktop then
  begin
    Params.Style := WS_POPUP;
    Params.ExStyle := WS_EX_NOACTIVATE;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  ShowHint := TRUE;

  Width := Digits * XYStep;
  Height := 3 * XYStep;

  Top := 10;
  Left := Screen.Width - Width - 10;

  WinRGN := CreateRectRGN(0, 0, 0, 0);

  CreateRegions;

  GetSystemTime(dt);

  SetWindowRgn(Handle, WinRGN, TRUE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DeleteObject(WinRGN);
  
  Action := caFree;
end;

procedure TForm1.CreateRegions;
var
  i, n, x , y: Integer;
  RGN : HRGN;
begin
  y := Radius;
  for n := 1 to 3 do
  begin
    x := clientwidth - Radius;
    for i := Digits downto 1 do
    begin
      RGN := CreateEllipticRgn(x - Radius,
                               y - Radius,
                               x + Radius + 1,
                               y + Radius + 1);
      CombineRgn(WinRgn, RGN, WinRgn, RGN_OR);
      DeleteObject(RGN);
      dec(x, XYStep);
    end;
    inc(y, XYStep);
  end;
end;

function IntToBin(Int, Digits: Integer): String;
var
  i : Integer;
begin
  Result := '';
  for i := Digits - 1 downto 0 do
    Result := Result + IntToStr((Int shr i) and 1);
end;

procedure TForm1.DrawBinTime;
var
  i, n, x , y: Integer;
  s: string;
begin
  y := Radius;
  for n := 1 to 3 do
  begin
    case n of
      1: s := IntToBin(dt.wHour, Digits);
      2: s := IntToBin(dt.wMinute, Digits);
      3: s := IntToBin(dt.wSecond, Digits);
    end;

    x := clientwidth - Radius;
    for i := length(s) downto 1 do
    begin
      if s[i] <> '0' then
      begin
        Canvas.Pen.Color := RGB(128, 0, 0);
        Canvas.Brush.Color := RGB(255, 0, 0);
      end else
      begin
        Canvas.Brush.Color := RGB(64, 0, 0);
        Canvas.Pen.Color := RGB(32, 0, 0);
      end;

      Canvas.Ellipse(x - Radius, y - Radius, x + Radius, y + Radius);

      dec(x, XYStep);
    end;
    inc(y, XYStep);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
  // inlinefunction
  function ItS(V: integer): String; begin str(V:2, Result); end;
  //
begin
  GetLocalTime(dt);
  Hint := ItS(dt.wHour) + ':' + ItS(dt.wMinute) + ':' + ItS(dt.wSecond);

  DrawBinTime;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawBinTime;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if SetToDesktop then
  begin
    ShowWindow(Application.Handle, SW_Hide);
    SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);

    Windows.SetParent(Handle, GetDesktopWindow);
    SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  end else
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
  Close;
end;

end.