Hi all
This is the unfixed First example I Had Made with floating toolbar...
I thought IT must be possible to use the regular simple toolbar.o2bas example from winGui folder...
I Made for this First Case with Intension No Buttons for toolbar ;) IT was only a Test to See If I can Show this way a floating toolbar
'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
'
' toolbar, floating toolbar, oxygen, by frank brübach 19-12-2023
' test it's not working properly
'
$ filename "t.exe"
includepath "$/inc/"
'#include "RTL32.inc"
'#include "RTL64.inc"
#include "MinWin.inc"
% ID_FIRSTCHILD 100
% ID_SECONDCHILD 101
% ID_THIRDCHILD 102
sys hinstance
sys hWndMain
sys ghInstance
'===================================
sys inst=GetModuleHandle 0
asciiz * cmdline
@cmdline=GetCommandLine
string szAppName="Hello Window"
string szconfirm="Confirm Quit"
'===================================
% ICC_BAR_CLASSES = 4
% TBSTYLE_BUTTON 0x0000 // obsolete; use BTNS_BUTTON instead
% TBSTYLE_SEP 0x0001 // obsolete; use BTNS_SEP instead
% TBSTYLE_CHECK 0x0002 // obsolete; use BTNS_CHECK instead
% TBSTYLE_GROUP 0x0004 // obsolete; use BTNS_GROUP instead
% TBSTYLE_CHECKGROUP (TBSTYLE_GROUP | TBSTYLE_CHECK) // obsolete; use BTNS_CHECKGROUP instead
% TBSTYLE_DROPDOWN 0x0008 // obsolete; use BTNS_DROPDOWN instead
% TBSTYLE_AUTOSIZE 0x0010 // obsolete; use BTNS_AUTOSIZE instead
% TBSTYLE_NOPREFIX 0x0020 // obsolete; use BTNS_NOPREFIX instead
% TBSTYLE_TOOLTIPS 0x0100
% TBSTYLE_WRAPABLE 0x0200
% TBSTYLE_ALTDRAG 0x0400
% TBSTYLE_FLAT 0x0800
% TBSTYLE_LIST 0x1000
% TBSTYLE_CUSTOMERASE 0x2000
% TBSTYLE_REGISTERDROP 0x4000
% TBSTYLE_TRANSPARENT 0x8000
% HINST_COMMCTRL -1
% IDB_STD_SMALL_COLOR 0
% IDB_STD_LARGE_COLOR 1
% IDB_VIEW_SMALL_COLOR 4
% IDB_VIEW_LARGE_COLOR 5
% IDB_HIST_SMALL_COLOR 8
% IDB_HIST_LARGE_COLOR 9
% IDB_HIST_NORMAL 12
% IDB_HIST_HOT 13
% IDB_HIST_DISABLED 14
% IDB_HIST_PRESSED 15
% STD_CUT = 0
% STD_COPY = 1
% STD_PASTE = 2
% STD_UNDO = 3
% STD_REDOW = 4
% STD_DELETE = 5
% STD_FILENEW = 6
% STD_FILEOPEN = 7
% STD_FILESAVE = 8
% STD_PRINTPRE = 9
% STD_PROPERTIES = 10
% STD_HELP = 11
% STD_FIND = 12
% STD_REPLACE = 13
% STD_PRINT = 14
% TB_ENABLEBUTTON (WM_USER + 1)
% TB_CHECKBUTTON (WM_USER + 2)
% TB_PRESSBUTTON (WM_USER + 3)
% TB_HIDEBUTTON (WM_USER + 4)
% TB_INDETERMINATE (WM_USER + 5)
% TB_MARKBUTTON (WM_USER + 6)
% TB_ISBUTTONENABLED (WM_USER + 9)
% TB_ISBUTTONCHECKED (WM_USER + 10)
% TB_ISBUTTONPRESSED (WM_USER + 11)
% TB_ISBUTTONHIDDEN (WM_USER + 12)
% TB_ISBUTTONINDETERMINATE (WM_USER + 13)
% TB_ISBUTTONHIGHLIGHTED (WM_USER + 14)
% TB_SETSTATE (WM_USER + 17)
% TB_GETSTATE (WM_USER + 18)
% TB_ADDBITMAP (WM_USER + 19)
% TB_ADDBUTTONS (WM_USER + 20)
% TB_INSERTBUTTON (WM_USER + 21)
% TB_DELETEBUTTON (WM_USER + 22)
% TB_GETBUTTON (WM_USER + 23)
% TB_BUTTONCOUNT (WM_USER + 24)
% TB_COMMANDTOINDEX (WM_USER + 25)
% TB_BUTTONSTRUCTSIZE (WM_USER + 30)
% CMB_MASKED 0x02
% TBSTATE_CHECKED 0x01
% TBSTATE_PRESSED 0x02
% TBSTATE_ENABLED 0x04
% TBSTATE_HIDDEN 0x08
% TBSTATE_INDETERMINATE 0x10
% TBSTATE_WRAP 0x20
% TBSTATE_ELLIPSES 0x40
% TBSTATE_MARKED 0x80
% WS_EX_DLGMODALFRAME 1
% WS_TOOLWINDOW = 0x00000080 '0x80
% WS_TOPMOST = 0x8
% IDC_TOOLBAR = 101
typedef byte BYTE
typedef word WORD
typedef dword DWORD
% _WIN32
typedef struct {
sys hInst;
sys nID;
} TBADDBITMAP, *LPTBADDBITMAP;
#ifdef _WIN32
%n 2
#else
%n 6
#endif
typedef struct {
int iBitmap;
int idCommand;
BYTE fsState;
BYTE fsStyle;
BYTE bReserved[n];
sys dwData;
sys iString;
} TBBUTTON, *PTBBUTTON, *LPTBBUTTON;
typedef struct tagINITCOMMONCONTROLSEX {
DWORD dwSize;
DWORD dwICC;
} INITCOMMONCONTROLSEXtype, *LPINITCOMMONCONTROLSEX;
declare InitCommonControlsEx lib "ComCtl32.dll" (INITCOMMONCONTROLSEXtype*ic) as sys
indexbase 0
'------------------------------------------------------------ -------
Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
'====================================================================
'
; window handle
dim a,b,c,style,hWnd as sys
dim wc as WndClass
dim wm as MSG
with wc '
.style=CS_HREDRAW or CS_VREDRAW
.lpfnWndProc=@wndproc
.cbClsExtra=0
.cbWndExtra=0
.hInstance=inst
.hIcon=LoadIcon 0, IDI_APPLICATION
.hCursor=LoadCursor 0,IDC_ARROW
.hbrBackground=GetStockObject WHITE_BRUSH '
.lpszMenuName=0
.lpszClassName=@"Wins"
end with
hinstance=inst
if not RegisterClass @wc
MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
exit function
end if
style=WS_OVERLAPPEDWINDOW
style=WS_OVERLAPPEDWINDOW | // overlapped window
WS_HSCROLL | // horizontal scroll bar
WS_VSCROLL // vertical scroll bar
// Create the main window.
call InitCommonControlsEx
hwndMain = CreateWindowEx(
0, // no extended styles
"Wins", // class name
"toolbar & float Window", // window name ''Main Window
style, //
CW_USEDEFAULT, // default horizontal position
CW_USEDEFAULT, // default vertical position
CW_USEDEFAULT, // default width
CW_USEDEFAULT, // default height
NULL, // no parent or owner window
NULL, // class menu used
hinstance, // instance handle
NULL); // no window creation data
local wclass as WndClassEx
local szClassName as string 'asciiz ''* 80
local szChildName as string 'asciiz ' * 80
local hWnd as long
'ghInst = hInstance
szClassName = "MYPROGRAM32"
wclass.cbSize = sizeof(wclass)
wclass.style = CS_HREDRAW or CS_VREDRAW
wclass.lpfnWndProc = @wndproc 'CODEPTR( WndProc )
wclass.cbClsExtra = 0
wclass.cbWndExtra = 0
wclass.hInstance = hInstance
wclass.hIcon = LoadIcon( hInstance, "PROGRAM" )
wclass.hCursor = LoadCursor(0, IDC_ARROW )
wclass.hbrBackground = GetStockObject WHITE_BRUSH
wclass.lpszMenuName = null '0
wclass.lpszClassName = strptr(szClassName) 'VARPTR( szClassName ) 'strptr
'print @szClassName
wclass.hIconSm = LoadIcon( hInstance, IDI_APPLICATION )
RegisterClassEx wclass
''**Register Floating toolbar window
szChildName = "FLOATTOOLBAR"
wclass.cbSize = sizeof(wclass)
wclass.style = CS_HREDRAW or CS_VREDRAW
wclass.lpfnWndProc = @FloatProc 'CODEPTR(FloatProc)
wclass.cbClsExtra = 0
wclass.cbWndExtra = 0
wclass.hInstance = hInstance
wclass.hIcon = LoadIcon(hInstance, "PROGRAM")
wclass.hCursor = LoadCursor(0, IDC_ARROW)
wclass.hbrBackground = GetStockObject(WHITE_BRUSH)
wclass.lpszMenuName = 0
wclass.lpszClassName = strptr(szChildName)
'print @szChildName
wclass.hIconSm = LoadIcon( hInstance, IDI_APPLICATION )
RegisterClassEx wclass
// Show the window using the flag specified by the program
// that started the application, and send the application
// a WM_PAINT message.
hwnd=hwndMain
if not hWnd then
MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
exit function
end if
'
ShowWindow hWnd,show
UpdateWindow hWnd
'
'MESSAGE LOOP
'
'do while GetMessage &wm,0,0,0
' TranslateMessage &wm
' DispatchMessage &wm
'wend
'
sys bRet
'
do while bRet := GetMessage (&wm, 0, 0, 0)
if bRet == -1 then
'show an error message?
else
TranslateMessage &wm
DispatchMessage &wm
end if
wend
'
'
function=wm.wparam
end function ; end of WinMain
WinMain inst,0,cmdline,SW_NORMAL
end
'STANDARD CHILD WINDOWS STYLES
'=============================
'
'"Button" The class for a button.
'"ComboBox" The class for a combo box.
'"Edit" The class for an edit control.
'"ListBox" The class for a list box.
'"MDIClient" The class for an MDI client window.
'"ScrollBar" The class for a scroll bar.
'"Static" The class for a static control.
dim cRect as rect
dim Paintst as paintstruct
dim hDC as sys
'------------------------------------------------------------------------------------
function WndProc(dword hwnd, dword uMsg, dword wParam, dword lParam) as long callback
'====================================================================================
'{
RECT rcClient
sys i,w,px,py,lx,ly,id,idmenu,style,hWndChild
string sty
static sys hdc, htools, hInstance,hToolfloat
static tbAddBmp as TBADDBITMAP
static tbb as TBBUTTON
static tbbx as TBBUTTON
static iccx as INITCOMMONCONTROLSEXtype
'' bitmap for each button
static tbBmp(7) as sys 'as BYTE
static RECT r
select umsg
case WM_CREATE: // creating main window
'--------------- floattoolbar try -------------------- //
% CCS_TOP = &H00000001???
% TBSTYLES TBSTYLE_FLAT or WS_CHILD or WS_VISIBLE
' Create a Floating toobar window
' 1) not ok something is wrong
GetClientRect hwnd, @r
'WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE
sys ghWndTool = CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE or WS_EX_TOPMOST, _
"FLOATTOOLBAR", _
"ToolBar", WS_SYSMENU, _
500, 150, 68, 240,_
hWnd, null, hInstance, null)
ShowWindow ghWndTool,SW_SHOW
UpdateWindow ghWndTool
'--------------------------------------------------------------------- //
if ghWndTool <> null then
SendMessage( ghWndTool, TB_BUTTONSTRUCTSIZE, sizeof tbb, null )
tbAddBmp.hInst = HINST_COMMCTRL
tbAddBmp.nID = IDB_STD_SMALL_COLOR
SendMessage( ghWndTool, TB_ADDBITMAP, 0, @tbAddBmp )
'
'' apply bitmap to toolbar buttons
'
dim i,k as LONG
for i = 0 to 6
if i=4 then k=TBSTYLE_SEP else k=TBSTYLE_BUTTON
with tbb
.iBitmap = tbBmp(i)
.fsState = TBSTATE_ENABLED
.fsStyle = k
.idCommand = -1
.dwData = 0
end with
SendMessage( ghWndTool, TB_ADDBUTTONS, 1, @tbb)
next
end if
'---------------------------------------------------- //
'
' 2) usual toolbar works :-) ------------ //
'
'http://msdn.microsoft.com/en-us/library/windows/desktop/bb760433(v=vs.85).aspx
iccx.dwSize = sizeof( iccx )
iccx.dwICC = ICC_BAR_CLASSES
tbBmp = {STD_FILENEW, STD_FILEOPEN, STD_FILESAVE, STD_CUT, STD_COPY, STD_PASTE }
hInstance=GetModuleHandle null
InitCommonControlsEx( iccx )
% TBSTYLES TBSTYLE_FLAT or WS_CHILD or WS_VISIBLE
'------------ toolbar ok -------------------------------------- //
hTools = CreateWindowEx( WS_EX_DLGMODALFRAME, "ToolBarWindow32",
null,WS_CHILD or WS_VISIBLE or TBSTYLES or TBSTYLE_WRAPABLE,
0, 0, 0, 0, hWnd, null,hInstance, null )
'
' paint toolbar buttons
'
if hTools <> null then
SendMessage( hTools, TB_BUTTONSTRUCTSIZE, sizeof tbbx, null )
tbAddBmp.hInst = HINST_COMMCTRL
tbAddBmp.nID = IDB_STD_SMALL_COLOR
SendMessage( hTools, TB_ADDBITMAP, 0, @tbAddBmp )
'
'' apply bitmap to toolbar buttons
'
dim i,k as LONG
for i = 0 to 6
if i=3 then k=TBSTYLE_SEP else k=TBSTYLE_BUTTON
with tbbx
.iBitmap = tbBmp(i)
.fsState = TBSTATE_ENABLED
.fsStyle = k
.idCommand = -1
.dwData = 0
end with
SendMessage( hTools, TB_ADDBUTTONS, 1, @tbbx)
next
end if
'-------------------------------------------------------------------------- //
case WM_SIZE: // main window changed size
// Get the dimensions of the main window's client
// area, and enumerate the child windows. Pass the
// dimensions to the child windows during enumeration.
GetClientRect(hwnd, &rcClient);
'EnumChildWindows(hwnd, & EnumChildProc, &rcClient);
return 0;
case WM_CLOSE:
// Create the message box. If the user clicks
// the Yes button, destroy the main window.
if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES)
DestroyWindow(hwndMain);
else
return 0;
end if
case WM_DESTROY:
// Post the WM_QUIT message to
// quit the application terminate.
PostQuitMessage(0);
return 0;
end select
'
return DefWindowProc(hwnd, uMsg, wParam, lParam);
'}
end function
'--------------------------------------------------- //
' dummy content must however work like in powerbasic
function FloatProc() export as long
sys hwnd,wParam,lparam,fl
local wMsg as msg
select case wMsg
'%WM_
end select
function = DefWindowProc(hWnd,wMsg,wParam,lParam)
end function
Second issue: with usual MS Button but No floating toolbar ;)
Oxygen:
'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
'
' toolbar, floating toolbar, oxygen, by frank brübach 19-12-2023
' test it's not working properly
' 22-12-2023, 16:06
'
$ filename "t.exe"
includepath "$/inc/"
'#include "RTL32.inc"
'#include "RTL64.inc"
#include "MinWin.inc"
% ID_FIRSTCHILD 100
% ID_SECONDCHILD 101
% ID_THIRDCHILD 102
sys hinstance
sys hWndMain
sys ghInstance
'===================================
sys inst=GetModuleHandle 0
asciiz * cmdline
@cmdline=GetCommandLine
string szAppName="Hello Window"
string szconfirm="Confirm Quit"
'===================================
% ICC_BAR_CLASSES = 4
% TBSTYLE_BUTTON 0x0000 // obsolete; use BTNS_BUTTON instead
% TBSTYLE_SEP 0x0001 // obsolete; use BTNS_SEP instead
% TBSTYLE_CHECK 0x0002 // obsolete; use BTNS_CHECK instead
% TBSTYLE_GROUP 0x0004 // obsolete; use BTNS_GROUP instead
% TBSTYLE_CHECKGROUP (TBSTYLE_GROUP | TBSTYLE_CHECK) // obsolete; use BTNS_CHECKGROUP instead
% TBSTYLE_DROPDOWN 0x0008 // obsolete; use BTNS_DROPDOWN instead
% TBSTYLE_AUTOSIZE 0x0010 // obsolete; use BTNS_AUTOSIZE instead
% TBSTYLE_NOPREFIX 0x0020 // obsolete; use BTNS_NOPREFIX instead
% TBSTYLE_TOOLTIPS 0x0100
% TBSTYLE_WRAPABLE 0x0200
% TBSTYLE_ALTDRAG 0x0400
% TBSTYLE_FLAT 0x0800
% TBSTYLE_LIST 0x1000
% TBSTYLE_CUSTOMERASE 0x2000
% TBSTYLE_REGISTERDROP 0x4000
% TBSTYLE_TRANSPARENT 0x8000
% HINST_COMMCTRL -1
% IDB_STD_SMALL_COLOR 0
% IDB_STD_LARGE_COLOR 1
% IDB_VIEW_SMALL_COLOR 4
% IDB_VIEW_LARGE_COLOR 5
% IDB_HIST_SMALL_COLOR 8
% IDB_HIST_LARGE_COLOR 9
% IDB_HIST_NORMAL 12
% IDB_HIST_HOT 13
% IDB_HIST_DISABLED 14
% IDB_HIST_PRESSED 15
% STD_CUT = 0
% STD_COPY = 1
% STD_PASTE = 2
% STD_UNDO = 3
% STD_REDOW = 4
% STD_DELETE = 5
% STD_FILENEW = 6
% STD_FILEOPEN = 7
% STD_FILESAVE = 8
% STD_PRINTPRE = 9
% STD_PROPERTIES = 10
% STD_HELP = 11
% STD_FIND = 12
% STD_REPLACE = 13
% STD_PRINT = 14
% TB_ENABLEBUTTON (WM_USER + 1)
% TB_CHECKBUTTON (WM_USER + 2)
% TB_PRESSBUTTON (WM_USER + 3)
% TB_HIDEBUTTON (WM_USER + 4)
% TB_INDETERMINATE (WM_USER + 5)
% TB_MARKBUTTON (WM_USER + 6)
% TB_ISBUTTONENABLED (WM_USER + 9)
% TB_ISBUTTONCHECKED (WM_USER + 10)
% TB_ISBUTTONPRESSED (WM_USER + 11)
% TB_ISBUTTONHIDDEN (WM_USER + 12)
% TB_ISBUTTONINDETERMINATE (WM_USER + 13)
% TB_ISBUTTONHIGHLIGHTED (WM_USER + 14)
% TB_SETSTATE (WM_USER + 17)
% TB_GETSTATE (WM_USER + 18)
% TB_ADDBITMAP (WM_USER + 19)
% TB_ADDBUTTONS (WM_USER + 20)
% TB_INSERTBUTTON (WM_USER + 21)
% TB_DELETEBUTTON (WM_USER + 22)
% TB_GETBUTTON (WM_USER + 23)
% TB_BUTTONCOUNT (WM_USER + 24)
% TB_COMMANDTOINDEX (WM_USER + 25)
% TB_BUTTONSTRUCTSIZE (WM_USER + 30)
% CMB_MASKED 0x02
% TBSTATE_CHECKED 0x01
% TBSTATE_PRESSED 0x02
% TBSTATE_ENABLED 0x04
% TBSTATE_HIDDEN 0x08
% TBSTATE_INDETERMINATE 0x10
% TBSTATE_WRAP 0x20
% TBSTATE_ELLIPSES 0x40
% TBSTATE_MARKED 0x80
% WS_EX_DLGMODALFRAME 1
% WS_TOOLWINDOW = 0x00000080 '0x80
% WS_TOPMOST = 0x8
% IDC_TOOLBAR = 101
typedef byte BYTE
typedef word WORD
typedef dword DWORD
% _WIN32
typedef struct {
sys hInst;
sys nID;
} TBADDBITMAP, *LPTBADDBITMAP;
#ifdef _WIN32
%n 2
#else
%n 6
#endif
typedef struct {
int iBitmap;
int idCommand;
BYTE fsState;
BYTE fsStyle;
BYTE bReserved[n];
sys dwData;
sys iString;
} TBBUTTON, *PTBBUTTON, *LPTBBUTTON;
typedef struct tagINITCOMMONCONTROLSEX {
DWORD dwSize;
DWORD dwICC;
} INITCOMMONCONTROLSEXtype, *LPINITCOMMONCONTROLSEX;
declare InitCommonControlsEx lib "ComCtl32.dll" (INITCOMMONCONTROLSEXtype*ic) as sys
indexbase 0
'------------------------------------------------------------ -------
Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
'====================================================================
'
; window handle
dim a,b,c,style,hWnd as sys
dim wc as WndClass
dim wm as MSG
with wc '
.style=CS_HREDRAW or CS_VREDRAW
.lpfnWndProc=@wndproc
.cbClsExtra=0
.cbWndExtra=0
.hInstance=inst
.hIcon=LoadIcon 0, IDI_APPLICATION
.hCursor=LoadCursor 0,IDC_ARROW
.hbrBackground=GetStockObject WHITE_BRUSH '
.lpszMenuName=0
.lpszClassName=@"Wins"
end with
hinstance=inst
if not RegisterClass @wc
MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
exit function
end if
style=WS_OVERLAPPEDWINDOW
style=WS_OVERLAPPEDWINDOW | // overlapped window
WS_HSCROLL | // horizontal scroll bar
WS_VSCROLL // vertical scroll bar
// Create the main window.
call InitCommonControlsEx
hwndMain = CreateWindowEx(
0, // no extended styles
"Wins", // class name
"toolbar & float Window", // window name ''Main Window
style, //
CW_USEDEFAULT, // default horizontal position
CW_USEDEFAULT, // default vertical position
CW_USEDEFAULT, // default width
CW_USEDEFAULT, // default height
NULL, // no parent or owner window
NULL, // class menu used
hinstance, // instance handle
NULL); // no window creation data
local wclass as WndClassEx
local szClassName as string 'asciiz ''* 80
local szChildName as string 'asciiz ' * 80
local hWnd as long
'ghInst = hInstance
szClassName = "MYPROGRAM32"
wclass.cbSize = sizeof(wclass)
wclass.style = CS_HREDRAW or CS_VREDRAW
wclass.lpfnWndProc = @wndproc 'CODEPTR( WndProc )
wclass.cbClsExtra = 0
wclass.cbWndExtra = 0
wclass.hInstance = hInstance
wclass.hIcon = LoadIcon( hInstance, "PROGRAM" )
wclass.hCursor = LoadCursor(0, IDC_ARROW )
wclass.hbrBackground = GetStockObject WHITE_BRUSH
wclass.lpszMenuName = null '0
wclass.lpszClassName = strptr(szClassName) 'VARPTR( szClassName ) 'strptr
'print @szClassName
wclass.hIconSm = LoadIcon( hInstance, IDI_APPLICATION )
RegisterClassEx wclass
''**Register Floating toolbar window
szChildName = "FLOATTOOLBAR"
wclass.cbSize = sizeof(wclass)
wclass.style = CS_HREDRAW or CS_VREDRAW
wclass.lpfnWndProc = @FloatProc 'CODEPTR(FloatProc)
wclass.cbClsExtra = 0
wclass.cbWndExtra = 0
wclass.hInstance = hInstance
wclass.hIcon = LoadIcon(hInstance, "PROGRAM")
wclass.hCursor = LoadCursor(0, IDC_ARROW)
wclass.hbrBackground = GetStockObject(WHITE_BRUSH)
wclass.lpszMenuName = 0
wclass.lpszClassName = strptr(szChildName)
'print @szChildName
wclass.hIconSm = LoadIcon( hInstance, IDI_APPLICATION )
RegisterClassEx wclass
// Show the window using the flag specified by the program
// that started the application, and send the application
// a WM_PAINT message.
hwnd=hwndMain
if not hWnd then
MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
exit function
end if
'
ShowWindow hWnd,show
UpdateWindow hWnd
'
'MESSAGE LOOP
'
'do while GetMessage &wm,0,0,0
' TranslateMessage &wm
' DispatchMessage &wm
'wend
'
sys bRet
'
do while bRet := GetMessage (&wm, 0, 0, 0)
if bRet == -1 then
'show an error message?
else
TranslateMessage &wm
DispatchMessage &wm
end if
wend
'
'
function=wm.wparam
end function ; end of WinMain
WinMain inst,0,cmdline,SW_NORMAL
end
'STANDARD CHILD WINDOWS STYLES
'=============================
'
'"Button" The class for a button.
'"ComboBox" The class for a combo box.
'"Edit" The class for an edit control.
'"ListBox" The class for a list box.
'"MDIClient" The class for an MDI client window.
'"ScrollBar" The class for a scroll bar.
'"Static" The class for a static control.
dim cRect as rect
dim Paintst as paintstruct
dim hDC as sys
'------------------------------------------------------------------------------------
function WndProc(dword hwnd, dword uMsg, dword wParam, dword lParam) as long callback
'====================================================================================
'{
RECT rcClient
sys i,w,px,py,lx,ly,id,idmenu,style,hWndChild
string sty
static sys hdc, htools, hInstance,hToolfloat
static tbAddBmp as TBADDBITMAP
static tbb as TBBUTTON
static tbbx as TBBUTTON
static iccx as INITCOMMONCONTROLSEXtype
'' bitmap for each button
static tbBmp(7) as sys 'as BYTE
static RECT r
select umsg
case WM_CREATE // creating main window
'----------------------------------------------------- //
'toolbar simple with usual ms buttons
dim i as integer
dim tbBmp(17) as long
dim tbAddBmp as TBADDBITMAP
dim tbb AS TBBUTTON
' Bitmaps festlegen, alles StandardIcon aus Windows
tbBmp(0) = STD_FILENEW
tbBmp(1) = STD_FILEOPEN
tbBmp(2) = STD_FILESAVE
tbBmp(3) = -1
tbBmp(4) = STD_CUT
tbBmp(5) = STD_COPY
tbBmp(6) = STD_PASTE
tbBmp(7) = STD_DELETE
tbBmp(8) = -1
tbBmp(9) = STD_FIND
tbBmp(10) = STD_REPLACE
tbBmp(11) = -1
tbBmp(12) = STD_UNDO
tbBmp(13) = STD_REDOW
tbBmp(14) = -1
tbBmp(15) = STD_PRINT
tbBmp(16) = STD_PROPERTIES
' Initialisieren der common controls W32
'InitCommonControls()
InitCommonControlsEx( iccx )
'ToolBar anlegen
hTools = CreateWindowEx( WS_EX_TOOLWINDOW OR WS_EX_CLIENTEDGE, _
"ToolBarWindow32", "", _
WS_CHILD or WS_VISIBLE, _
0, 0, 0, 0, _
hWnd, null, hInstance, null )
'Die ToolBar und Buttons zeichnen
if ( hTools <> null ) then
SendMessage( hTools, TB_BUTTONSTRUCTSIZE, sizeof(tbb), NULL )
tbAddBmp.hInst = HINST_COMMCTRL
tbAddBmp.nID = IDB_STD_SMALL_COLOR
SendMessage( hTools, TB_ADDBITMAP, 0, @tbAddBmp )
for i = 0 to 16
with tbb
if tbBmp(i)= -1 then
'an diesen Stellen einen Abstand zwischen die Buttons einfügen
.fsStyle = TBSTYLE_SEP
.iBitmap = 6 'bestimmt den Abstand der Button
else
.fsStyle = TBSTYLE_BUTTON
.iBitmap = tbBmp(i)
end if
.fsState = TBSTATE_ENABLED
.idCommand = -1
.dwData = 0
end with
SendMessage( hTools, TB_ADDBUTTONS, 1, @tbb )
next
end if
'--------------- floattoolbar try -------------------- //
% CCS_TOP = &H00000001???
% TBSTYLES TBSTYLE_FLAT or WS_CHILD or WS_VISIBLE
' Create a Floating toobar window
' 1) not ok something is wrong
GetClientRect hwnd, @r
'WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE
sys ghWndTool = CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE or WS_EX_TOPMOST, _
"FLOATTOOLBAR", _
"ToolBar", WS_SYSMENU, _
500, 150, 68, 240,_
hWnd, null, hInstance, null)
ShowWindow ghWndTool,SW_SHOW
UpdateWindow ghWndTool
'--------------------------------------------------------------------- //
if ghWndTool <> null then
SendMessage( ghWndTool, TB_BUTTONSTRUCTSIZE, sizeof tbb, null )
tbAddBmp.hInst = HINST_COMMCTRL
tbAddBmp.nID = IDB_STD_SMALL_COLOR
SendMessage( ghWndTool, TB_ADDBITMAP, 0, @tbAddBmp )
'
'' apply bitmap to toolbar buttons
'
dim i,k as LONG
for i = 0 to 6
if i=4 then k=TBSTYLE_SEP else k=TBSTYLE_BUTTON
with tbb
.iBitmap = tbBmp(i)
.fsState = TBSTATE_ENABLED
.fsStyle = k
.idCommand = -1
.dwData = 0
end with
SendMessage( ghWndTool, TB_ADDBUTTONS, 1, @tbb)
next
end if
'---------------------------------------------------- //
case WM_SIZE: // main window changed size
// Get the dimensions of the main window's client
// area, and enumerate the child windows. Pass the
// dimensions to the child windows during enumeration.
GetClientRect(hwnd, &rcClient);
'EnumChildWindows(hwnd, & EnumChildProc, &rcClient);
return 0;
case WM_CLOSE:
// Create the message box. If the user clicks
// the Yes button, destroy the main window.
if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES)
DestroyWindow(hwndMain);
else
return 0;
end if
case WM_DESTROY:
// Post the WM_QUIT message to
// quit the application terminate.
PostQuitMessage(0);
return 0;
end select
'
return DefWindowProc(hwnd, uMsg, wParam, lParam);
'}
end function
'--------------------------------------------------- //
' dummy content must however work like in powerbasic
function FloatProc() export as long
sys hwnd,wParam,lparam,fl
local wMsg as msg
select case wMsg
'%WM_
end select
function = DefWindowProc(hWnd,wMsg,wParam,lParam)
end function
If there is a little more time Here I make IT with new Image buttons and toolbar with floating toolbar like I know from Powerbasic examples
omg
why you use typedef struct
i don't remember when i use it for ..maybe intitCommonControlsEx
something like that ..hmmm...ok
Maybe something like this ;D
'Tool window with awinh037.inc include file by Aurel
$ filename "ToolWindow.exe"
include "rtl32.inc" : include "awinh037.inc" : #lookahead
'globals
INT win,twin,toolwin=0
INT x=200,y=200,w=400,h=300,wstyle = WS_MINMAXSIZE
' open window with message loop...
win = SetWindow("Main Window",x,y,w,h,0,wstyle)
'create fake tool window
twin = SetWindow("TOOL 1",x+w+10 ,y, 300,86, 0,wstyle)
'add icon buttons----------------------------------------------------------------
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(twin,2,2,36,36,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "OpenApp.ico", 1, 24, 24, 24) 'load icon...
SendMessage( button1, 247, 1, icon1) 'add icon to button...
if twin <> 0 : toolwin = 1 : endif
Wait() '/// message loop function ///
Function WndProc(sys hwnd,wmsg,wparam,lparam) as sys Callback
SELECT hwnd
CASE win
Select wmsg
CASE WM_CLOSE
CloseWindow(win)
'CloseWindow(twin) 'this could be changed
EndProgram
End Select
CASE twin
Select wmsg
CASE WM_CLOSE
if toolwin = 1
CloseWindow(twin)
toolwin = 0
end if
End Select
END SELECT
RETURN Default
End Function
Or maybe this one ...add XMass tool button maybe ;D
'Tool window with awinh037.inc include file by Aurel
$ filename "ToolWindow.exe"
include "rtl32.inc" : include "awinh037.inc" : #lookahead
'globals
INT win,twin,toolwin=0
INT x=200,y=200,w=400,h=300,wstyle = WS_MINMAXSIZE
' open window with message loop...
win = SetWindow("Main Window",x,y,w,h,0,wstyle)
'create fake tool window
twin = SetWindow("TOOL 1",x+w+10 ,y, 300,86, 0,wstyle)
'add icon buttons----------------------------------------------------------------
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(twin,2,2,36,36,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "OpenApp.ico", 1, 24, 24, 24) 'load icon...
SendMessage( button1, 247, 1, icon1) 'add icon to button...
INT button2, b2ID = 100
button2 = SetButton(twin,40,2,36,36,"", ICONBUTTON, 0,b1ID)
INT icon2 = LoadImage(0, "PenTool.ico", 1, 24, 24, 24) 'load icon...
SendMessage( button2, 247, 1, icon2) 'add icon
if twin <> 0 : toolwin = 1 : endif
Wait() '/// message loop function ///
Function WndProc(sys hwnd,wmsg,wparam,lparam) as sys Callback
SELECT hwnd
CASE win
Select wmsg
CASE WM_CLOSE
CloseWindow(win)
'CloseWindow(twin) 'this could be changed
EndProgram
End Select
CASE twin
Select wmsg
CASE WM_CLOSE
if toolwin = 1
CloseWindow(twin)
toolwin = 0
end if
End Select
END SELECT
RETURN Default
End Function
It may not be possible to float the toolbar over an active OpenGl surface. It does not work with child windows but menus and message boxes work okay by automatically freezing the underlying opengl.
Thanks Zlatko for your example IT Works Here :) but I didnt have time enough to Work at my example and its frustrating to translate Code snippets from Powerbasic to oxygen its wasting time in my eyes
In 2017 I Made my private oxygen oxide.o2bas with toolbar Buttons See Pic below
Yes thx Charles for your new oxygen Update First of all and that was my Idea to place a floating toolbar in an OpenGL Scene... But IT Works with window Menues AS I know already
More to come later
Regards Frank
A simple moveable toolbar box using ConsoleGl.
It is just a slice of icons from the AppTools image (below). By changing the color r,g,b,a the box can be tinted or made transparent. The next step would be to individuate the icons into separate buttons on the panel.
BeginScript
sub QuadTex(float xp=0.0,yp=0.0,xq=1.0,yq=1.0)
==============================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end sub
procedure main()
================
if opening
CreateTexture imgn,"AppTools.png"
end if
cls ' .3,.3,.5
move 20,-15
pushstate
UserMovement m1,100 'for moveable box
'
'display toolbar
'
flat
color 1,1,1,.9
texture imgn
scale 10
scale 1.0, 0.10*imgnHt/imgnWi, 1.0 'dimensions of box strip
quadtex(0,.68,1,.78) 'portion of image
texture 0
popstate
'
end procedure 'main
EndScript
A few more steps.
1. The icons are separated into buttons
2. They are positioned on a toolbar panel
3. The buttons are each assigned an identity
4. The buttons can be picked and highlighted
uses consoleG
BeginScript
procedure QuadTex(float xp=0.0,yp=0.0,xq=1.0,yq=1.0)
====================================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end procedure
procedure main()
================
if opening
CreateTexture imgn,"AppTools.png"
end if
cls ' .3,.3,.5
move 20,-15
pushstate
UserMovement m1,100 'for moveable box
'
'display toolbar
'
flat
color 1,1,1,.4 'translucent panel
texture 0
pushstate
move 6,0
scale 10,1.25,1
quadtex()
popstate
move 0,0,.0001
color 1,1,1,.9
texture imgn
'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
'separate button icons
int i
static int k
float x=0.015
for i=1 to 5 'each button
if picked=200+i
k=200+i
endif
if k=200+i
color 1,.5,1,.9
else
color 1,1,1,.9
endif
picklabel 200+i
quadtex(x,.68,x+.1,.78) 'portion of image
x+=.2
move 3,0
next 'button
texture 0
popstate
'
end procedure 'main
EndScript
Thank you Charles good Idea... I Had a similar Idea some weeks ago with triangle Data example but didnt know how to load an Image with consoleG OpenGL :)
Just for a Test to understand I build an example with two toolbars (Panels) and a different Image (tassecafe.png) as Background
I know various Icons are better to use for certain function later AS Well
Oxygen consoleG (OpenGL) example
'A few more steps.
'CodeSelect Expand
'23-12-2023, charles
'25-12-2023 frank
'
% ExplicitMain
% Title = "Toolbar openGL / consoleG"
uses consoleG
BeginScript
procedure QuadTex(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
====================================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.25 '1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end procedure
procedure QuadTex2(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
====================================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.25 '1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end procedure
procedure main()
================
if opening
CreateTexture imgn, "Tassecafe.png" ''"AppTools.png"
end if
cls ' .3,.3,.5
'move 20,-15
move 5,-5
pushstate
UserMovement m1,100 'for moveable box
'
'display toolbar
'
flat
color 1,1,1,.4 'translucent panel
texture 0
pushstate
'move 6,0
move 8,0
scale 10,1.25,1
quadtex()
popstate
move 0,0,.0001
color 1,1,1,.9
texture imgn
'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
'separate button icons
int i
static int k
float x=0.015
for i=1 to 6 'each button
if picked=200+i
k=200+i
endif
if k=200+i
color 1,.5,1,.9
else
color 1,1,1,.9
endif
picklabel 200+i
'quadtex(x,.68,x+.1,.78) 'portion of image
quadtex(x,.68,x+.1,.78) 'portion of image
x+= .15 '.2
move 3.25,0 ' place between buttons with icons
next 'button
texture 0
popstate
'
'display toolbar2 -------------------------------- //
'
cls ' .3,.3,.5
'move 20,-15
move 5,-5
pushstate
UserMovement m1,300 'for moveable box
'
flat
'color 1,1,1,.4 'translucent panel
color 0.5,0.9,0.95,.4 'translucent panel
texture 0
pushstate
'move 6,0
move 8,-4
scale 10,1.25,1
quadtex2()
popstate
move 0,-4,.0001
color 1,1,1,.9
texture imgn
'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
'separate button icons
int ii
static int kk
float xx=0.015
for ii=1 to 6 'each button
if picked=300+ii
kk=300+ii
endif
if kk=300+ii
color 1,.5,1,.9
else
color 1,1,1,.9
endif
picklabel 300+ii
'quadtex(x,.68,x+.1,.78) 'portion of image
quadtex(xx,.68,xx+.1,.78) 'portion of image
xx+= .15 '.2
move 3.25,0 ' place between buttons with icons
next 'button
texture 0
popstate
end procedure 'main
EndScript
'MainWindow width,height,WS_OVERLAPPEDWINDOW
'cup of Coffee - tasse cafe (German)
Little more with Button click Print (gprint) nothing Else
Info: you can move both toolbars at every place in the Scene If you want
'CodeSelect Expand
'23-12-2023, charles
'25-12-2023, frank, plus btn click print
'
% ExplicitMain
% Title = "Toolbars consoleG -> pick and move + buttonclick"
uses consoleG
BeginScript
procedure QuadTex(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
====================================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.25 '1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end procedure
procedure QuadTex2(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
====================================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.25 '1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end procedure
procedure main()
================
if opening
CreateTexture imgn, "Tassecafe.png" ''"AppTools.png"
end if
cls ' .3,.3,.5
'move 20,-15
'move 5,-5
move 2,-2
pushstate
UserMovement m1,100 'for moveable box
'
'display toolbar 1 ------------------- //
'
flat
color 1,1,1,.4 'translucent panel
texture 0
pushstate
'move 6,0
move 8,0
scale 10,1.25,1
quadtex()
popstate
move 0,0,.0001
color 1,1,1,.9
texture imgn
'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
'separate button icons
int i
static int k
float x=0.015
for i=1 to 6 'each button
if picked=200+i
k=200+i
pushstate
move -1.5,-2.5
color 0.5,0.8,0,.9
scale 1.25,1.25
gprint "btn: "+ k
popstate
endif
if k=200+i
color 1,.5,1,.9
else
color 1,1,1,.9
endif
picklabel 200+i
'quadtex(x,.68,x+.1,.78) 'portion of image
quadtex(x,.68,x+.1,.78) 'portion of image
x+= .15 '.2
move 3.25,0 ' place between buttons with icons
next 'button
texture 0
popstate
'
'display toolbar2 -------------------------------- //
'
cls ' .3,.3,.5
'move 20,-15
move 0.5,-20
pushstate
UserMovement m1,300 'for moveable box
'
flat
'color 1,1,1,.4 'translucent panel
color 0.5,0.9,0.95,.4 'translucent panel
texture 0
pushstate
'move 6,0
move 8,-4
scale 10,1.25,1
quadtex2()
popstate
move 0,-4,.0001
color 1,1,1,.9
texture imgn
'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
'separate button icons
int ii
static int kk
float xx=0.015
for ii=1 to 6 'each button
if picked=300+ii
kk=300+ii
pushstate
move -1.5,-2.5
color 0.5,0.8,0,.9
scale 1.25,1.25
gprint "btn: "+ kk
popstate
endif
if kk=300+ii
color 1,.5,1,.9
else
color 1,1,1,.9
endif
picklabel 300+ii
'quadtex(x,.68,x+.1,.78) 'portion of image
quadtex(xx,.68,xx+.1,.78) 'portion of image
xx+= .15 '.2
move 3.25,0 ' place between buttons with icons
next 'button
texture 0
popstate
'
end procedure 'main
EndScript
'MainWindow width,height,WS_OVERLAPPEDWINDOW
You can also use separate images for each button:
This example works in demos\opengl\consoleG\ and uses jpegs from demos\images\
uses consoleG
BeginScript
procedure QuadTex(float xp=0.0,yp=0.0,xq=1.0,yq=1.0)
====================================================
'Configured As Front Face
glBegin GL_TRIANGLE_STRIP
glNormal3f 0.0 , 0.0 , 1.0
float u=1.0
float n=0.0
glTexCoord2f xp , yp
glVertex3f -u , -u , n
glTexCoord2f xq , yp
glVertex3f u , -u , n
glTexCoord2f xp , yq
glVertex3f -u , u , n
glTexCoord2f xq , yq
glVertex3f u , u , n
glEnd
end procedure
procedure main()
================
if opening
'sub LoadTexture(optional string fi, int n,res,*wi,*ht,*pflip)
'
texe=5
static int imgn[]={1,2,3,4,5}
static int wi[5],ht[5]
LoadTexture ("..\..\images\star.jpg",imgn[1],0,Wi[1],Ht[1])
LoadTexture ("..\..\images\head1.jpg",imgn[2],0,Wi[2],Ht[2])
LoadTexture ("..\..\images\mud.jpg",imgn[3],0,Wi[3],Ht[3])
LoadTexture ("..\..\images\fruitfly1.jpg",imgn[4],0,Wi[4],Ht[4])
LoadTexture ("..\..\images\glass.jpg",imgn[5],0,Wi[5],Ht[5])
end if
cls ' .3,.3,.5
move 20,-15
pushstate
UserMovement m1,100 'for moveable box
'
'display toolbar
'
flat
color 1,1,1,.4 'translucent panel
texture 0
scale 1.5
pushstate
move 6,0
scale 8,1.25,1
quadtex()
popstate
move 0,0,.0001
color 1,1,1,.9
'separate button icons
int i
static int k
float x=0.015
for i=1 to 5 'each button
if picked=200+i
k=200+i
endif
if k=200+i
color 1,.5,1,.9
else
color 1,1,1,.9
endif
texture imgn[i]
picklabel 200+i
quadtex(0.0,.0.0,1.0,1.0) 'whole images
texture 0
move 3,0
next 'button
popstate
'
end procedure 'main
EndScript
Thank you Charles its running Well with different jpgs too :)
Nice merry Christmas for you and family... Hope you are fit and healthy
Regards Frank