Michael Clease
29-09-2010, 21:48
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.
#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
Can I also suggest another sub board for Oxygen Basic.
Mike
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.
#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
Can I also suggest another sub board for Oxygen Basic.
Mike