{
  Copyright (c) 1996 by Charlie Calvert
  Modifications by Florian Klaempfl

  Standard Windows API application written in Object Pascal.
  No VCL code included. This is all done on the Windows API
  level.
}

{$APPTYPE GUI}
{$MODE DELPHI}
program WinHello;

uses
  Strings, Windows,
  SysUtils, DateUtils;

const
  AppName  = 'TheClock';
  WM_SETUP = 500;

type
  RCoords = record
    x, y: integer;
  end;
  TArrowType = (
    atHour, atMinute, atSecond
  );


const
  CArrowLength : array [TArrowType] of Single = (

    0.70,
    0.85,
    0.95

  );
  CArrowAngles : array [TArrowType] of Single = (

    30.0,
     6.0,
     6.0

  );


var
  id_timer: integer;
  r : rect;
  draw: boolean;
  my_brush: HBrush;
  arrow_pen: array[TArrowType] of HPen;
  clear_pen: HPen;

  coords: array[tarrowtype] of RCoords;

  center: RCoords;


function GetRad(const angle: Single): Single;
begin result := angle * (Pi / 180) end;

function GetRadius(): integer;
begin
  result := (min((r.right - r.left), (r.bottom - r.top)) div 2) - 40;
end;
function GetArrowLength(p: tarrowtype): integer;
begin
  result := round(GetRadius() * CArrowLength[p]);
end;
function GetArrowCoords(p: tarrowtype): RCoords;
var
  time: Word;
begin

  case p of
    atHour   : time := HourOf(Now);
    atMinute : time := MinuteOf(Now);
    atSecond : time := SecondOf(Now);
  end;

  result.X := center.x +
              Round(GetArrowLength(p) * cos(GetRad(270 + time * CArrowAngles[p]))); {+some}
  result.Y := center.y +
              Round(GetArrowLength(p) * sin(GetRad(270 + time * CArrowAngles[p]))); {+some}

end;



function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
                    LParam: LPARAM): LRESULT; stdcall; export;

  var
     dc : hdc;
     ps : paintstruct;
     pens: tarrowtype;
     curr_pen: hpen;
     clearing: boolean;

     ang, _cx, _cy: word;
     draw_brush: hbrush;
     txt_r: rect;

begin
  WindowProc := 0;

  case AMessage of
    wm_create:
      begin
        id_timer := settimer(window, 0, 1000, nil);

        my_brush := createsolidbrush(rgb(0, 0, 0));

        clear_pen := createpen(0, 1, rgb(0, 0, 0));
        arrow_pen[atHour]   := CreatePen(0, 1, RGB(0, 255, 0));   // GREEN
        arrow_pen[atMinute] := CreatePen(0, 1, RGB(255, 0, 0));   // RED
        arrow_pen[atSecond] := CreatePen(0, 1, RGB(200, 200, 0)); // YELLOW

        exit;
      end;
    wm_size:
      begin

        if WParam = sizeiconic then draw := false
        else begin
          draw := true;
          postmessage(window, WM_SETUP, 0, 0);
        end;
        exit;

      end;
    wm_setup:
      begin
        dc := getdc(window);
        getclientrect(window, @r);
        fillrect(dc, r, my_brush);

        curr_pen := createpen(0, 1, rgb(255, 255, 255));
        selectobject(dc, curr_pen);

        center.X := (r.right - r.left) div 2;
        center.Y := (r.bottom - r.top) div 2;

        ang := 0;
        setbkcolor(dc, rgb(0, 0, 0));
        settextcolor(dc, rgb(255, 255, 255));
        while (ang < 360) do begin

          _cx := center.x + round(GetRadius() * sin(GetRad(ang)));
          _cy := center.y + round(GetRadius() * cos(GetRad(ang)));

          if ang mod 30 = 0 then begin

            draw_brush := createsolidbrush(rgb(255, 0, 0));
            // SetFillStyle(SolidFill, Red);
            selectobject(dc, draw_brush);
            Ellipse(dc, _cx - 6, _cy - 6, _cx + 6, _cy + 6);
            // FillEllipse(_cx, _cy, 6, 6);

            textout(
              dc,
              center.x + round((30 + GetRadius()) * sin(GetRad(180 - ang))),
              center.y + round((30 + GetRadius()) * cos(GetRad(180 - ang))),
              Pchar(IntToStr(ang div 30)), length(IntToStr(ang div 30))
            );
            (*
            OutTextXY(
            cx + round((30 + _radius) * SIN(GetRad(180 - ang))),
            cy + round((30 + _radius) * COS(GetRad(180 - ang))),
              IntToStr(ang div 30)
            )
            *)
            deleteobject(draw_brush);

          end
          else begin

            draw_brush := createsolidbrush(rgb(0, 0, 255));
            selectobject(dc, draw_brush);
            // SetFillStyle(SolidFill, Blue);
            Ellipse(dc, _cx - 2, _cy - 2, _cx + 2, _cy + 2);
            // FillEllipse(_cx, _cy, 2, 2);
            deleteobject(draw_brush);

          end;

          inc(ang, 6);
        end;
        deleteobject(curr_pen);
        releaseDC(window, dc);
        exit;
      end;

    wm_paint:
      begin
         dc:=BeginPaint(Window,@ps);
         (*
         GetClientRect(Window,@r);
         DrawText(dc,'Hello world by Free Pascal',-1,@r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         *)
         postmessage(window, WM_SETUP, 0, 0);
         EndPaint(Window,ps);
         Exit;
      end;

    wm_timer:
      begin

        if draw then begin

          dc := getdc(window);
          for clearing := true downto false do
            for pens := low(tarrowtype) to high(tarrowtype) do begin

              if not clearing then begin

                curr_pen := selectobject(dc, arrow_pen[pens]);
                coords[pens] := getarrowcoords(pens);

              end
              else
                curr_pen := selectobject(dc, clear_pen);

              with coords[pens] do begin

                MoveToEx(dc, center.X, center.Y, nil);
                LineTo(dc, X, Y);

                MoveToEx(dc, center.X - 5, Center.Y - 5, nil);
                LineTo(dc, X, Y);

                MoveToEx(dc, center.X + 5, Center.Y + 5, nil);
                LineTo(dc, X, Y);

              end;

            end;

        end;
        exit;

      end;

    wm_Destroy:
      begin

         for pens := low(tarrowtype) to high(tarrowtype) do
           deleteobject(arrow_pen[pens]);
         deleteobject(clear_pen);

         killtimer(window, id_timer);
         PostQuitMessage(0);
         Exit;
      end;
  end;

  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;

 { Register the Window Class }
function WinRegister: Boolean;
var
  WindowClass: WndClass;
begin
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := AppName;
  WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
  WindowClass.hInstance := system.MainInstance;
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := WndProc(@WindowProc);
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;

  Result := RegisterClass(WindowClass) <> 0;
end;

 { Create the Window Class }
function WinCreate: HWnd;
var
  hWindow: HWnd;
begin
  hWindow := CreateWindow(AppName, 'Simple Clock',
              ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
              cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);

  if hWindow <> 0 then begin

    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);

  end;

  Result := hWindow;
end;


var
  AMessage: Msg;
  hWindow: HWnd;

begin
  if not WinRegister then begin
    MessageBox(0, 'Register failed', nil, mb_Ok);
    Exit;
  end;
  hWindow := WinCreate;
  if longint(hWindow) = 0 then begin
    MessageBox(0, 'WinCreate failed', nil, mb_Ok);
    Exit;
  end;

  while GetMessage(@AMessage, 0, 0, 0) do begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end.