Hello Charles

[peter]

Hello Charles,

this source code is an experiment with OxygenBasic but it is nothing special.
It shows some technics about Window programming.
I think that I can write a game therewith. Some other Expriments have showed me that the speed is fantastic.

By the way: if I forget the declaration 'GetDC()', I get no message
which says to me 'undefined name' but is running without result.



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 WM_KEYDOWN 256
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

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

Dim byref cmdline as asciiz,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 long
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
iF wMsg = WM_CREATE
hdc = GetDC(hwnd)
xball =100 : yball =100
elseif wMsg = WM_KEYDOWN
iF wParam =37
xball -= idx
elseif wParam =39
xball += idx
elseiF wParam =38
yball -= idy
elseif wParam =40
yball += idy
elseiF wParam =32
Rectangle hdc, -1, -1, xmax+1, ymax+1
elseif wParam =27
SendMessage hwnd, WM_CLOSE, 0, 0
InvalidateRect hwnd, 0, 0
End iF
elseif wMsg = WM_PAINT
Ellipse hdc, xball-r, yball-r, xball+r, yball+r
ValidateRect hwnd,0
elseif wMsg = WM_SIZE
xmax = LowWord (lParam)
ymax = HighWord(lParam)
elseif wMsg = WM_DESTROY
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
End iF
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

[Charles Pegge]

Thank you Peter,

I am always amazed at how much work is involved in creating a Window. It would be great to see the first game scripted in Oxygen. :)

I've found a way to trap the kind of error you reported. It though GetDC might be some sort of array but neglected to check whether the base variable existed or not.

This correction will go into the next release (Alpha011). I will also update thinBasic_Oxygen soon. We had a few battles with Antivirus software, so I have done some major surgery to the binary layout, which should make executables less prone to triggering false alarms.

Charles

[Michael Clease]

Charles I noticed that the datatypes used in this example seem to be wrong?? I thought that windows handles are all Dword and not Long (i know this example works though)

I am using the headers by Jose for PowerBasic as reference but I see Freebasic has hwnd as Integer and I cant seem to find a absolute answer.

[MouseTrap]

It would be great to see the first game scripted in Oxygen.
Oxygen would make a great embedded scripting language. There would need to be some built in sandboxing features first however.

[Charles Pegge]

Yes it's designed to be embedded. I've been thinking about sandboxing too. Google has very stringent 'sandbox' requirements which must be satisfied before it will allow any application to run in its web-based Chrome Operating system. I'm making changes to try and satisfy these requirements in anticipation.


Charles

[MouseTrap]

I believe the google sandbox in chrome actually looks at the opcodes of program, It goes way beyond just protected memory.
Imo, the best way to have a sandbox environment for oxygen is to disallow importing of external libs and to be able to trap any kind of IO. Anything needed by oxygen should be provided by the host app. But because oxygen still has the ability to allocate its own memory and move pointers around. keeping that stuff safe is a bit beyond my knowledge.

[Charles Pegge]

To ensure a safe programming environment within an application you could preprocess the user's script before compilation to block any undesirable commands and limit the function calls available. And it may well be that raw basic is not appropriate to the application - in which case you could devise a domain-specific language by providing a fixed set of macros and functions for the application then reject all other keywords.

Charles

[Charles Pegge]

Mike,

On the subject of Longs and Dwords. Either can be used as long as you do not intend to do arithmetic with then that might cause an overflow or sign reversal. Handles are never altered in this way so these types are safe, and pointers operating within the 2Gig range are also safe. but with one major caveat: On 64 bit platforms, all handles and pointers become 64 bits wide and you can no longer depend on using 32 bit integers. This becomes a serious issue when you have data structures which depend on 32 bit storage to hold pointers and handles. In Oxygen to avoid any problems in producing 32/64 bit versions of software I have introduced the "sys" type which always matches the bit size of the platform allowing the source code to be identical for both 32 and 64 bit. (I'm hoping to do the 64bit runtime soon.)

Charles

[Michael Clease]

Thanks for clearing that up, I have a clearer picture now.

[peter]

Hi Charles,

here is an experiment about 3D Text. That can be used in a simple manner.

If one of all parameter (x1 y1) the numbers takes away then shows oxygen a strange behavior.
I mean only in the Function Text3D and declaration!

The Linker tells you: Error; Linker found unindentified names;
x: Level 0

Thanks



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

Type tRGB
r as long
g as long
b 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_QUIT 18
Def WM_SIZE 5
Def WM_KEYDOWN 256
Def WS_OVERLAPPEDWINDOW 0x00cf0000
Def SW_SHOW 5
Def SM_CXSCREEN 0
Def SM_CYSCREEN 1

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 GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
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 SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Declare Function SetBkMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) 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 HighWord(byval high as long) as long
Declare Function LowWord (byval low as long) as long
Declare Function Rgb(byval red as long, byval green as long, byval blue as long) as long
Declare Function GetRgb(Fab)
Declare Function Max(byval a as long, byval b as long) as long
Declare Function Text3D(txt as string, x1 as long, y1 as long, fab as long)
Declare Function CreateBuffer(x2 As Long, y2 As Long)

