'------------------------------------------------------------------------------- ' ' KOOL.BAS for 32-bit PB/DLL 6.0 ' Copyright (c) 1999 by PowerBASIC, Inc. ' ' 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 $ClassName = "PB/DLL Simple Graphics Demo" '------------------------------------------------------------------------------ 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 STATIC hOldPen AS LONG STATIC x1 AS LONG STATIC x2 AS LONG STATIC y1 AS LONG STATIC y2 AS LONG STATIC z1 AS LONG STATIC z2 AS LONG STATIC c1 AS LONG STATIC c2 AS LONG STATIC co1 AS LONG STATIC xd1 AS LONG STATIC xd2 AS LONG STATIC yd1 AS LONG STATIC yd2 AS LONG STATIC zd1 AS LONG STATIC zd2 AS LONG STATIC cd1 AS LONG STATIC cd2 AS LONG STATIC iOk AS LONG STATIC count AS LONG SELECT CASE wMsg CASE %WM_CREATE DIM pt(13) AS STATIC POINTAPI DIM x1(40) AS STATIC LONG DIM y1(40) AS STATIC LONG DIM x2(40) AS STATIC LONG DIM y2(40) AS STATIC LONG DIM z1(40) AS STATIC LONG DIM z2(40) AS STATIC LONG DIM a1(40) AS STATIC LONG DIM b1(40) AS STATIC LONG DIM a2(40) AS STATIC LONG DIM b2(40) AS STATIC LONG DIM c1(40) AS STATIC LONG DIM c2(40) AS STATIC LONG 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) z1 = RND(10, Rct.nRight - 10) : c1 = RND(10, Rct.nRight - 10) z2 = RND(10, Rct.nBottom - 10) : c2 = RND(10, Rct.nBottom - 10) xd1 = 9 : xd2 = 7 yd1 = 6 : yd2 = 10 zd1 = 2 : zd2 = 2 cd1 = -2 : cd2 = -2 iOk = -1 EXIT FUNCTION CASE %WM_SIZE iOk = 0 InvalidateRect hWnd, BYVAL %NULL, %TRUE SendMessage hWnd, %WM_CREATE, 0, 0 EXIT FUNCTION 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 z1(1) : ARRAY DELETE z2(1) ARRAY DELETE c1(1) : ARRAY DELETE c2(1) hOldPen = SelectObject(hDC, CreatePen(%PS_SOLID, 1, co1)) pt( 1).x = z1 : pt( 1).y = z2 pt( 2).x = z1 : pt( 2).y = z2 pt( 3).x = x2 : pt( 3).y = y2 pt( 4).x = c1 : pt( 4).y = c2 pt( 5).x = c1 : pt( 5).y = c2 pt( 6).x = x1 : pt( 6).y = y1 MoveToEx hDC, x1, y1, BYVAL %NULL PolyBezierTo hDC, pt(1), 6 DeleteObject SelectObject(hDC, GetStockObject(%BLACK_PEN)) pt( 1).x = z1(1) : pt( 1).y = z2(1) pt( 2).x = z1(1) : pt( 2).y = z2(1) pt( 3).x = x2(1) : pt( 3).y = y2(1) pt( 4).x = c1(1) : pt( 4).y = c2(1) pt( 5).x = c1(1) : pt( 5).y = c2(1) pt( 6).x = x1(1) : pt( 6).y = y1(1) MoveToEx hDC, x1(1), y1(1), BYVAL %NULL PolyBezierTo hDC, pt(1), 6 DeleteObject SelectObject(hDC, hOldPen) EndPaint hWnd, PS EXIT FUNCTION CASE %WM_TIMER IF ISFALSE iOk THEN EXIT SELECT END IF IF count < 1 THEN co1 = RGB(29+RND(1,225),29+RND(1,225),29+RND(1,225)) count = 200 END IF DECR count GetClientRect hWnd, Rct InvalidateRect hWnd, BYVAL %NULL, %FALSE UpdateWindow hWnd x1(40) = x1 : x2(40) = x2 y1(40) = y1 : y2(40) = y2 z1(40) = z1 : z2(40) = z2 c1(40) = c1 : c2(40) = c2 x1 = x1 + xd1 : x2 = x2 + xd2 y1 = y1 + yd1 : y2 = y2 + yd2 z1 = z1 + zd1 : z2 = z2 + zd2 c1 = c1 + cd1 : c2 = c2 + cd2 IF (x1 < 1) OR (x1 => Rct.nRight -1) OR (RND(1,100) = 5) THEN xd1 = -xd1 END IF IF (x2 < 1) OR (x2 => Rct.nRight -1) OR (RND(1,100) = 5) THEN xd2 = -xd2 END IF IF (z1 < 1) OR (z1 => Rct.nRight -1) OR (RND(1,100) = 5) THEN zd1 = -zd1 END IF IF (c1 < 1) OR (c1 => Rct.nRight -1) OR (RND(1,100) = 5) THEN cd1 = -cd1 END IF IF (y1 < 1) OR (y1 => Rct.nBottom -1) OR (RND(1,100) = 5) THEN yd1 = -yd1 END IF IF (y2 < 1) OR (y2 => Rct.nBottom -1) OR (RND(1,100) = 5) THEN yd2 = -yd2 END IF IF (z2 < 1) OR (z2 => Rct.nBottom -1) OR (RND(1,100) = 5) THEN zd2 = -zd2 END IF IF (c2 < 1) OR (c2 => Rct.nBottom - 1) OR (RND(1,100) = 5) THEN cd2 = -cd2 END IF EXIT FUNCTION CASE %WM_DESTROY PostQuitMessage 0 EXIT FUNCTION END SELECT FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam) END FUNCTION