'===========================================================================
' Subject: SIMPLE GRAPHICS DRAWING EXAMPLE   Date: 06-28-99 (18:45)       
' Author:  Dave Navarro, Jr.                 Code: PBCC, PBDLL            
' 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

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

  DIM x1(40) AS STATIC LONG
  DIM x2(40) AS STATIC LONG
  DIM y1(40) AS STATIC LONG
  DIM y2(40) AS STATIC LONG
  DIM a1(40) AS STATIC LONG
  DIM a2(40) AS STATIC LONG
  DIM b1(40) AS STATIC LONG
  DIM b2(40) AS STATIC LONG

  STATIC hOldPen AS LONG
  STATIC x1      AS LONG
  STATIC x2      AS LONG
  STATIC y1      AS LONG
  STATIC y2      AS LONG
  STATIC a1      AS LONG
  STATIC a2      AS LONG
  STATIC b1      AS LONG
  STATIC b2      AS LONG
  STATIC c1      AS LONG
  STATIC c2      AS LONG
  STATIC xd1     AS LONG
  STATIC xd2     AS LONG
  STATIC yd1     AS LONG
  STATIC yd2     AS LONG
  STATIC ad1     AS LONG
  STATIC ad2     AS LONG
  STATIC bd1     AS LONG
  STATIC bd2     AS LONG
  STATIC iOk     AS LONG
  STATIC Change1 AS LONG
  STATIC 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
      END IF

      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
      END IF

      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