Author Topic: Power basic - Analog Clock  (Read 179 times)

Aurel

  • Regular Member
  • Sr. Member
  • *
  • Posts: 272
    • View Profile
Power basic - Analog Clock
« on: 27. April 2017, 18:47:31 »
Yes .. Power Basic  :D
Jose Roca site have many great programs and examples.
and here is one of them:
Code: [Select]

     ' ========================================================================================
' CLOCK.BAS
' This program is a translation/adaptation of CLOCK.C -- Analog Clock Program Charles Petzold,
' 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.
' An analog clock program needn't concern itself with internationalization, but the
' complexity of the graphics more than make up for that simplification. To get it right,
' you'll need to know some trigonometry.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"

%ID_TIMER = 1

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                  BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG

   LOCAL hwnd      AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX
   LOCAL szCaption AS ASCIIZ * 256

   szAppName          = "Clock"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
   wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szAppName)

   IF ISFALSE RegisterClassEx(wcex) THEN
      FUNCTION = %TRUE
      EXIT FUNCTION
   END IF

   szCaption = "Analog Clock"
   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         szCaption, _              ' window caption
                         %WS_OVERLAPPEDWINDOW, _   ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         %CW_USEDEFAULT, _         ' initial x size
                         %CW_USEDEFAULT, _         ' initial y size
                         %NULL, _                  ' parent window handle
                         %NULL, _                  ' window menu handle
                         hInstance, _              ' program instance handle
                         BYVAL %NULL)              ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
SUB SetIsotropic (BYVAL hdc AS DWORD, BYVAL cxClient AS LONG, BYVAL cyClient AS LONG)

   SetMapMode hdc, %MM_ISOTROPIC
   SetWindowExtEx hdc, 1000, 1000, BYVAL %NULL
   SetViewportExtEx hdc, cxClient / 2, -cyClient / 2, BYVAL %NULL
   SetViewportOrgEx hdc, cxClient / 2,  cyClient / 2, BYVAL %NULL

END SUB
' ========================================================================================

' ========================================================================================
SUB RotatePoint (pt() AS POINT, BYVAL iNum AS LONG, BYVAL iAngle AS LONG)

   LOCAL i AS LONG
   LOCAL ptTemp AS POINT
   LOCAL TWOPI AS DOUBLE

   TWOPI = 2 * 3.14159#

   FOR i = 0 TO iNum - 1
      ptTemp.x = (pt(i).x * COS(TWOPI * iAngle / 360) + _
                 pt(i).y * SIN(TWOPI * iAngle / 360))

      ptTemp.y = (pt(i).y * COS(TWOPI * iAngle / 360) - _
                 pt(i).x * SIN(TWOPI * iAngle / 360))
      pt(i) = ptTemp
   NEXT

END SUB
' ========================================================================================

' ========================================================================================
SUB DrawClock (BYVAL hdc AS DWORD)

   LOCAL iAngle AS LONG
   DIM   pt(0 TO 3) AS POINT

   FOR iAngle = 0 TO 359 STEP 6
      pt(0).x = 0
      pt(0).y = 900

      RotatePoint (pt(), 1, iAngle)

      IF iAngle MOD 5 <> 0 THEN
         pt(2).x = 33
      ELSE
         pt(2).x = 100
      END IF
      pt(2).y = pt(2).x

      pt(0).x = pt(0).x - pt(2).x / 2
      pt(0).y = pt(0).y - pt(2).y / 2

      pt(1).x  = pt(0).x + pt(2).x
      pt(1).y  = pt(0).y + pt(2).y

      SelectObject hdc, GetStockObject(%BLACK_BRUSH)

      ELLIPSE hdc, pt(0).x, pt(0).y, pt(1).x, pt(1).y
   NEXT

END SUB
' ========================================================================================

' ========================================================================================
SUB DrawHands (BYVAL hdc AS DWORD, pst AS SYSTEMTIME, BYVAL fChange AS LONG)

   DIM    pt(0 TO 2, 0 TO 4) AS STATIC POINT
   STATIC flag AS LONG
   LOCAL  i AS LONG
   LOCAL  x AS LONG
   LOCAL  start AS LONG
   DIM    iAngle(0 TO 2) AS LONG
   DIM    ptTemp(0 TO 2, 0 TO 4) AS POINT
   DIM    ptVector(0 TO 4) AS POINT

   IF ISFALSE flag THEN

      pt(0, 0).x = 0    : pt(0, 0).y = -150
      pt(0, 1).x = 100  : pt(0, 1).y = 0
      pt(0, 2).x = 0    : pt(0, 2).y = 600
      pt(0, 3).x = -100 : pt(0, 3).y = 0
      pt(0, 4).x = 0    : pt(0, 4).y = -150

      pt(1, 0).x = 0    : pt(1, 0).y = -200
      pt(1, 1).x = 50   : pt(1, 1).y = 0
      pt(1, 2).x = 0    : pt(1, 2).y = 800
      pt(1, 3).x = -50  : pt(1, 3).y = 0
      pt(1, 4).x = 0    : pt(1, 4).y = -200

      pt(2, 0).x = 0    : pt(2, 0).y = 0
      pt(2, 1).x = 0    : pt(2, 1).y = 0
      pt(2, 2).x = 0    : pt(2, 2).y = 0
      pt(2, 3).x = 0    : pt(2, 3).y = 0
      pt(2, 4).x = 0    : pt(2, 4).y = 800

      flag = %TRUE

   END IF

   iAngle(0) = (pst.wHour * 30) MOD 360 + pst.wMinute / 2
   iAngle(1) = pst.wMinute * 6
   iAngle(2) = pst.wSecond * 6

   CopyMemory VARPTR(ptTemp(0)), VARPTR(pt(0)), ARRAYATTR(pt(), 4) * SIZEOF(POINT)

   IF ISFALSE fChange THEN start = 2
   FOR i = start TO 2
      FOR x = 0 TO 4
         ptVector(x) = ptTemp(i, x)
      NEXT
      RotatePoint ptVector(), 5, iAngle(i)
      POLYLINE hdc, ptVector(0), 5
   NEXT

   SelectObject hdc, GetStockObject(%WHITE_BRUSH)
   ELLIPSE hdc, -30, -30, 30, 30

