'===========================================================================
' Subject: GRAPHICS DRAWING PROGRAM FOR PB    Date: 07-06-99 (17:29)       
'  Author: Dave Navarro, Jr.                  Code: PBCC                   
'  Origin: dave@powerbasic.com              Packet: PBCC.ABC
'===========================================================================
'-------------------------------------------------------------------------------
'
'   COOL.BAS for 32-bit PB/CC 2.0
'   Copyright (c) 1999 by PowerBASIC, Inc.
'
'   A simple graphics drawing program
'   Ported from PB/DOS to PB/CC 6.0 by Lance Edmonds 1999
'   Original PB/DOS code by Dave Navarro.
'
'   Uses a 30mSec Timer to do the drawing updates, and uses less than 1% of the
'   processor time (as measured on an AMD K6-266/64Mb/1Mb S3 Trio video card)
'
'------------------------------------------------------------------------------

#DIM ALL
#COMPILE EXE
#OPTION VERSION4
#INCLUDE "WIN32API.INC"
DEFLNG a-z

$IF %DEF(%pb_dll32)
$ClassName = "PB/DLL Simple Graphics Demo"
$ELSE
$ClassName = "PB/CC Simple Graphics Demo"
$ENDIF

'------------------------------------------------------------------------------

FUNCTION WinMain (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  lpCmdLine           AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

  LOCAL Msg         AS tagMsg
  LOCAL wndclass    AS WndClassEx
  LOCAL szClassName AS ASCIIZ * 80
  LOCAL hWnd        AS LONG
  LOCAL hTimer      AS LONG

  szClassName = $ClassName

  wndclass.cbSize        = SIZEOF(WndClass)
  wndclass.style         = %CS_HREDRAW OR %CS_VREDRAW
  wndclass.lpfnWndProc   = CODEPTR( WndProc )
  wndclass.cbClsExtra    = 0
  wndclass.cbWndExtra    = 0
  wndclass.hInstance     = hInstance
  wndclass.hIcon         = LoadIcon( hInstance, "PROGRAM" )
  wndclass.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
  wndclass.hbrBackground = GetStockObject( %BLACK_BRUSH )
  wndclass.lpszMenuName  = %NULL
  wndclass.lpszClassName = VARPTR(szClassName)
  wndclass.hIconSm       = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )

  RegisterClassEx wndclass

  ' Create a window using the registered class
  hWnd = CreateWindowEx(0, _                        ' extended Window style
                      $ClassName, _                 ' window class name
                      $ClassName, _                 ' 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
                      %HWND_DESKTOP, _              ' parent window handle
                      BYVAL 0, _                    ' window menu handle
                      hInstance, _                  ' program instance handle
                      BYVAL %NULL)                  ' creation parameters

  ShowWindow hWnd, iCmdShow
  UpdateWindow hWnd

  ' Create a timer event every 30 mSec
  hTimer = SetTimer(hWnd, 0, 30, BYVAL %NULL)

  WHILE GetMessage(Msg, %NULL, 0, 0)
    TranslateMessage Msg
    DispatchMessage Msg
  WEND

  ' Destroy the timer
  KillTimer hWnd, 0

  FUNCTION = msg.wParam

END FUNCTION  ' WinMain

'------------------------------------------------------------------------------

FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

  DIM Rct AS RECT
  DIM PS AS PAINTSTRUCT
  DIM hDC AS LONG
  DIM Pt AS POINTAPI

  STATIC hOldPen AS LONG

  DIM x1(40) AS STATIC LONG, x2(40) AS STATIC LONG, y1(40) AS STATIC LONG, y2(40) AS STATIC LONG
  DIM a1(40) AS STATIC LONG, a2(40) AS STATIC LONG, b1(40) AS STATIC LONG, b2(40) AS STATIC LONG
  STATIC x1 AS LONG, x2 AS LONG, y1 AS LONG, y2 AS LONG
  STATIC a1 AS LONG, a2 AS LONG, b1 AS LONG, b2 AS LONG
  STATIC c1 AS LONG, c2 AS LONG
  STATIC xd1 AS LONG, xd2 AS LONG
  STATIC yd1 AS LONG, yd2 AS LONG
  STATIC ad1 AS LONG, ad2 AS LONG
  STATIC bd1 AS LONG, bd2 AS LONG
  STATIC iOk AS LONG, Change1 AS LONG, Change2 AS LONG

  SELECT CASE wMsg
    CASE %WM_CREATE
        RANDOMIZE TIMER

        GetClientRect hWnd, Rct
        x1 = RND(10, Rct.nRight - 10)  : x2 = RND(10, Rct.nRight - 10)
        y1 = RND(10, Rct.nBottom - 10) : y2 = RND(10, Rct.nBottom - 10)
        a1 = RND(10, Rct.nRight - 10)  : a2 = RND(10, Rct.nRight - 10)
        b1 = RND(10, Rct.nBottom - 10) : b2 = RND(10, Rct.nBottom - 10)

        c1  = RGB(255,255,0) ' Yellow
        c2  = RGB(0,112,255) ' Blue

        xd1 = 9   : xd2 = 7
        yd1 = 6   : yd2 = 10
        ad1 = -11 : ad2 = 7
        bd1 = 4   : bd2 = -13

        Change1 = 0
        Change2 = 0

        iOk = -1
        EXIT FUNCTION

    CASE %WM_SIZE
        iOk = 0
        InvalidateRect hWnd, BYVAL %NULL, %TRUE
        SendMessage hWnd, %WM_CREATE, 0, 0
        EXIT FUNCTION

    CASE %WM_COMMAND

    CASE %WM_SYSCOMMAND
        IF wParam = %SC_CLOSE THEN
           DestroyWindow hWnd
           EXIT FUNCTION
        END IF

    CASE %WM_PAINT
        IF ISFALSE iOk THEN EXIT SELECT

        hDC = BeginPaint(hWnd, PS)

        ARRAY DELETE x1(1) : ARRAY DELETE x2(1)
        ARRAY DELETE y1(1) : ARRAY DELETE y2(1)
        ARRAY DELETE a1(1) : ARRAY DELETE a2(1)
        ARRAY DELETE b1(1) : ARRAY DELETE b2(1)

        hOldPen = SelectObject(hDC, CreatePen(%PS_SOLID, 1, c1))
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2

        DeleteObject SelectObject(hDC, GetStockObject(%Black_Pen))
        MoveToEx hDC, x1(1), y1(1), byval %NULL
        LineTo hDC, x2(1), y2(1)

        DeleteObject SelectObject(hDC, CreatePen(%PS_SOLID, 1, c2))
        MoveToEx hDC, a1, b1, byval %NULL
        LineTo hDC, a2, b2 ', c2

        DeleteObject SelectObject(hDC, GetStockObject(%Black_Pen))
        MoveToEx hDC, a1(1), b1(1), byval %NULL
        LineTo hDC, a2(1), b2(1)

        DeleteObject SelectObject(hDC, hOldPen)

        EndPaint hWnd, PS
        EXIT FUNCTION

    CASE %WM_Timer
        IF ISFALSE iOk THEN EXIT SELECT

        GetClientRect hWnd, Rct
        InvalidateRect hWnd, BYVAL %NULL, %FALSE
        UpdateWindow hWnd

        x1(40) = x1 : x2(40) = x2
        y1(40) = y1 : y2(40) = y2
        a1(40) = a1 : a2(40) = a2
        b1(40) = b1 : b2(40) = b2

        x1 = x1 + xd1 : x2 = x2 + xd2
        y1 = y1 + yd1 : y2 = y2 + yd2

        a1 = a1 + ad1 : a2 = a2 + ad2
        b1 = b1 + bd1 : b2 = b2 + bd2

        IF (x1 < 1) OR (x1 => Rct.nRight -1) THEN
            xd1 = -xd1
            INCR Change1
        END IF

        IF (x2 < 1) OR (x2 => Rct.nRight -1) THEN
            xd2 = -xd2
            INCR Change1
        END IF

        IF (a1 < 1) OR (a1 => Rct.nRight -1) THEN
            ad1 = -ad1
            INCR Change2
        END IF

        IF (a2 < 1) OR (a2 => Rct.nRight -1) THEN
            ad2 = -ad2
            INCR Change2
        END IF

        IF (y1 < 1) OR (y1 => Rct.nBottom -1) THEN
            yd1 = -yd1
            INCR Change1
        END IF

        IF (y2 < 1) OR (y2 => Rct.nBottom -1) THEN
            yd2 = -yd2
            INCR Change1
        END IF

        IF (b1 < 1) OR (b1 => Rct.nBottom -1) THEN
            bd1 = -bd1
            INCR Change2
        END IF

        IF (b2 < 1) OR (b2 => Rct.nBottom - 1) THEN
            bd2 = -bd2
            INCR Change2
        END IF

        IF Change1 => 4 THEN
            c1  = RGB(RND(1,4) * 64, RND(1,4) * 64, RND(1,4) * 64)
            Change1 = 0
        END IF

        IF Change2 => 4 THEN
            c2  = RGB(RND(1,4) * 64, RND(1,4) * 64, RND(1,4) * 64)
            Change2 = 0
        END IF

        EXIT FUNCTION

    CASE %WM_DESTROY
        PostQuitMessage 0
        EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION