Oxygen Basic and Timers

[Michael Clease]

Hello Charles,

I have taken a simple window program (by Peter) and tried adding a timer to it but cant seem to get it working, can you have a look and see what I am doing wrong.
[code=FreeBasic]
#basic

Type WNDCLASS
Style as long
lpfnwndproc as long
cbClsextra as long
cbWndExtra as long
hInstance as long
hIcon as long
hCursor as long
hbrBackground as long
lpszMenuName as long
lpszClassName as long
End Type

Type point
x as long
y as long
End Type

Type MSG
hwnd as long
message as long
wParam as long
lParam as long
time as long
pt as point
End Type

Type RECT
Left as long
Top as long
Right as long
Bottom as long
End Type

Def SW_NORMAL 1
Def SW_SHOWDEFAULT 10
Def CS_VREDRAW 1
Def CS_HREDRAW 2
Def IDI_APPLICATION 32512
Def IDC_ARROW 32512
Def WHITE_BRUSH 0
Def BLACK_BRUSH 4
Def WM_CREATE 1
Def WM_DESTROY 2
Def WM_PAINT 15
Def WM_CLOSE 16
Def WM_QUIT 18
Def WM_SIZE 5
Def CW_USEDEFAULT 0x80000000
Def WS_OVERLAPPEDWINDOW 0x00cf0000
Def WS_DLGFRAME 0x400000
Def PM_REMOVE 1
Def SW_SHOW 5
Def SM_CXSCREEN 0
Def SM_CYSCREEN 1
Def WM_INPUT 0x0FF
Def WM_KEYFIRST 0x100
Def WM_KEYDOWN 0x100
Def WM_KEYUP 0x101
Def WM_TIMER 0x113
Def ID_Timer 3000
Def Interval 100
Def WM_INITDIALOG 0x110

Dim kernel32,user32,gdi32
kernel32 = LoadLibrary "kernel32.dll"
user32 = LoadLibrary "user32.dll"
gdi32 = LoadLibrary "gdi32.dll"

Bind kernel32
(
GetCommandLine GetCommandLineA
GetModuleHandle GetModuleHandleA
ExitProcess ExitProcess
)

Bind user32
(
LoadIcon LoadIconA
LoadCursor LoadCursorA
RegisterClass RegisterClassA
MessageBox MessageBoxA
CreateWindowEx CreateWindowExA
ShowWindow ShowWindow
UpdateWindow UpdateWindow
GetMessage GetMessageA
TranslateMessage TranslateMessage
DispatchMessage DispatchMessageA
PostQuitMessage PostQuitMessage
PostMessage PostMessageA
DefWindowProc DefWindowProcA
PeekMessage PeekMessageA
)

Bind gdi32
(
GetStockObject GetStockObject
)

Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Declare Function ValidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Declare Function WinMain(byval inst as long, byval prevInst as long, byval cmdline as asciiz, byval show as long) as long
Declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Declare Function HighWord(byval high as long) as long
Declare Function LowWord (byval low as long) as long

DECLARE FUNCTION SetTimer LIB "USER32.DLL" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG
DECLARE FUNCTION KillTimer LIB "USER32.DLL" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG
DECLARE FUNCTION TimerProc (BYVAL hWnd AS DWORD, byval wMsg as DWORD, BYVAL nIDEvent AS LONG, BYVAL dwTime AS DWORD) as long

Dim byref cmdline as asciiz
Global inst as long
Global hdc,xmax,ymax,r,idx,idy,xball,yball as long
r =15 : idx =5 : idy =5

&cmdline = GetCommandLine
inst = GetModuleHandle 0

WinMain inst,0,cmdline,SW_NORMAL
Freelibrary kernel32 : Freelibrary user32 : Freelibrary gdi32
Terminate : ExitProcess 0

Function WinMain(byval inst as long,byval prevInst as long,byval cmdline as asciiz, byval show as long) as long
Dim wc as WndClass
Dim wm as MSG
Dim hwnd as DWORD
Dim Wwd as long
Dim Wht as long
Dim Wtx as long
Dim Wty as long
Dim Tax as long

wc.style = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc = &WndProc
wc.cbClsExtra =0
wc.cbWndExtra =0
wc.hInstance =inst
wc.hIcon=LoadIcon 0, IDI_APPLICATION
wc.hCursor=LoadCursor 0,IDC_ARROW
wc.hbrBackground = GetStockObject WHITE_BRUSH
wc.lpszMenuName =0
wc.lpszClassName ="Demo"
RegisterClass &wc

Wwd = 800 : Wht = 600
Tax = GetSystemMetrics,SM_CXSCREEN
Wtx = (Tax - Wwd) /2
Tax = GetSystemMetrics,SM_CYSCREEN
Wty = (Tax - Wht) /2

hwnd = CreateWindowEx 0,wc.lpszClassName,"OXYGEN BASIC",WS_OVERLAPPEDWINDOW,Wtx,Wty,Wwd,Wht,0,0,inst,0
ShowWindow hwnd,SW_SHOW
UpdateWindow hwnd

Do While GetMessage &wm,0,0,0
TranslateMessage &wm
DispatchMessage &wm
Wend
End Function

Function WndProc(byval hwnd as long,byval wMsg as long, byval wParam as long,byval lparam as long) as long callback

SELECT wMsg

Case WM_CREATE
hdc = GetDC(hwnd)
xball =100 : yball =100
hTimer = SetTimer (hWnd, ID_Timer, 200, &TimerProc)
If hTimer = 0 THEN r = 200

Case WM_KEYDOWN

Select wParam

Case 37
xball -= idx
Case 39
xball += idx
Case 38
yball -= idy
Case 40
yball += idy
Case 32
Rectangle hdc, -1, -1, xmax+1, ymax+1
Case 27
SendMessage hwnd, WM_CLOSE, 0, 0
InvalidateRect hwnd, 0, 0
End Select

Case WM_TIMER
r += 10
Case WM_PAINT
Ellipse hdc, xball-r, yball-r, xball+r, yball+r
ValidateRect hwnd,0
Case WM_SIZE
xmax = LowWord (lParam)
ymax = HighWord(lParam)
Case WM_DESTROY
KillTimer(hWnd,ID_TIMER)
PostQuitMessage 0
Case else
Function = DefWindowProc hWnd,wMsg,wParam,lParam

End Select

End Function

Function HighWord(byval high as long) as long
shr high,16 : Function = high
End Function

Function LowWord(byval low as long) as long
and low,&hffff : Function = low
End Function

Function TimerProc(BYVAL hWnd AS DWORD, byval wMsg as DWORD, BYVAL nIDEvent AS LONG, BYVAL dwTime AS DWORD) as long callback

SELECT wMsg

Case WM_TIMER

r +=5

FUNCTION = 0

END SELECT


End Function
[/code]

Can I also suggest another sub board for Oxygen Basic.

Mike

[Charles Pegge]

Yes something strange is happening here. I don't think it is directly connected with the timing function per se since I've been able to get it working, and also the timer message in WndProc, but they don't work consistently.

I'll dream of a few more tests tonight

Charles

PS: OxygenBasic is about to get its own forum but I value the close association with thinBasic very much.

[Charles Pegge]

Good Morning!

I could not pinpoint the problem unfortunately. It may have been a Local/Static variable issue but here is
some working code using most of yours. I would like to use something like this as one of the standard demos.

Charles