Dim byref cmdline as asciiz,inst,i,hdc,hFont,xmax,ymax as long
Dim cRGB as tRGB
Global xB, yB, bHdc, bHnd as long

&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 long
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 BLACK_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
iF wMsg = WM_CREATE
hdc = GetDC(hwnd)
CreateBuffer 800,600
hFont = CreateFont 100,32,0,0,0,0,0,0,0,0,0,0,0,"times"
SelectObject bHdc,hFont
SetBKMode bHdc,1

elseif wMsg = WM_PAINT
For i=0 to 360
SetPixel bHdc,400+sin(i)*350,230+cos(i)*150,Rgb 255,100,100
Next
Text3D(" HELLO ",188,120,&h404000)
Text3D("OXYGENBASIC",112,200,&h004000)
Text3D("NO BLUE ! ",200,450,&h0020F0)
BitBlt hdc, 0, 0, xB, yB, bHdc, 0, 0, &hCC0020
ValidateRect hwnd,0

elseif wMsg = WM_SIZE
xmax = LowWord (lParam)
ymax = HighWord(lParam)

elseif wMsg = WM_DESTROY
DeleteObject hFont
DeleteObject bHnd
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
End iF
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 Rgb(byval red as long, byval green as long, byval blue as long) as long
Function = red + green*256 + blue*65536
End Function
'----------------------------------------------------------------------
Function Max(byval a as long, byval b as long) as long
iF a>=b
Function =a
else
Function =b
End iF
End Function
'----------------------------------------------------------------------
Function GetRgb(Fab)
cRGB.r = Fab & 0xFF0000
cRGB.g = Fab & 0x00FF00
cRGB.b = Fab & 0x0000FF
End Function
'----------------------------------------------------------------------
Function Text3D(txt as string,x1 as long,y1 as long,farbe as long)
Dim i,l as long
GetRgb farbe
l = Len(txt)
For i=1 To 10
SetTextColor bHdc,Rgb(Max(cRGB.r-i*8,0),Max(cRGB.g-i*8,0),Max(cRGB.b-i*8,0))
TextOut bHdc,x1+i,y1+i,txt,l
Next
End Function
'----------------------------------------------------------------------
Function CreateBuffer(x2 As Long, y2 As Long)
bHnd = CreateCompatibleBitmap(hdc, x2, y2)
bHdc = CreateCompatibleDC(hdc)
SelectObject bHdc, bHnd
xB = x2 : yB = y2
End Function

[Charles Pegge]

Hi Peter,

Many thanks for the demo.

I wasn't sure what you meant but I was able to run your demo with no problems at all here (apart from a minor glitch of my own making on version Alpha012). If you are using Alpha011 there should be no problem.

Charles

[peter]

Hi,

I meant the Variables x1 and y1!
I'm sorry, I have it bad described.

Peter

[Michael Clease]

@Peter can you syntax hightlighting please scrolling through 2 pages for each post is a little bit of a pain in ass thanks.

@Charles can edit the posts to add tags.

Keep up the good work Peter its quite interesting to see what other people are doing.

Mike

[Charles Pegge]

I don't have moderator access in this area but I recommend thinBasic Syntax Highlighting from the list. its the best fit and is easy to read.

Charles

[Petr Schreiber]

Peter,

it is simple, just mark the source code, and pick geShi thinBasic syntax (or other close match), I attach picture for you.


Petr

[peter]

Hi Petr,

That's easy, I know.
I forget this over and over!

Thank you

[peter]

Hello,

