Hi E7,
jepp. User32 und GDI32.
hier ist der Quellcode für "Kool"
'==============================================================================
'
' KOOL.BAS SDK graphics example for PowerBASIC for Windows PB/WIN 7.0
' Copyright (c) 1999-2002 PowerBASIC, Inc.
' All Right Reserved.
'
' 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
#INCLUDE "WIN32API.INC"
'------------------------------------------------------------------------------
' GUI Window class name (must be unique). We'll use it for the title too.
'
$ClassName = "PB/WIN Simple Graphics Demo #2"
'------------------------------------------------------------------------------
' Main program entry point...
'
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wce AS WndClassEx
LOCAL szClassName AS ASCIIZ * 80
LOCAL hWnd AS DWORD
LOCAL hTimer AS DWORD
szClassName = $ClassName
wce.cbSize = SIZEOF(wce)
wce.style = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR( WndProc )
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInstance
wce.hIcon = LoadIcon( hInstance, "PROGRAM" )
wce.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
wce.hbrBackground = GetStockObject( %BLACK_BRUSH )
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szClassName)
wce.hIconSm = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )
RegisterClassEx wce
' 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 %NULL, _ ' 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)
DO WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
LOOP
' Destroy the timer
KillTimer hWnd, 0
FUNCTION = msg.wParam
END FUNCTION
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 DWORD
STATIC hOldPen AS DWORD
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 c1(40) AS STATIC LONG
DIM c2(40) AS STATIC LONG
RANDOMIZE
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 0 |