Hi Charles,
unfortunately, I haven't been able to work with Oxygenbasic as intensively as I would like. But I noticed that you made some changes to "redim". This causes the programs in \Wingui\Autosizing to crash. The error message is in autosizing.inc in line 73 and line 148:
error: Array member not found
word: pinctl_rec.destructor
col: 16
line: 73
file: autosizing.inc
The whole construct consists of:
sizing_data
PinCtl_Rec
MaxPinnedCtls
MaxPinned
at the moment I don't know where I have to apply the constructor / destructor?
Autosizing Folder contain few demos and SmallApp
and all programs work ...so how you get that error is mistery ?
I use Version:
0.7.0 2024-01-01T14:45:45 32bit
and I think this is current. I know autosizing.inc works with previous versions but I missed some of the latest progress and the improvement of redim. I don't know yet how this will affect the file.
Yes, I see the problem! It's affecting UDT/Class variables with redim ...
Well
I really never use ReDim command in o2 ..i think in any Basic
I think that this command is problematic.
yes i tried with older 0.6.0 2023 06-03T07
btw..
when we talking about autosize of controls inside
window ...it is prefered way to use
WM_SIZE message and put all sizing inside this message ?
I'm making progress with redim on UDTs and will need to do a few more tests. It's highly combinatorial with primitives, UDTs, classes, multi-dimensions, static and dynamic..
Does it mean i can make UDT's with dynamic strings?
It would be a large improvement compared to Powerbasic.
I think Powerbasic was on the way to auto-redim when Bob passed away.
PS: Thought of making a new Setup,
but saw there has been a bug somewhere and now waiting for a stable version.
Yes Theo, there are no restrictions on what members you can use in a UDT, including dynamic strings. But you have to be careful when instantiating such UDT variables locally inside a function and then returning the variables. The local dynamic strings will get garbage-collected at the end of the function. The solution is to use bstrings instead of strings. These are also dynamic but not automatically garbage-collected.
The current problem with redim, is due to the _del macro being invoked inside the redim macro
Hi Charles,
at the moment I run programs every now and then and in demos\!ProjB\WinP the app SpaceInvaders.o2bas does not work. I assume line 194 must read:
call PlayWav "../GDI/cosmobumm.wav",0,1
but the error occurs in line 73:
error: unexpected end of prog
word : idx
proc: setexplos
col: 7
line: 73
file: 'main source'
although no redim, maybe it's a similar problem?
Btw: do you know why Peter left the old forum?
Thanks Roland,
It is the Dim inside a type. I have restored tolerance of this word. It is rarely used inside a type but I think the semantics are okay in Basic.
Perhaps Peter Wirbelauer got carried away by his Dancing Gnomes :). He got some fairly hostile treatment from John Spikowski and Mike Lobanovsky, which was not unusual on the Oxygen Forum. His APIs and demo code are specialized for single window 2d games. Compact and elegant.
Hey Roland Here is a fixed Version and its running Well :) of Ufo Game
'fixed version, 08-02-2024 by frank bruebach, oxyenbasic
'
include "win.inc"
int i
sys SetTimer = CallDll(user,"SetTimer")
sys KillTimer= CallDll(user,"KillTimer")
Screen 800,600,1
SetCaption "UFFO"
SetColorKey 255,0,255
ShowMouse 0
Type uBomb
x as long
y as long
z as Single
End Type
Type Uffo
x as long
y as long
z as long
r as long
i as long
n as long
End Type
Type Rocket
x as long
y as long
r as long
End Type
Type Explosion
x as long
y as long
i as long
z as single
End Type
Dim Meg(40) as uBomb
Dim Ufo(40) as Uffo
Dim Bum(40) as Explosion
Dim Rok(40) as Rocket
sys xRak,yRak,rRak,zRak,iBx,iDx,iCx,iAx,zFrame,z1,z2,z3,px,sc,uz,jx,drop,Ok
sys ufos,miss,ship,bomb expl,bknd
'bknd= LoadBmp "media/bground.bmp",1
ufos= LoadBmp "media/ufos.bmp",8
miss= LoadBmp "media/missile.bmp",8
ship= LoadBmp "media/ships.bmp",8
bomb= LoadBmp "media/bomb1.bmp",8
expl= LoadBmp "media/explode.bmp",8
Function Timer1() as long callback
zFrame +=1
iF zFrame =8 Then zFrame =0
End Function
Function Timer2() as long callback
jx +=1
iF jx =21 Then jx=0
End Function
Function Timer3() as long callback
Drop = Rand(0,40)
End Function
z1= call SetTimer hwnd,1,140,&Timer1
z2= call SetTimer hwnd,2,200,&Timer2
z3= call SetTimer hwnd,3,150,&Timer3
Sub SetExplos(sys x, y, i)
For iDx=0 To 39
iF Bum(iDx).y =0
Bum(iDx).x = x
Bum(iDx).y = y
Bum(iDx).i = i
Exit Sub
End iF
Next
End Sub
Sub ShowExplos()
For iDx=0 To 39
iF Bum(iDx).i =1
SetBmp expl,Bum(iDx).x,Bum(iDx).y,96,96,Bum(iDx).z
Bum(iDx).z +=.1
iF Bum(iDx).z >=8.0
Bum(iDx).z =0
Bum(iDx).y =0
Bum(iDx).i =0
End iF
End iF
Next
End Sub
Sub SetRocket(sys x, y)
For iAx=0 To 39
iF Rok(iAx).y =0
Rok(iAx).x = x
Rok(iAx).y = y
Rok(iAx).r = 1
Exit Sub
End iF
Next
End Sub
Sub ScanRocket()
For iAx=0 To 39
iF Rok(iAx).r =1 and Rok(iAx).y <=-32
Rok(iAx).r =0: Rok(iAx).y =0
End iF
Next
End Sub
Sub ShowRocket()
For iAx=0 To 39
iF Rok(iAx).r =1
SetBmp miss,Rok(iAx).x,Rok(iAx).y,64,64,zFrame
Rok(iAx).y -=1
iF Rok(iAx).y =400 Then zRak=0
End iF
Next
End Sub
Sub ScanRakete()
iF rRak=5 Then Exit Sub
iF Key(32)<>0 and Key(39)<>0 and zRak =0
SetRocket xRak,yRak
rRak =1
zRak =1
call PlayWav "media/shoot.wav",0,1
ElseiF Key(32)<>0 and Key(37)<>0 and zRak=0
SetRocket xRak,yRak
rRak =2
zRak =1
call PlayWav "media/shoot.wav",0,1
ElseiF Key(32)<>0 and zRak=0
SetRocket xRak,yRak
zRak =1
call PlayWav "media/shoot.wav",0,1
ElseiF Key(39)<>0 and xRak<736
rRak =1
ElseiF Key(37)<>0 and xRak>0
rRak =2
Else
rRak =0
End iF
End Sub
Sub ShowRakete()
iF rRak =0
SetBmp ship,xRak,yRak,64,64,zFrame
ElseiF rRak =1
SetBmp ship,xRak,yRak,64,64,zFrame
xRak +=1
ElseiF rRak =2
SetBmp ship,xRak,yRak,64,64,zFrame
xRak -=1
End If
End Sub
Function Collision(sys x1, y1, r1, x2, y2, r2) as sys
iF (x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)<(r1+r2)*(r1+r2)
Return 1
End iF
End Function
Sub RocketCollision()
For iBx=0 To uz
For iCx=0 To 39
iF Rok(iCx).r >0 And Ufo(iBx).r >0
iF Collision Rok(iCx).x+32,Rok(iCx).y+32,16,Ufo(iBx).x+32,Ufo(iBx).y+32,16
SetExplos Rok(iCx).x,Rok(iCx).y,1
SetExplos Ufo(iBx).x,Ufo(iBx).y,1
Rok(iCx).r =0: Rok(iCx).y =0
Ufo(iBx).r =0: Ufo(iBx).y =0
call PlayWav "media/plode.wav",0,1
sc +=25
Exit For
End iF
End iF
Next
Next
End Sub
Sub RaketeCollision()
iF Ok=1 Then Exit Sub
For iAx=0 To 40
iF Meg(iAx).y >0
iF Collision xRak,yRak,16,Meg(iAx).x,Meg(iAx).y,16
SetExplos xRak,yRak,1
rRak=5: Ok=1
'call PlayWav "media/xship.wav",0,1
call PlayWav "../GDIWindow/cosmobumm.wav",0,1
Exit Sub
End iF
End iF
Next
End Sub
Sub SetUfos()
For iAx=0 To uz
Ufo(iAx).x = Rand(16,736)
Ufo(iAx).y = Rand(16,300)
Ufo(iAx).r = Rand(1,4)
Ufo(iAx).z = 0
Ufo(iAX).n = 0
Next
End Sub
Sub ScanUfos()
For iBx=0 To uz
iF Ufo(iBx).r =1 and Ufo(iBx).x >=736
Ufo(iBx).r =2
ElseiF Ufo(iBx).r =2 and Ufo(iBx).x <=0
Ufo(iBx).r =1
ElseiF Ufo(iBx).r =3 and Ufo(iBx).y <=0
Ufo(iBx).r =4
ElseiF Ufo(iBx).r =4 and Ufo(iBx).y >=350
Ufo(iBx).r =3
ElseiF jx =5 and Ufo(iBx).r =4
Ufo(iBx).r = Rand(1,4)
ElseiF jx =10 and Ufo(iBx).r =3
Ufo(iBx).r = Rand(1,4)
ElseiF jx =15 and Ufo(iBx).r =2
Ufo(iBx).r = Rand(1,4)
ElseiF jx =20 and Ufo(iBx).r =1
Ufo(iBx).r = Rand(1,4)
End iF
Next
End Sub
Sub ShowUfos()
For iBx=0 To uz
iF Ufo(iBx).r =1
SetBmp ufos,Ufo(iBx).x,Ufo(iBx).y,64,64,zFrame
Ufo(iBx).x +=1
ElseiF Ufo(iBx).r =2
SetBmp ufos,Ufo(iBx).x,Ufo(iBx).y,64,64,zFrame
Ufo(iBx).x -=1
ElseiF Ufo(iBx).r =3
SetBmp ufos,Ufo(iBx).x,Ufo(iBx).y,64,64,zFrame
Ufo(iBx).y -=1
ElseiF Ufo(iBx).r =4
SetBmp ufos,Ufo(iBx).x,Ufo(iBx).y,64,64,zFrame
Ufo(iBx).y +=1
End iF
Next
End Sub
Sub SetData
xRak=384:yRak=536:rRak=0
uz=40:sc=0:Ok=0
SetUfos
For iBx=0 To 40
Meg(iBx).y =0
Meg(iBx).x =0
Next
End Sub
Sub TestUfos()
For iAx=0 To 40
iF Ufo(iAx).y >0 or Ok=1 Then Exit Sub
Next
Ok=1
End Sub
Sub ScanUfoBombs()
For iAx=0 To drop Step 2
iF Ufo(iAx).r >0
iF Meg(iAx).y=0
Meg(iAx).x = Ufo(iAx).x
Meg(iAx).y = Ufo(iAx).y+32
End iF
End iF
Next
End Sub
Sub UfoBombs()
For iDx=0 To 40
iF Meg(iDx).y >0
iF iDx <20
SetBmp bomb,Meg(iDx).x,Meg(iDx).y,64,64,zFrame
ElseiF iDx >=20
SetBmp bomb,Meg(iDx).x,Meg(iDx).y,64,64,zFrame
End iF
Meg(iDx).y +=1
iF Meg(iDx).y >=600 Then Meg(iDx).y =0
End iF
Next
End Sub
'Main
'====
SetData()
While Key(27)=0
'SetBmp bknd,0,0,800,600,0
'ClsColor 10,0,90
for i=0 to 599
line 0,i,799,i,1,0,0,i >>2 'shaded sky
next
SetText 600,0,"SCORE:" + sc,255,255,255
ScanUfos
ShowUfos
ScanRocket
ShowRocket
ScanRakete
ShowRakete
ScanUfoBombs
UfoBombs
ShowExplos
RocketCollision
RaketeCollision
TestUfos
iF Ok=1
SetText 328,300,"Once again? ",255,250,245
SetText 328,320,"Hit [c] Key",200,245,255
iF Key(0x43) <>0 Then SetData
End iF
Flip
SetFps 80 'select your speed :)
Wend
call KillTimer hwnd,z1
call KillTimer hwnd,z2
call KillTimer hwnd,z3
'Ends
End
QuotePerhaps Peter Wirbelauer got carried away by his Dancing Gnomes
Yeah..i am wondering where is that guy
I like him. ;)
Hi Frank,
your modifications in type uBomb, Uffo, Rocket and Explosion will work, although you have also to change in line 196: GDIWindow to GDI, otherwise you will miss the final big "Bumms". I never used dim in defining members a type, but in previous versions this was supported.
Quote from: Charles Pegge on February 07, 2024, 10:11:17 AMYes Theo, there are no restrictions on what members you can use in a UDT, including dynamic strings. But you have to be careful when instantiating such UDT variables locally inside a function and then returning the variables. The local dynamic strings will get garbage-collected at the end of the function. The solution is to use bstrings instead of strings. These are also dynamic but not automatically garbage-collected.
The current problem with redim, is due to the _del macro being invoked inside the redim macro
@Charles Pegge I would expect that local variables are of course deleted after leaving a SUB/Function.
But I expect Global Variables to stay persistant even if been changed inside a SUB Function.
In PB i currently have STRINGS and WStrings.
BStrings i only know from being type of System-Strings. What string types are available in there?
And why do i need several of these?
Hi Theo,
If the UDT variables are instantiated in global or static space, there won't be garbage-collection problems. The GC for these variables is only executed at the end of the program.
For dynamic string, we have strings, wstrings, and correspondingly, bstrings and wbstrings
This is the current list of primitives and their internal codings:
void 15 0x10 '* Used by-reference only
sbyte 15 0x01
byte 15 0x21
ubyte 15 0x21
string 15 0xe1
wstring 15 0xe2
bstring 15 0xc1
gstr_ 15 0xc1 '* Accept any Bstring width. for core functions only
bstr 15 0xc1
wbstring 15 0xc2
char 15 0xa1
wchar 15 0xa2
cstr_ 15 0xa1 '* Accept any char width. for core functions only
pstr_ 15 0xb1 '* Accept any char width. for core functions (len returned in ecx)
asciiz 15 0xa1
zstring 15 0xa1
wzstring 15 0xa2
short 15 0x02
long 15 0x04
wide 15 0xa2
int 15 0x04
integer 15 0x04
float 15 0x64
single 15 0x64
double 15 0x68
extended 15 0x6A
quad 15 0x48 ''* using FPU on 32 bit systems (was 08), returns data on edx:eax
word 15 0x22
dword 15 0x24
ulong 15 0x24
uint 15 0x24
usys 15 0x28 '* 64 bit only
qword 15 0x58 '* using FPU on 32 bit systems
any 15 0x08 '* to be used by reference only
sys 15 0x08 '* 4/8 depending on 32/64 bit system
bool 15 0x04 '* MS
boolean 15 0x01 '* MS
fpu 15 0x40 '* fast call using fpu registers (not exportable)
signed 15 0x04
unsigned 15 0x24
'===========================================
I have fixed the redim / autodim problem, and uploaded a temp version to GITHUB. It is simply called OxygenBasic.zip, a work in progress which I will update very frequently. It is the same as my local backups, so it could be updated as frequently as twice a day.
This provides immediate access to new features and bug fixes.
https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic.zip
Hi Charles,
my virus program Defender prevented me from downloading Oxygenbasic.zip for a while, but everything seems to be fine now.
Thanks for restoring redim with types. This means that some workarounds are not necessary.
While checking the code of SmallApp.o2bas I noticed a logical error. I had added a vertical splitter, but I called it horizontal. I renamed the variables, the logic of the program did not change. Maybe you will replace the app?
I designed the splitter like I found in some other programs. When you move the cursor between ListView and EditBox, the shape of the cursor changes. Drag and drop can be applied by pressing and releasing the left mouse button.
I remember that I also wanted to display a horizontal splitter and possibly connect splitters with autosizing. Maybe I can continue with this project again.
PS: deleted the images
SmallApp.o2bas:
$ filename "SmallApp.exe"
'uses rtl32
'uses rtl64
'Get path of Oxygenbasic
string o2dir = "..\..\..\"
'Messageloop in WinUtil
sys hAccel
macro InMessageLoop
if TranslateAccelerator( hWnd, hAccel, @wm ) = 0 then
if not IsDialogMessage(hWnd, &wm) then
TranslateMessage(&wm)
DispatchMessage(&wm)
end if
end if
end macro
uses WinUtil
uses dialogs
uses autosizing
% DS_MODALFRAME=0x80
% SS_CENTERIMAGE=0x200
% GCL_HICON= -14
% TBSTYLE_TOOLTIPS=0x100
% TBSTYLE_FLAT=0x800
% TBSTATE_ENABLED=4
% TBSTYLE_BUTTON=0
% TB_BUTTONSTRUCTSIZE=1054
% TB_ADDBITMAP=1043
% TB_ADDBUTTONS=1044
% TB_AUTOSIZE=1057
% LR_LOADTRANSPARENT=32
% SBARS_SIZEGRIP=256
% MF_UNCHECKED=0
% MF_CHECKED=8
% TB_ENABLEBUTTON=1025
% SS_GRAYRECT=5
% WM_SETCURSOR=32
% GCL_HCURSOR= -12
% IDC_SIZEWE=32644
'htmlhelp.h
% HH_DISPLAY_TOPIC=0x0000
% TTN_FIRST -520
% TTN_NEEDTEXT (TTN_FIRST-0)
'htmlhelp.h
type HH_AKLINK
int cbStruct
bool fReserved
char* pszKeywords
char* pszUrl
char* pszMsgText
char* pszMsgTitle
char* pszWindow
bool fIndexOnFail
end type
! HtmlHelp lib "hhctrl.ocx" alias "HtmlHelpA" (dword hwndCaller, char* pszFile, dword uCommand, dword dwData) as sys
type TBBUTTON
int iBitmap
int idCommand
byte fsState
byte fsStyle
byte bReserved[2]
dword dwData
int iString
end type
type TBADDBITMAP
sys hInst
sys nID
end type
type NMTTDISPINFO
NMHDR hdr
char* lpszText
zstring szText[80]
sys hinst
uint uFlags
sys lParam
end type
typedef NMTTDISPINFO TOOLTIPTEXT
================================================================================
'Menu IDs
% IDM_FILEMENU = 1000
% IDM_OPEN = 1001
% IDM_CLOSE = 1002
% IDM_EXIT = 1003
% IDM_VIEWMENU = 1010
% IDM_TOOLBAR = 1011
% IDM_STATUSBAR = 1012
% IDM_HELPMENU = 1020
% IDM_HELPTOPICS = 1021
% IDM_ABOUT = 1022
'Control Handles
sys hIcon
sys hMenu, hToolBar, hStatusBar, hListbox, hEdit, hButton, hVSplit
' Control IDs
% IDI_ICON = 100
% ID_TOOLBAR = 200
% ID_STATUSBAR = 201
% ID_LISTBOX = 202
% ID_EDIT = 203
% ID_BTN = 204
% ID_VSPLIT = 205
================================================================================
'Get Icon
string fullname
fullname = o2dir + "tools\OxideIcon.ico"
hIcon = LoadImage( 0, fullname, IMAGE_ICON,0,0, LR_LOADFROMFILE )
if hIcon=null then mbox "Cannot load " + fullname +"!"
'Bitmps for Toolbar and Menu
sys hOpenBmp = LoadImage( 0, "Open.bmp", IMAGE_BITMAP,0,0, LR_LOADFROMFILE or LR_LOADTRANSPARENT )
if hOpenBmp=null then mbox "Connot load hOpenBmp"
sys hCloseBmp = LoadImage( 0, "Close.bmp", IMAGE_BITMAP,0,0, LR_LOADFROMFILE or LR_LOADTRANSPARENT )
if hCloseBmp=null then mbox "Connot load hCloseBmp"
sys hAboutBmp = LoadImage( 0, "About.bmp", IMAGE_BITMAP,0,0, LR_LOADFROMFILE or LR_LOADTRANSPARENT )
if hAboutBmp=null then mbox "Connot load hAboutBmp"
'Get name of OxygenBasic Help file
string HelpFile = o2dir & "inf\oxygen_help.chm"
'Register special common control classes
init_common_controls()
'forward references
#lookahead
MainWindow 600, 420 , WS_OVERLAPPEDWINDOW
function WndProc(sys hwnd, uint MainMsg, sys wParam, lParam) as sys callback
'Check for Splitter
if MainMsg=WM_MOUSEMOVE or MainMsg=WM_LBUTTONDOWN or MainMsg=WM_LBUTTONUP then
SplitterEvents(hwnd, MainMsg, wParam, lParam)
end if
select MainMsg
case WM_CREATE
'Set Icon for MainWindow
SetClassLongPtr(hwnd, GCL_HICON, hIcon )
SetWindowText(hwnd, "A Small App")
'Create Controls
addMenu(hwnd)
addToolbar(hwnd)
addStatusBar(hwnd)
addListbox(hwnd)
addEdit(hwnd)
addButton(hwnd)
addVertSplit(hwnd)
'Attach Controls
pinCtl(hListbox, hwnd, "TL","BL")
pinCtl(hEdit, hwnd, "TL","BR")
pinCtl(hButton, hwnd, "BL")
pinCtl(hVSplit, hwnd, "TL","BL")
'Start with Button disabled
EnableWindow(hButton, false)
case WM_COMMAND
select case loword(wParam)
case IDM_EXIT
DestroyWindow( hwnd )
case IDM_ABOUT
Dialog( 0,0,144,77, "About Small App Sample",
DS_MODALFRAME | DS_CENTER | WS_CAPTION | WS_POPUP or WS_SYSMENU or DS_SETFONT or DS_CENTER,
8,"MS Sans Serif" )
CONTROL "OK",IDOK,"Button",WS_CHILD|WS_VISIBLE, 54,51,40,14
CONTROL "A small app demo",-1,"Static",WS_CHILDWINDOW|WS_VISIBLE, 50,17,92, 8
CONTROL "in OxygenBasic",-1,"Static",WS_CHILDWINDOW|WS_VISIBLE, 50,27,70, 8
CONTROL( "",IDI_ICON, "STATIC", SS_ICON|SS_CENTERIMAGE, 0, 0,40,40 )
CreateModalDialog( hwnd, @AboutDlgProc, 0 )
case IDM_TOOLBAR
int offs=getControlHeight(hToolBar)
if GetMenuState(hMenu, IDM_TOOLBAR, MF_BYCOMMAND ) then
CheckMenuItem(hMenu, IDM_TOOLBAR, MF_BYCOMMAND or MF_UNCHECKED)
ShowWindow(hToolBar, SW_HIDE)
'correct offsets
modpinCtl(hListbox, 0, -offs, 0, -offs)
modpinCtl(hEdit, 0, -offs)
modpinCtl(hVSplit, 0, -offs)
else
CheckMenuItem(hMenu, IDM_TOOLBAR, MF_BYCOMMAND or MF_CHECKED)
ShowWindow(hToolBar, SW_SHOW)
'correct offsets
modpinCtl(hListbox, 0, offs, 0, offs)
modpinCtl(hEdit, 0, offs)
modpinCtl(hVSplit, 0, offs)
end if
SendMessage(hwnd, WM_SIZE, 0,0)
case IDM_STATUSBAR
int offs=getControlHeight(hStatusBar)
if GetMenuState(hMenu, IDM_STATUSBAR, MF_BYCOMMAND ) then
CheckMenuItem(hMenu, IDM_STATUSBAR, MF_BYCOMMAND or MF_UNCHECKED)
ShowWindow(hStatusBar, SW_HIDE)
'Listbox needs no change
modpinCtl(hEdit, 0, 0, 0, offs)
modpinCtl(hVSplit, 0, 0, 0, offs)
else
CheckMenuItem(hMenu, IDM_STATUSBAR, MF_BYCOMMAND or MF_CHECKED)
ShowWindow(hStatusBar, SW_SHOW)
'Listbox needs no change
modpinCtl(hEdit, 0, 0, 0, -offs)
modpinCtl(hVSplit, 0, 0, 0, -offs)
end if
SendMessage(hwnd, WM_SIZE, 0,0)
case IDM_OPEN
mbox "IDM_OPEN message"
EnableMenuItem(hMenu, IDM_OPEN, MF_GRAYED )
EnableMenuItem(hMenu, IDM_CLOSE, MF_ENABLED )
SendMessage(hToolBar, TB_ENABLEBUTTON, IDM_OPEN, false )
case IDM_CLOSE
mbox "IDM_CLOSE message"
EnableMenuItem(hMenu, IDM_CLOSE, MF_GRAYED )
EnableMenuItem(hMenu, IDM_OPEN, MF_ENABLED )
SendMessage(hToolBar, TB_ENABLEBUTTON, IDM_OPEN, true )
case ID_LISTBOX
if hiword(wparam) = LBN_SELCHANGE then
'get index of List, zero-based
int index = SendMessage(hListbox, LB_GETCURSEL, 0, 0)
if index>0 then EnableWindow(GetDlgItem(hwnd, ID_BTN), true)
SetWindowText(GetDlgItem(hwnd,ID_EDIT), "Here will be the description of Position " index+1)
end if
case ID_BTN
int index = SendMessage(hListbox, LB_GETCURSEL, 0, 0)
if index > -1 then mbox "This is an example for position " index+1
case IDM_HELPTOPICS
if HtmlHelp (null , HelpFile & "::/wordlink.htm>!", HH_DISPLAY_TOPIC, null) = null then mbox "Error: Cannot find " HelpFile
end select
case WM_SIZE
SendMessage(hToolBar, TB_AUTOSIZE, 0,0)
SendMessage(hStatusBar, WM_SIZE, 0, 0 )
resizeControls(hwnd)
case WM_GETMINMAXINFO
setMinSize (450,350)
case WM_NOTIFY
showToolTips(lParam)
case WM_CLOSE
DestroyWindow(hwnd)
case WM_DESTROY
PostQuitMessage(0)
case else
return DefWindowProc(hwnd, MainMsg, wParam, lParam)
end select
return 0
end function
============================================================
sub addMenu(sys hwnd)
MENU(hMenu)
BEGIN
POPUP "&File"
BEGIN
MENUITEM "&Open..." tab "Ctrl+O", IDM_OPEN
MENUITEM "&Close", IDM_CLOSE, GRAYED
MENUITEM "E&xit" tab "Alt-F4", IDM_EXIT
ENDMenu
POPUP "&View"
BEGIN
MENUITEM "&Toolbar", IDM_TOOLBAR, CHECKED
MENUITEM "&Status Bar", IDM_STATUSBAR, CHECKED
ENDMenu
POPUP "&Help"
BEGIN
MENUITEM "&Help Topics" tab "F1", IDM_HELPTOPICS
MENUITEM "SEPARATOR"
MENUITEM "&About...",IDM_ABOUT
ENDMenu
ENDMenu
if SetMenu( hwnd, hMenu ) = 0 then mbox "SetMenu hMenu failed!"
'add image to menu item: Open, About
sys OpenSubMenu=GetSubMenu(hMenu, 0) 'Index base 0
SetMenuItemBitmaps(OpenSubMenu, 0, MF_BYPOSITION , hOpenBmp, 0)
SetMenuItemBitmaps(OpenSubMenu, 1, MF_BYPOSITION , hCloseBmp, 0)
sys AboutSubMenu=GetSubMenu(hMenu, 2) 'Index base 0
SetMenuItemBitmaps(AboutSubMenu, 2, MF_BYPOSITION , hAboutBmp, 0)
'Accelerators
ACCEL accl[] = {
{FVIRTKEY | FCONTROL, asc("O"), IDM_OPEN },
{FVIRTKEY , VK_F1, IDM_HELPTOPICS }
}
hAccel = CreateAcceleratorTable( @accl, 2 )
if hAccel=0 then mbox "Error: Cannot create Accelerators"
end sub
================================================================================
function createControl(string ctlclass, string Caption, sys hParent, int id, x,y,w,h, int Style, optional ExStyle=0, optional sys hInstance=GetModuleHandle(null)) as sys
sys hCtrl
hCtrl=CreateWindowEx(ExStyle, ctlclass, Caption, Style, x,y,w,h, hParent, id, hInstance, null)
if hCtrl=null then mbox "Error: Cannot create " ctlclass
return hCtrl
end function
================================================================================
sub addToolbar(sys hwnd)
TBBUTTON tbb1, tbb2, tbb3
TBADDBITMAP tbab
hToolBar=createControl("ToolbarWindow32", null, hwnd, ID_TOOLBAR, 0,0,0,0, WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS or TBSTYLE_FLAT)
SendMessage(hToolBar, TB_BUTTONSTRUCTSIZE, sizeof(TBBUTTON), 0)
tbab.hInst = null
tbab.nID = hOpenBmp
SendMessage(hToolBar, TB_ADDBITMAP, 1, &tbab)
tbb1.iBitmap = 0 'index based 0
tbb1.fsState = TBSTATE_ENABLED
tbb1.fsStyle = TBSTYLE_BUTTON
tbb1.idCommand = IDM_OPEN
SendMessage(hToolBar, TB_ADDBUTTONS, 1, &tbb1)
tbab.nID = hAboutBmp
SendMessage(hToolBar, TB_ADDBITMAP, 1, &tbab)
tbb2.iBitmap = 1 'index based 0
tbb2.fsState = TBSTATE_ENABLED
tbb2.fsStyle = TBSTYLE_BUTTON
tbb2.idCommand = IDM_ABOUT
SendMessage(hToolBar, TB_ADDBUTTONS, 1, &tbb2)
end sub
sub showToolTips(sys lParam)
' lParam holds the notification
TOOLTIPTEXT *lpttt
&lpttt = lParam
string TTText
if lpttt.hdr.code = TTN_NEEDTEXT then
select lpttt.hdr.idFrom
case IDM_OPEN
TTText="Open File"
case IDM_ABOUT
TTText="About"
end select
lpttt.szText = TTText
end if
end sub
sub addStatusBar(sys hwnd)
hStatusBar = createControl(STATUSCLASSNAME, null, hwnd, ID_STATUSBAR, 0,0,0,0, WS_CHILD or WS_VISIBLE or SBARS_SIZEGRIP)
SetWindowText(hStatusBar, "Ready")
end sub
sub addListbox(sys hwnd)
hListbox = createControl("Listbox", null, hwnd, ID_LISTBOX, 10, 30, 205, 250, WS_CHILD or WS_VISIBLE or WS_VSCROLL or WS_BORDER or WS_TABSTOP or LBS_NOTIFY, WS_EX_CLIENTEDGE)
int x
for x=1 to 200
SendMessage(hListbox, LB_ADDSTRING, 0, "This is position " x)
next
end sub
sub addEdit(sys hwnd)
uint style=WS_CHILD or WS_VISIBLE or ES_LEFT or WS_TABSTOP or WS_VSCROLL or WS_HSCROLL or ES_MULTILINE or ES_AUTOVSCROLL or ES_AUTOHSCROLL or ES_WANTRETURN 'or ES_READONLY
hEdit = createControl("Edit", null, hwnd, ID_EDIT, 220, 30, 355, 305, style, WS_EX_CLIENTEDGE)
end sub
sub addButton(sys hwnd)
hButton = createControl("Button", "Show Example", hwnd, ID_BTN, 30, 300, 100, 20, WS_CHILD or WS_VISIBLE or WS_TABSTOP)
end sub
function getControlHeight(sys hCtl) as int
RECT rc
GetWindowRect(hCtl, &rc)
return rc.bottom - rc.top
end function
function AboutDlgProc( sys hDlg, uint uMsg, sys wParam, lParam) as sys callback
select case uMsg
case WM_INITDIALOG
'Set Icon
SendMessage (GetDlgItem(hDlg,IDI_ICON), STM_SETIMAGE, IMAGE_ICON, hIcon)
SetFocus(GetDlgItem(hDlg,IDOK))
case WM_COMMAND
if loword(wParam) = IDOK then EndDialog( hDlg )
if loword(wParam) = IDCANCEL then EndDialog( hDlg )
case WM_CLOSE
EndDialog(hDlg)
end select
return 0
end function
================================================================================
' Vertical Splitter
sub addVertSplit(sys hwnd)
hVSplit = createControl("Static", null, hwnd, ID_VSPLIT, 215, 30, 6, 305, WS_CHILD or SS_GRAYRECT or SS_Notify, WS_EX_CLIENTEDGE)
end sub
sub SplitterEvents(sys hwnd, uint uMsg, sys wParam, lParam)
static bool MouseIsDragging
static bool MouseMayDrag
static int vertDiff
static short vertPos 'x pos
static RECT rcV_old, rcV
static RECT pRect
select uMsg
case WM_MOUSEMOVE
GetClientRect(hwnd, &pRect)
vertPos=loword(lParam )
if vertPos < 140 then vertPos = 140 'Example button
if vertPos > pRect.right then vertPos=pRect.right-10
if MouseIsDragging=true then
vertDiff=vertPos-rcV.left
rcV.left+=vertDiff
rcV.right+=vertDiff
MoveWindow(hVSplit, rcV.left, rcV.top, rcV.right-rcV.left, rcV.bottom-rcV.top, true)
else
GetWindowRect(hVSplit,&rcV)
MapWindowPoints(HWND_DESKTOP, GetParent(hVSplit), &rcV, 2)
if vertPos >= rcV.left and vertPos <= rcV.right then
MouseMayDrag=true
SetClassLongPtr(hwnd, GCL_HCURSOR, LoadCursor(null, IDC_SIZEWE))
rcV_old.left=rcV.left : rcV_old.top=rcV.top : rcV_old.right=rcV.right : rcV_old.bottom=rcV.bottom
else
MouseMayDrag=false
SetClassLongPtr(hwnd, GCL_HCURSOR, LoadCursor(null, IDC_ARROW))
end if
end if
case WM_LBUTTONDOWN
if MouseMayDrag then
SetCapture(hWnd)
ShowWindow(hVSplit, SW_SHOW)
SetFocus(hVSplit)
MouseIsDragging = true
end if
case WM_LBUTTONUP
if MouseIsDragging then
ReleaseCapture()
MouseIsDragging = false
ShowWindow(hVSplit, SW_HIDE)
MouseMayDrag=false
vertDiff=rcV.left - rcV_old.left
modpinCtl(hVSplit)
modpinCtl(hListbox, 0, 0, vertDiff)
modpinCtl(hEdit, vertDiff)
SendMessage(hwnd, WM_SIZE, 0,0)
end if
end select
end sub
Thanks Roland,
I'll update SmallApp.o2bas, and look forward to further developments.
Yes, Defender occasionally decides o2 is malware and makes life awkward. I know Eros often has similar problems with thinBasic. Reporting false positives and reversing quarantine usually resolves it.
BTW: your png screenshots have gone multi-megabyte.