here another Demo for you. Download the Graphics please.
I have written three headers files (inc's) for Oxygenbasic.
That comes with the download.
kernel32.inc, gdi32.inc, user32.inc.
In the user32.inc could be a error or Oxygen understands something wrong!
Won't embedded in O2.

Have a look on this dilemma, Chales.


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

%SW_NORMAL = 1
%SW_SHOWDEFAULT = 10
%CS_VREDRAW = 1
%CS_HREDRAW = 2
%IDI_APPLICATION = 32512
%IDC_ARROW = 32512
%WM_CREATE = 1
%WM_DESTROY = 2
%WM_PAINT = 15
%WM_QUIT = 18
%SW_SHOW = 5
%SM_CXSCREEN = 0
%SM_CYSCREEN = 1
%WS_OVERLAPPEDWINDOW &h00CF0000

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

Bind kernel32
(
GetCommandLine GetCommandLineA
GetModuleHandle GetModuleHandleA
ExitProcess ExitProcess
sleep Sleep
)

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 GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
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 LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Declare Function SelectObject Lib "gdi32.dll" Alias "SelectObject" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32.dll" Alias "CreateCompatibleDC" (ByVal hdc As Long) As Long
Declare Function BitBlt Lib "gdi32.dll" Alias "BitBlt" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" Alias "DeleteObject" (ByVal hObject As Long) As Long
Declare Function PatBlt Lib "gdi32.dll" Alias "PatBlt" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Declare Function DeleteDC Lib "gdi32.dll" Alias "DeleteDC" (ByVal hdc As Long) 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 LoadBitMap(bmp As String) As Long
Declare Function ClearSprite()
Declare Function Sprite(x As Long,y As Long,F As Long)

Dim byref cmdline as asciiz,inst as long
Dim hdc,BmpHnd,BmpHdc,xPos,yPos,cF,cR hBmp as long
Dim a as single

xPos =40 : yPos =160 : cF =0 : cR =1
&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 long
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 0
wc.lpszMenuName =0
wc.lpszClassName ="Demo"
RegisterClass &wc

Wwd = 620 : Wht = 480
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
iF wMsg = WM_CREATE
hdc = GetDC(hwnd)
hBmp = LoadBitMap "Fmouse.bmp"

elseif wMsg = WM_PAINT
ClearSprite
Sprite xPos +252+sin(a*pi)*20, yPos+cos(a*pi)*20, cF
Sprite xPos +264+sin(a*pi)*90, yPos+cos(a*pi)*60, cF
iF cR =1
yPos = yPos -1
iF yPos <= 0 Then cR =2
ElseiF cR =2
yPos += 1
iF yPos >=420 Then cR =1
End iF
cF += 1
iF cF = 4 Then cF =0
a +=.1
iF a =36 Then a =0
Sleep 100
ValidateRect hwnd,0

elseif wMsg = WM_DESTROY
DeleteObject hBmp
DeleteDC BmpHdc
DeleteDC hdc
PostQuitMessage 0
else
Function = DefWindowProc hWnd,wMsg,wParam,lParam
End iF
End Function
'========================================================
Sub Sprite(x As Long,y As Long,F As Long)
BitBlt hdc,x,y,32,32,BmpHdc,F*32,0,&hcc0020
End Sub
'========================================================
Function ClearSprite()
PatBlt hdc, 0, 0, 640,480, &hFF0062
End Function
'========================================================
Function LoadBitMap(bmp As String) As Long
BmpHnd = LoadImage(0, bmp, 0, 0, 0, 16)
BmpHdc = CreateCompatibleDC(hdc)
SelectObject BmpHdc, BmpHnd
Function = BmpHnd
End Function

[Charles Pegge]

Many thanks Peter, your demo is working well here. I will investigate the USER32.INC and see if I can fix the problem. But first I need some sleep to clear the cotton wool from my brain.

Charles

[Charles Pegge]

Hello again Peter,

I found these two lines in your USER32.INC




%WM_QUERYEnd TypeESSION = &H0011

%WM_End TypeESSION = &H0016


ammended to:


%WM_QUERYEndSESSION = &H0011

%WM_EndSESSION = &H0016


In Oxygen % is treated more like a macro than a simple equate but I will see whether this kind of error can be trapped at the point of occurence.

Charles

[peter]

Hello Charles,

I see now, there is a space in it.
That was really a wrong detail.
I don't know, how that happened.

Have I got bad books or am I a dreamer ?

What is 'ammended' ? This word is unknown to me!

Thank you

[Charles Pegge]

Hi Peter,

It looks like a find-and-replace error since the 'S' was missing from 'Session'

My spelling was incorrect: Amended is another word for 'corrected' or 'fixed'. It is one of the older English words less used now.

Charles

[peter]

Hello Charles,

I saw remarkable behaviour by this program. (Attached Files)
It seems that it need a lot of memory.

if you see in task manager (processes),
you will notice that the memory get more and more.

The directives ( and, or, && ,||) seem not correctly to work !
have Found a way with round brackets!
But isn't the best solution!

Another problem is a game loop!
This won't work.

[Charles Pegge]

Hi Peter,

Thanks for your sample code. I didn't know how easy PlaySound was!.

If you need an unconditional loop..

do
exit do
continue do
end do



The logical parts of an expression should normally be enclosed by brackets.

if ((d=8)and(value=16)) or ((d=8)and(a=0)) or(value=32) '...


The dramatic memory leak you saw was due to a missing BeginPaint..EndPant around the textout commands.

I have reworked the code to include the necessary changes here.

Charles



#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

type PAINTSTRUCT
; 64 bytes
hDC as long
fErase as long
rcPaint as rect
fRestore as long
fIncUpdate as long
rgb as rgbacolor
Reserved as 32
end type

%SW_NORMAL = 1
%SW_SHOWDEFAULT = 10
%CS_VREDRAW = 1
%CS_HREDRAW = 2
%IDI_APPLICATION = 32512
%IDC_ARROW = 32512
%WHITE_BRUSH = 0
%BLACK_BRUSH = 4
%WM_CREATE = 1
%WM_DESTROY = 2
%WM_PAINT = 15
%WM_CLOSE = 16
%WM_QUIT = 18
%WM_SIZE = 5
%WM_KEYDOWN = 256
%SW_SHOW = 5
%SM_CXSCREEN = 0
%SM_CYSCREEN = 1
%WS_DLGFRAME = &h400000
%WS_POPUP = &h80000000
%WS_OVERLAPPEDWINDOW = &h00cf0000

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 ; @8
LoadCursor LoadCursorA ; @8
RegisterClass RegisterClassA ; @4
MessageBox MessageBoxA ; @4
CreateWindowEx CreateWindowExA ; @48
ShowWindow ShowWindow ; @8
UpdateWindow UpdateWindow ; @4
GetMessage GetMessageA ; @16
TranslateMessage TranslateMessage ; @4
DispatchMessage DispatchMessageA ; @4
PostQuitMessage PostQuitMessage ; @4
BeginPaint BeginPaint ; @8
EndPaint EndPaint ; @8
GetClientRect GetClientRect ; @8
DrawText DrawTextA ; @20
PostMessage PostMessageA ; @16
DefWindowProc DefWindowProcA ; @16
EnumChildWindows EnumChildWindows ; @12
MoveWindow MoveWindow ; @24
DestroyWindow DestroyWindow ; @4
GetWindowLong GetWindowLongA ; @8
FillRect FillRect
GetDC GetDC ; @4
ReleaseDC ReleaseDC ;
SetTimer SetTimer ;
KillTimer KillTimer ;
)

