Oxygen Basic
Programming => Example Code => User Interface => Topic started by: Aurel on March 26, 2018, 03:07:02 AM
-
Here is example in 02progress(043) - Toolbar with imageList and menu with small 16x16 bitmaps
on each menu item.
bitmaps are in attachment - so just add them into same folder.
'toolbar & menu example - o2 /26.3.2018
$ filename "Menu3.exe"
Include "rtl32.inc"
'#lookahead
'structures.......................
Type WNDCLASSEX
cbSize as int
Style as int
lpfnwndproc as sys
cbClsextra as int
cbWndExtra as int
hInstance as int
hIcon as int
hCursor as int
hbrBackground as int
lpszMenuName as int
lpszClassName as int
hIconSm AS int
End Type
Type POINTAPI
x as INT
y as INT
End Type
Type RECT
Left as INT
Top as INT
Right as INT
Bottom as INT
End Type
Type MSG
hwnd as int
message as int
wParam as int
lParam as int
time as dword
pt as POINTAPI
End Type
type NMHDR
int hwndFrom
int idFrom
dword code
End type
'.............................
'constants
% IDI_WINLOGO = 32517
% IDI_APPLICATION = 32512
% IDC_ARROW = 32512
% CS_OWNDC = 32
% CS_DBLCLKS = 0x0008
% SW_NORMAL = 1
% SW_SHOW = 5
% WM_CREATE = 1
% WM_DESTROY = 2
% WM_PAINT = 15
% WM_QUIT = 18
% WM_SIZE = 5
% WM_MOVE = 3
% WM_CHAR = 258
% WM_KEYDOWN = 256
% WM_KEYUP = 257
% WM_MOUSEMOVE = 512
% WM_MBUTTONDOWN = 519
% WM_LBUTTONDOWN = 513
% WM_RBUTTONDOWN = 516
% WM_LBUTTONUP = 514
% WM_RBUTTONUP = 517
% WM_MBUTTONUP = 520
% WM_USER = 0x0400
% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_intMENU = 0x80000
% WS_OVERLAPPED = 0x00000000
% WS_POPUP = 0x80000000
% WS_DLGFRAME = 0x400000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
'defines...
INT WHITE_BRUSH = 8
' bitmaps
% BM_SETIMAGE = 247
% MF_BYPOSITION = &H400
% IMAGE_BITMAP = 0
% COLOR_BTNFACE = 15
% ILC_MASK = 1
% ILC_COLOR8 = 8
% ILC_COLOR16 = 16
% PS_SOLID = 0
% SRCCOPY = 0xCC0020
'toolbar & tooltips constants ................................
% TOOLBARCLASSNAME = "ToolbarWindow32"
% TB_SETTOOLTIPS = 1060
% TB_BUTTONSTRUCTSIZE = 1054
% TB_SETBUTTONSIZE = (WM_USER + 31)
% TB_SETBUTTONWIDTH = (WM_USER + 59)
% TB_ADDBITMAP = 1043
% TB_ADDBUTTONS = 1044
% TBSTATE_ENABLED = 4
% TBSTYLE_BUTTON = 0
% TBTOOLTIPS = 256
% TBSTYLE_TOOLTIPS = 0x0100
% TBSETTIP = 9
% TTS_ALWAYSTIP = 0x01
% TTS_NOPREFIX = 0x02
% TTS_BALLOON = 0x040 ' comctl32.dll v5.8 require
% TTM_ACTIVATE = WM_USER+1
% TTM_ADDTOOL = (WM_USER + 4)
% TTM_DELTOOL = (WM_USER + 5)
% TTM_NEWTOOLRECT = (WM_USER + 6)
% TTM_GETTOOLINFO = (WM_USER + 8)
% TTM_SETTIPBKCOLOR = (WM_USER + 19)
% TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
% TTM_SETMAXTIPWIDTH = (WM_USER + 24)
% TTM_UPDATETIPTEXT = 1036
% TTDT_AUTOPOP = 2
% TTDT_INITIAL = 3
% TTF_IDISHWND = 1
% TTF_CENTERTIP = 2
% TTF_SUBCLASS = 0x0010
% CCS_ADJUSTABLE = 32
% CCS_NODIVIDER = 64
% TBSTYLE_FLAT = 2048
% TBSTYLE_LIST = 0x01000
% TB_ADDBUTTONS = WM_USER+21
% TB_SETIMAGELIST = 1072
% TB_ADDBITMAP = 1043
% TB_AUTOSIZE = 1057
'..........................
Type TOOLINFO
cbSize As int
uFlags As int
hWnd As int
uId As int
cRect As Rect
hinst As int
lpszText As int
End Type
'toolbar button UDT
TYPE TBBUTTON
iBitmap as int
idCommand as int
fsState as byte
fsStyle as byte
bReserved[1] as byte
bReserved[1] as byte
dwData as dword
iString as int
End TYPE
TYPE TBADDBITMAP
int hInst
int nID
End TYPE
Type NMHDR
hwndFrom as int
idFrom as int
code as int
End Type
'typdef structure for intit_common_controlsEx
Type INITCOMMONCONTROLSEX_TYPE
dword dwSize
dword dwICC
End Type
'dim user32 = LoadLibrary "user32.dll"
'bind user32
'(
'Sendmessage SendMessageA
')
'declare toolbar function/ ret = SETTOOLBAR()
Declare Function SetToolbar (byval hwnd as INT,byval flag as INT,byval ex as INT,byval id as INT) As INT
Declare Function RGB(byval red as int,byval green as int,byval blue as int) as int
Declare Function SetToolTip (byval _tthwnd as INT) As INT
Declare SUB AddTButton(byval hwnd as int,byval cid as int,byval iNumber as int,byval tips as string)
'declarations...
Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As INT, ByVal lpsz As String, ByVal dwType As INT, ByVal dwWidth As INT, ByVal dwHeight As INT, ByVal dwFlags As INT) As int
Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As INT, ByVal lpIconName As Any) As INT
Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As INT, ByVal lpCursorName As Any) As INT
Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (int lpModuleName) as INT
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as WNDCLASSEX) as INT
Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (byval dwExStyle AS INT,byval lpClassName AS STRING,byval lpWindowName AS STRING,byval dwStyle AS INT,byval x AS INT,byval y AS INT,byval nWidth AS INT,byval nHeight AS INT,byval hWndParent AS INT,byval hMenu AS INT,byval hInstance AS INT,byval lpParam AS INT) as INT
Declare Function TranslateMessage Lib "user32.dll" (byref lpMsg as MSG) as INT
Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as MSG) as INT
Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As INT, ByVal wMsgFilterMin As INT, ByVal wMsgFilterMax As INT) As INT
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As INT, ByVal nCmdShow As INT) As INT
Declare Function UpdateWindow Lib "user32.dll" (ByVal lhwnd As INT) As INT
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT
Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As INT)
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As INT) As INT
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As INT) As INT
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As INT) As INT
' COMMENT NEXT LINE & UNcomment bind user32 () -------------------------------------------------------------------------------------------
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As INT, ByVal dwMsg As INT, ByVal wParam As INT, lParam As Any) As INT
'! SendMessage Lib "user32.dll" Alias "SendMessageA" (byval hWnd As int,byval dwMsg As int,byval wParam As int, lParam As int) As int
! MoveWindow Lib "user32.dll" (ByVal hwnd As INT, ByVal x As INT, ByVal y As INT, ByVal nWidth As INT, ByVal nHeight As INT, ByVal bRepaint As INT) As INT
Declare Function SetFocus Lib "user32.dll" Alias "SetFocus" (ByVal hWnd As INT) As INT
Declare Function CreatePopupMenu Lib "user32.dll" () As INT
Declare Function CreateMenu Lib "user32.dll" () As INT
Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As INT) As INT
Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As INT, ByVal hMenu As INT) As INT
Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As INT, ByVal wFlags As INT, ByVal wIDNewItem As INT, ByVal lpNewItem As Any) As INT
Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As INT) As INT
Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As INT, ByVal nPosition As INT, ByVal wFlags As INT) As INT
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As INT) As INT
Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As INT, ByVal wFlags As INT, ByVal x As INT, ByVal y As INT, ByVal nReserved As INT, ByVal hwnd As INT, lprc As RECT) As INT
! SetMenuItemBitmaps Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
'/// COMCTL32.DLL ///////////
'Declare InitCommonControlsEx Lib "comctl32.dll" (INITCOMMONCONTROLSEX_TYPE *ic) as int
Declare Function InitCommonControlsEx Lib "comctl32.dll" (icc As INITCOMMONCONTROLSEX_TYPE) As int
Declare Function ImageList_Create Lib "comctl32.dll" (byval cx as int,byval cy as int,byval flags as int,byval cInitial as int,byval cGrow as int) as int
Declare Function ImageList_Add Lib "comctl32.dll" (ByVal cx As Int, ByVal cy As Int ByVal flags As uint, ByVal cInitial as Int, ByVal cGrow as Int) As int
Declare Function ImageList_AddMasked Lib "comctl32.dll" (byval hImageList as int,byval hBitmap as int,byval crMask as int) as int
Dim wcx as WNDCLASSEX
Dim wm as MSG
Dim win,style, Wx, Wy, Ww, Wh, wparent as INT
Dim wcaption,ClassName as String
'wcaption = "MyWindow"
classname = "Oxygen"
style = WS_OVERLAPPEDWINDOW
Wx=100 : Wy=100 : Ww=640 : Wh=480
wparent = 0 'HWND_DESKTOP
'-------------------------------
'FILL WNDCLASSEX structure
inst = GetModuleHandle 0
wcx.cbSize = SizeOf(WNDCLASSEX)
wcx.style = CS_DBLCLKS | CS_OWNDC
wcx.lpfnWndProc = &WndProc
wcx.cbClsExtra = 0
wcx.cbWndExtra = 0
wcx.hInstance = inst
wcx.hIcon = LoadIcon 0,IDI_APPLICATION
wcx.hCursor = LoadCursor 0,IDC_ARROW
wcx.hbrBackground = CreateSolidBrush(GetSysColor(15))
wcx.lpszMenuName = strptr ""
wcx.lpszClassName = strptr Classname
wcx.hIconSm = 0
RegisterClassEx wcx
wcaption = "My Menu"
'create window -------------------------------
win = CreateWindowEx 0,ClassName , wcaption, style, Wx, Wy, Ww, Wh, wparent, 0, inst,0
ShowWindow win,SW_SHOW
'create Menu ---------------------------------------------------------
'Appendmenu hMenu , wFlags, wIDNewItem, lpNewItem
INT mainMenu,submenu1,submenu2
INT mImg1 = LoadImage(0, "iNew.bmp", 0, 16, 16, 24)
INT mImg2 = LoadImage(0, "iOpen.bmp", 0, 16, 16, 24)
INT mImg3 = LoadImage(0, "iSave.bmp", 0, 16, 16, 24)
INT mImg4 = LoadImage(0, "iQuit.bmp", 0, 16, 16, 24)
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1, 0,120,strptr "New")
SetMenuItemBitmaps(submenu1, 0,MF_BYPOSITION , mImg1, 0) 'add menu item bitmap
AppendMenu (submenu1,0,121,strptr "Open")
SetMenuItemBitmaps(submenu1, 1,MF_BYPOSITION , mImg2, 0)
AppendMenu (submenu1,0,122,strptr "Save")
SetMenuItemBitmaps(submenu1, 2,MF_BYPOSITION , mImg3, 0)
AppendMenu (submenu1,0,123,strptr "Quit")
SetMenuItemBitmaps(submenu1, 3,MF_BYPOSITION , mImg4, 0)
'set submwnu1 on main menu
AppendMenu (mainMenu,16,submenu1,strptr "File")
'...............................................
submenu2 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu2,0,124,strptr "Undo")
AppendMenu (submenu2,0,125,strptr "Cut")
AppendMenu (submenu2,0,126,strptr "Copy")
AppendMenu (submenu2,0,127,strptr "Paste")
'set submwnu1 on main menu
AppendMenu (mainMenu,16,submenu2,strptr "Edit")
'...............................................
SetMenu win ,mainMenu
'-----------------------------------------------
'TOOLBAR-------------------------------------------------------------
TBBUTTON tbb
TOOLINFO tti
Dim AddBmp as TBADDBITMAP
' setting common control mode
Dim ic as INITCOMMONCONTROLSEX_TYPE
ic.dwSize = SizeOf(ic)
ic.dwICC = 4
' initialize common controls 32
InitCommonControlsEx(ic)
with Addbmp
.hinst = -1
.nID = 0
End with
int htbar
INT toolID = 99
'add handlers
INT hImageList,hImage,maskRet,
'create toolbar -----------------------------------------------------
'htbar = SetToolbar ( hwnd, style, index, toolID)
htbar = SetToolBar (win, 0, 0, toolID)
'Properly resize toolbar to fit each image 24x24 image segment,h=32
MoveWindow(htbar, 0, 0, 434, 32, 0)
indexbase 0
' Set the imagelist used with default images
hImageList = ImageList_Create(24, 24, ILC_MASK | ILC_COLOR8, 1, 0)
hImage = LoadImage(0, "rCodetb24.bmp", 0, 336, 24, 24)
'print "IMAGE " + str(hImage)
maskRet = ImageList_AddMasked hImageList,byval hImage, RGB(231,223,231)
'print "MASK " + str(maskRet)
DeleteObject hImage
'set image list
SendMessage htbar, 1072, 0,byval hImageList 'use byval for imageList handler
'set button structure size
SendMessage htbar , 1054, sizeof(tbb), null
'TBUTTONS & TOOLTIPS -------------------------------------------------
INT tooltip
tooltip = SetToolTip(htbar)
AddTButton(htbar, 100, 0, "New File")
AddTButton(htbar, 101, 1, "Open File")
AddTButton(htbar, 102, 2, "Save As...")
AddTButton(htbar, 103, 3, "Save File")
AddTButton(htbar, 104, 4, "Close File")
AddTButton(htbar, 105, 5, "ASCI Table")
AddTButton(htbar, 106, 6, "Parser")
AddTButton(htbar, 107, 7, "Compile::")
AddTButton(htbar, 108, 8, "Run")
AddTButton(htbar, 109, 9, "Web Site")
AddTButton(htbar, 110, 10, "Info")
AddTButton(htbar, 111, 11, "Find")
AddTButton(htbar, 112, 12, "Options")
AddTButton(htbar, 113, 13, "Help")
SetFocus win
'message loop
While GetMessage(wm,0,0,0)
TranslateMessage wm
DispatchMessage wm
Wend
'main callback procedure ---------------------------------------
Function WndProc (sys hwnd,wMsg,wParam,lParam) as sys callback
Select wMsg
Case WM_DESTROY
PostQuitMessage 0
End Select
Return DefWindowProc(Hwnd,wMsg,wParam,lParam)
End Function
'------------------------------------------
Function SetToolbar (byval _tbhwnd as int ,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
INT TBSTYLES = TBSTYLE_FLAT | WS_VISIBLE | WS_CHILD
If _tbflag = 0
'_tbflag = TBSTYLES
'ELSE
_tbflag = 1342179328 | TBSTYLES | 4 | &H100
End If
hTBControl = CreateWindowEx(_ex, TOOLBARCLASSNAME,null,_tbflag,0,0,0,0,_tbhwnd, cID,0,0)
'SendMessage hTBControl, TB_SETBUTTONSIZE, 0, 32
' _hfont = GetStockObject(17)
'SendMessage hTBControl,WM_SETFONT,_hfont,0ž
Showwindow htbcontrol,1
UpdateWindow _tbhwnd
Function = hTBControl
'End Function
End Function
'---------------------------------------------------
SUB AddTButton(byval twnd as int,byval id as int,byval iNum as int,byval tip as string)
'TOOLINFO tti
tti.cbSize = SizeOf(tti)
tti.uFlags = 0 'TTF_SUBCLASS | TTF_IDISHWND
tti.hwnd = twnd
tti.uId = id
tti.hinst = 0
tti.lpszText = strPtr tip
SendMessage(SendMessage( htbar, 1059,0,0),1028, 0, tti)
string number = str(inum)
'add button
tbb.iBitmap = iNum
tbb.idCommand = id
tbb.fsState = 4
tbb.fsStyle = 0
tbb.dwData = 0
'tbb.iString = strptr number
SendMessage htbar , tb_addbuttons, iNum, tbb
'SendMessage htbar, TB_SETBUTTONWIDTH, 0, 0
'SendMessage htbar, 1052, 0, 0
End SUB
'=====================================================================================
'set tooltip control
Function SetToolTip (byval _tthwnd as INT) As INT
INT _hfont
hTTControl = CreateWindowEx(0,"tooltips_class32","", -805306368,0,0,0,0,_tthwnd,0,0,0)
SendMessage( _tthwnd, 1060, hTTControl,0)
Function = hTTControl
End Function
'----------------------------------------------------
Function RGB(byval red as INT,byval green as INT,byval blue as int) as int
int color
color = red
color = color + green*256
color = color + blue*65536
Return color
End Function
-
I am interested in this example, but when i compile it with my version of
Oxygen it doesnt display anything. Just stands there in the task manager
but no dialogs are displayed.
-
It compiles to a DLL. It's a Script BASIC extension DLL only callable by SB.
You should install SB and give it a try. The dynamic FFI and virtual DLL features are killer. :)
-
Actually, i got it working but only in 32 bit mode, for 64bit mode CreateWindowEx returns 0.
what is what is needed to make it work on both platforms?
-
It's only a 32 bit solution. Charles got too busy with O2 to take it to 64 bit.
Personally, I'm not wasting my time on 64 bit Windows. It looks like Microsoft isn't either.
-
I forgot about that. Now that i finally started working! :(
Now i need to start over for 64 bit mode....
-
@Brian,
To work with both 32 an 64-bit you have to use appropriate declares and data types.
For example, in the WNDCLASSEX stucture, found in WinData.inc
type WNDCLASSEX
int cbSize
int Style
sys lpfnwndproc
int cbClsextra
int cbWndExtra
sys hInstance
sys hIcon
sys hCursor
sys hbrBackground
sys lpszMenuName
sys lpszClassName
sys hIconSm
end type
sys is used for handles and pointers. sys evaluates as 4 bytes in 32 bits and as 8 bytes in 64 bit.
The data types and functions used by Aurel aren't suitable to wotk with 64 bit.
> It compiles to a DLL. It's a Script BASIC extension DLL only callable by SB.
What are you talking about?
-
> It compiles to a DLL. It's a Script BASIC extension DLL only callable by SB.
What are you talking about?
Since you hate SB and I wouldn't expect you to know anything about DLLC, HERE (https://www.scriptbasic.org/forum/index.php/topic,325.msg1462.html#msg1462) is an example of DLLC being use to call a ASM O2 virtual function dynamically.
-
I don't hate SB. I'm just not interested in it. What I HATE is that you hijack threads posting nonsense. The example posted by Aurel compiles to a 32 bit exe, not as a "Script BASIC extension DLL only callable by SB". So, what are you talking about?
-
Brian said he needed examples of O2 interface code and I recommended Charles's DLLC project as a reference, nothing more. I don't know where you're going with this.
-
Thanks Jose! It worked perfectly!! :D
-
Brian said he needed examples of O2 interface code and I recommended Charles's DLLC project as a reference, nothing more. I don't know where you're going with this.
Brian haven't said anything like that in this thread. He said "I am interested in this example, but when i compile it with my version of Oxygen it doesnt display anything." and you replied with "It compiles to a DLL. It's a Script BASIC extension DLL only callable by SB.", which is nonsense.
-
Brian switched topics and I missed it.
Sorry about that.
-
I said that in another thread John.
In this one I said i was interested in getting it working and to be honest
your reply was very misleading.
But enough drama, Thanks and carry on. :)
-
You're too quick on your feet for me. 8)
Agreed. Let's move on.
-
Brian
I am a glad that work for you
Yes Jose have a right this program is 32 bit.
By the way i am not sure that if you or any other user use
code and replace all INT with SYS that program will work .
Maybe i can try one of my other programs with SYS only. ::)