END SUB
' ========================================================================================

' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC cxClient AS LONG
   STATIC cyClient AS LONG
   STATIC stPrevious AS SYSTEMTIME
   LOCAL  fChange AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  st AS SYSTEMTIME

   SELECT CASE uMsg

      CASE %WM_CREATE
         SetTimer hwnd, %ID_TIMER, 1000, %NULL
         GetLocalTime st
         stPrevious = st
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         SELECT CASE LO(WORD, wParam)
            CASE %VK_ESCAPE
               SendMessage hwnd, %WM_CLOSE, 0, 0
               EXIT FUNCTION
         END SELECT

      CASE %WM_SIZE
         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)
         EXIT FUNCTION

      CASE %WM_TIMER
         GetLocalTime st
         IF st.wHour <> stPrevious.wHour OR st.wMinute <> stPrevious.wMinute THEN fChange = %TRUE
         hdc = GetDC(hwnd)
         SetIsotropic hdc, cxClient, cyClient
         SelectObject hdc, GetStockObject(%WHITE_PEN)
         DrawHands hdc, stPrevious, fChange
         SelectObject hdc, GetStockObject(%BLACK_PEN)
         DrawHands hdc, st, %TRUE
         ReleaseDC hwnd, hdc
         stPrevious = st
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SetIsotropic hdc, cxClient, cyClient
         DrawClock hdc
         DrawHands hdc, stPrevious, %TRUE
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         KillTimer hwnd, %ID_TIMER
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================
new basic pro forum on;
http://basicpro.spacefor.site/smf/
GUEST posting enabled

B+

  • Sr. Member
  • ****
  • Posts: 436
    • View Profile
Re: Power basic - Analog Clock
« Reply #1 on: 27. April 2017, 21:35:17 »
Ugly SmallBASIC editor? maybe...

less lines, fast coding, definitely!

Here is Analog Clock in 27 lines:

PS, still 1 line longer than Paul Dunn's more colored, more detailed, more stuff per line code.

« Last Edit: 27. April 2017, 22:32:10 by B+ »

Aurel

  • Regular Member
  • Sr. Member
  • *
  • Posts: 272
    • View Profile
Re: Power basic - Analog Clock
« Reply #2 on: 27. April 2017, 23:41:26 »
Quote
Ugly SmallBASIC editor?
I don't say that is ugly...but if you say -TRUE THAT  ;D
no
in first place is user unfriendly with NonIntuitive and DOS like openinig
like is stolen from some linux distro
it is simple...try ask some ordinary computer user  where is MENU or TOOLBAR?
RightClick not open Context menu with FILE-open/save ..nothing
just View Source, Open CONSOLE etc, where is standard FileOpenDialog?
I understand that you are biased to SmallBasic ...maybe little bit to much?
Look PBWin IDE is also little bit ugly for let say professional programming lang like Power Basic,yes!
Mark..correct me if am wrong but it seems to me that primary target of small basic is linux users..right?
BUT all this don't have nothing with Analog clock example .
« Last Edit: 28. April 2017, 00:02:44 by Aurel »
new basic pro forum on;
http://basicpro.spacefor.site/smf/
GUEST posting enabled

B+

  • Sr. Member
  • ****
  • Posts: 436
    • View Profile
Re: Power basic - Analog Clock
« Reply #3 on: 28. April 2017, 02:19:36 »
Aurel, I have no idea what the Linux experience is.

I personally use Windows 10 for all my File maintenance stuff but you can use SmallBASIC's File menu. see "SmallBASIC Notes" thread under "Tutorials and articles" board, that I have just updated with screen shots of latest update (this month) of SmallBASIC version 0.12.9

PS, I think the File menu stuff in SmallBASIC is for when you are writing code with Android device.
« Last Edit: 28. April 2017, 03:07:38 by B+ »

jj2007

  • Full Member
  • ***
  • Posts: 124
  • MasmBasic rocks
    • View Profile
    • MasmBasic - faster than C
Re: Power basic - Analog Clock
« Reply #4 on: 28. April 2017, 15:07:57 »
Yes .. Power Basic  :D
Jose Roca site have many great programs and examples.

With the Classic PowerBASIC Compiler 9.07 for Windows, it works after two little changes:

#INCLUDE ONCE "win32api.inc"
#INCLUDE ONCE "\PowerBasic\WinAPI\Win32API.inc"

                  BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG
                  BYVAL pszCmdLine AS LONG PTR, BYVAL iCmdShow AS LONG) AS LONG