Bind gdi32
(
GetStockObject GetStockObject
)

Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
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 DeleteDC Lib "gdi32.dll" Alias "DeleteDC" (ByVal hdc As Long) As Long
Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) 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 HighWord(byval high as long) as long
Declare Function LowWord (byval low as long) as long
Declare Function Rgb(red as long, green as long, blue as long) as long

Dim byref cmdline as asciiz,inst as long
Dim hdc,xmax,ymax as long
Dim a,b,c,d,e,value as long
Dim gosh(10) as long

&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 long
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 = 320 : Wht = 256
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

'static sys a,b,c,d,value,gosh(10),hdc
static as PaintStruct Paintst

iF wMsg = WM_CREATE

hdc = GetDC(hwnd)
a=1 : b=2 : c=4 : d=8 : value=32 : gosh(1)=10 : gosh(2)=20

elseif wMsg = WM_PAINT

hDC=BeginPaint hWnd,&Paintst

iF ((a=1)and(b=2)) or (c=4) 'true
PlaySound "c:/windows/media/tada.wav",0,1
end if

b=0 : c=0

iF (d=8) and (a=1) 'true
TextOut hdc,100,150,"HUHU!",5
end if

iF d=8 'true
if a=1 'true
TextOut hdc,100,100,"HALLO MASTER",12
a=0
End iF
End iF

