hi. a simple but funny supplement of "bounce" example by petzold. this blue ball is flattering, bouncing and walking slowly down to earth.
my 5 cents for today :)
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
%ID_TIMER = 1
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL szAppName AS ASCIIZ * 256
LOCAL msg AS tagMsg
LOCAL hWnd AS DWORD
LOCAL wc AS WNDCLASS
LOCAL szCaption AS ASCIIZ * 256
szAppName = "Bounce"
wc.style = %CS_HREDRAW OR %CS_VREDRAW
wc.lpfnWndProc = CODEPTR(WndProc)
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hInstance
wc.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wc.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wc.hbrBackground = GetStockObject(%WHITE_BRUSH)' or %BLUE or Transparence)
wc.lpszMenuName = %NULL
wc.lpszClassName = VARPTR(szAppName)
IF ISFALSE RegisterClass(wc) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
szCaption = "Flattering Ball walks slowly down"
hWnd = CreateWindow (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
%NULL) ' creation parameters
ShowWindow hWnd, iCmdShow
UpdateWindow hWnd
WHILE GetMessage(msg, %NULL, 0, 0)
TranslateMessage msg
DispatchMessage msg
WEND
FUNCTION = Msg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC hBitmap AS DWORD
STATIC cxClient AS LONG
STATIC cyClient AS LONG
STATIC xCenter AS LONG
STATIC yCenter AS LONG
STATIC cxTotal AS LONG
STATIC cyTotal AS LONG
STATIC cxRadius AS LONG
STATIC cyRadius AS LONG
STATIC cxMove AS LONG
STATIC cyMove AS LONG
STATIC xPixel AS LONG
STATIC yPixel AS LONG
LOCAL hBrush AS DWORD
LOCAL hdc AS DWORD
LOCAL hdc1 AS DWORD
LOCAL hdcMem AS DWORD
LOCAL hdcMem1 AS DWORD
LOCAL iScale AS LONG
SELECT CASE message
CASE %WM_CREATE
hdc = GetDC(hwnd)
hdc1 = GetDC(hwnd)
xPixel = GetDeviceCaps(hdc, %ASPECTX)
yPixel = GetDeviceCaps(hdc, %ASPECTY)
ReleaseDC hwnd, hdc
SetTimer hwnd, %ID_TIMER, 60, %NULL
FUNCTION = 0
EXIT FUNCTION
CASE %WM_SIZE
cxClient = LOWRD(lParam)
cyClient = HIWRD(lParam)
xCenter = cxClient \ 4
yCenter = cyClient \ 4
iScale = MIN&(cxClient * xPixel, cyClient * yPixel) \ 16
cxRadius = iScale \ xPixel
cyRadius = iScale \ yPixel
cxMove = MAX&(1, cxRadius \ 4) '2
cyMove = MAX&(1, cyRadius \ 4) '2
cxTotal = 4 * (cxRadius + cxMove)
cyTotal = 4 * (cyRadius + cyMove)
IF hBitmap THEN DeleteObject hBitmap
hdc = GetDC(hwnd)
hdcMem = CreateCompatibleDC(hdc)
hBitmap = CreateCompatibleBitmap(hdc, cxTotal, cyTotal)
ReleaseDC hwnd, hdc
SelectObject hdcMem, hBitmap
Rectangle hdcMem, -1, -1, cxTotal + 2, cyTotal + 2
hBrush = CreateHatchBrush(%HS_DIAGCROSS, 0)
SelectObject hdcMem, hBrush
SetBkColor hdcMem, RGB(RND(1,55), 0, 255)
ELLIPSE hdcMem, cxMove, cyMove, cxTotal - cxMove, cyTotal - cyMove
DeleteDC hdcMem
DeleteObject hBrush
FUNCTION = 0
EXIT FUNCTION
CASE %WM_TIMER
IF ISFALSE hBitmap THEN EXIT FUNCTION
hdc = GetDC(hwnd)
hdcMem = CreateCompatibleDC(hdc)
SelectObject hdcMem, hBitmap
BitBlt hdc, xCenter - cxTotal \ 2, _
yCenter - cyTotal \ 2, cxTotal, cyTotal, _
hdcMem, 0, 0, %SRCCOPY
ReleaseDC hwnd, hdc
DeleteDC hdcMem
xCenter = xCenter+0.5 + cxMove'*COS(yCenter+gettickcount*12)
yCenter = yCenter+0.5 + cyMove*SIN(xCenter+gettickcount*24)
IF (xCenter + cxRadius) >= cxClient OR (xCenter - cxRadius <= 0) THEN cxMove = -cxMove
IF (yCenter + cyRadius) >= cyClient OR (yCenter - cyRadius) <= 0 THEN cyMove = -cyMove
FUNCTION = 0
EXIT FUNCTION
CASE %WM_DESTROY
IF hBitmap THEN DeleteObject hBitmap
KillTimer hwnd, %ID_TIMER
PostQuitMessage 0
FUNCTION = 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, message, wParam, lParam)
END FUNCTION
' ========================================================================================
servus, frank