'iF (d=8 and value=16) or ((d=8 and a=0) or value=32) then TextOut hdc,100,50,"HELP!",5

if ((d=8)and(value=16)) or ((d=8)and(a=0)) or(value=32) 'true
TextOut hdc,100,50,"HELP!",5
end if

iF (gosh(1)=10)and(gosh(2)=20) 'true
TextOut hdc,100,20,"GOSH!",5
end iF

EndPaint hWnd,&Paintst
ValidateRect hwnd,0

elseif wMsg = WM_SIZE

xmax = LowWord (lParam)
ymax = HighWord(lParam)

elseif wMsg = WM_DESTROY

DeleteDC hdc
PostQuitMessage 0
else

Function = DefWindowProc hWnd,wMsg,wParam,lParam
End iF

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 Rgb(red as long, green as long, blue as long) as long
Function = red + green*256 + blue*65536
End Function

[peter]

Hi Charles,

I cannot believe this!
I get no memory leak if I take C or Assembler.

#include <windows.h>
void DrawMe(HDC hdc)
{
TextOut(hdc,50,50,"Hallo, World!",13);
}

LRESULT CALLBACK WindowProc(HWND hwnd, UINT m, WPARAM wParam,LPARAM lParam)
{
HDC hdc;
if m==WM_PAINT
{
hdc = GetDC(hwnd);
DrawMe;
ReleaseDC(hwnd,hdc);
ValidateRect(hwnd,0);
}
else if (m==WM_DESTROY)
PostQuitMessage(0);
else
return DefWindowProc(hwnd,m,wParam,lParam);
return 0;
}

No memory leak here!
No EndPaint here!

Cheerio!

[Charles Pegge]

Peter,

In the example you give here, you use releaseDC which I think has the same effect. In your prior example there was no ReleaseDC.

Try running the code without it and see if you get a memory leak :)

Charles

[Charles Pegge]

Ah yes. I see what is happening! The BeginPaint .. EndPaint gives single shot paint. If omiitted then the screen is continuously repainted. And this has exposed a memory leak somewhere in my TempString system. Some temp strings are not being released. I will get this fixed today I hope.

Thanks.

Charles.

[Charles Pegge]

After 'plugging' the leaks - I find the situation is a little more complicated. Oxygen makes intensive use of Bstrings and I find that even when all the Bstrings are freed with SysFreeString, discarded strings can remain in memory (as seen in Task Manager) till the process ends. The OS does not bother to clean up when there is spare memory available. So you cannot always tell whether there is a genuine memory leak or not.

Charles

[peter]

Hi Charles,

sounds good!
I have noticed, that " SciTE.exe" also shows such a behaviour.
I have it watched, while I'm writing a test.

Regards

[peter]

Hello Charles,

cannot come in the Forum !
It tells me: That user name is unknown.

lol

[Charles Pegge]

Hi Peter,

Very sorry about that. John and myself had to put in new spam traps. When we removed the visual numbers test required for registration, the site was targeted by a number of spam bots like a swarm of gnats. It's cyber warfare out there! I don't know what happened to your account in the process.

Please drop me your email address in a personal message here and I will register you again. Alternatively you can try and register yourself and see if it accepts your name this time.

Charles

[peter]

Hi Charles,

I am back again in your Forum. Thank you for your helping.
I cannot upload my software.
Download it from here!

I know, it's no good idea because it is no thinBasic Soft.
But this is the first Oxygen game in the world.

Regards

[John Spikowski]

@Peter - I have increased the max attachment size to 5 MB with a max of 4 attachments per post for a total of 10 MB.

@Eros - I keep getting script errors when accessing the site. I'm now on Linux using Firefox and didn't notice this with Firefox under Windows. Is this new?


A script on this page may be busy, or it may have stopped responding. You can stop the script now, or you can continue to see if the script will complete.

Script: http://kona.kontera.com/javascript/lib/2010_10_25/KonaFlashBase.js:28

[peter]

Cool John,

I will have no problems with further projects.

Thanks