Oxygen Basic
Programming => Problems & Solutions => Topic started by: Aurel on March 18, 2018, 08:05:07 AM
-
Hi Charles
When i remove complete Bind ()
and add as usual whole set of api functions in my include awinh035
then i get error when i run AurelEdit.exe .. see screenshot
what i do wrong ?
or o2 cannot compile properly without BInd instruction?
I use this time A043 ...so is there maybe some changes in progress pack?
thnx
Aurel
-
Charles
I do some changes and try all posible combination I know
but i constantly receive system error about signature?
why?
Do i must use latest Oxygenbasicprogress ? or back everything to old
way with BIND ?
i use classic way to build gui app with :
Type WNDCLASSEX
cbSize as long
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
hIconSm AS long
End Type
-----
-----
Function SetWindow (byval caption as string ,byval Wx as int,byval Wy as int, byval Ww as int, byval Wh as int, byval wparent as int, byval style as int) as int
inst = GetModuleHandle 0
'sys hbrush=RGB(250,250,255)
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 "Oxygen"
wcx.hIconSm = LoadIcon 0,IDI_APPLICATION
RegisterClassEx wcx
as you may see old way require & operator -> &wcx
but now i receive error with &wcx ...and i am forced to use just wcx
why is that ?
also is this proper way now to declare RegisterClassEx in o2:
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As sys
because i receive that window handler is 0 ?
-
Hi Aurel,
The awinh, asciiEdit and WebBrowserATL, which are included in /projectsB/Scintilla, work with corewin, without the bind blocks, and only two small changes were required.
But I am sure you have updated awinh quite a bit, so we need to be synchronised.
-
Hi Charles yes i agree ...
I do many testing last night to figured what is wrong and it looks that my WNDCLASSEX
must be this to work with A043 - i think that progress is same( size of rtl32,gx02 and oxy.dll is same)
so here is wndclass:
'#############################################
' awinh v035 include file - by Aurel 2018
'#############################################
Type WNDCLASSEX
cbSize as int
Style as int
lpfnwndproc as sys
cbClsextra as int
cbWndExtra as int
hInstance as sys
hIcon as sys
hCursor as sys
hbrBackground as sys
lpszMenuName as sys
lpszClassName as sys
hIconSm AS sys
End Type
-
Charles
I have lot of problems when i remove bind()
most of controls not respond properly as in old version of awinh
new version is called awinh035.inc
i will add it in attachment.
for example one stupid problem
what is proper shape of
Sendmessage function:
! SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal dwMsg As Long,byVal wParam As Long,byRef lParam As Long) As Long
is that corect?
also most of control function not respond..
it looks that i must go trough each declarations ::)
-
You could use corewin instead of binding blocks, or declaring procedures individually. Then you will have access to nearly 6000 API calls.
It also includes the common types like WndClassEx in 64bit-compatible format.
This is the prototype of SendMessage:
LRESULT WINAPI SendMessage(
_In_ HWND hWnd,
_In_ UINT Msg,
_In_ WPARAM wParam,
_In_ LPARAM lParam
);
All the parameters are passed byval, including lparam
-
All the parameters are passed byval, including lparam
OK Charles
but what type is lParam ...?
long
int
sys
any
is any supported or not?
also i have oxygenBasicProgress and i cannot found corewin there ?
is that include or something else?
-
Hi Aurel,
I would make them all sys, though strictly speaking, wmsg is uint.
corewin is very recent (7 days ago)
https://github.com/Charles-Pegge/OxygenBasic/
-
Hi Charles
i found it and replace with old oxygenbasicProgress
I will see if this way work BUT i really doubt
Also i still must use my GUI functions for creating controls
so it is not use Just Like That system....but i will try...
Charles
So many other programs in other compilers use old way and those programs works
well with declare function way .
types are problematic part of api functions.
-
Well IDEA with this CoreWin
is not bad .hmmm but i must see how work first ::)
here is for example one small example with menu
it is easy to put declares into include ..anyone can do that..right?
'skeleton VB way...
$ filename "Menu.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 sys
hIcon as sys
hCursor as sys
hbrBackground as sys
lpszMenuName as sys
lpszClassName as sys
hIconSm AS sys
End Type
Type POINTAPI
x as long
y as long
End Type
Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
Type MSG
hwnd as sys
message as int
wParam as sys
lParam as sys
time as dword
pt as POINTAPI
End Type
'constants
% IDI_WINLOGO = 32517
% IDI_APPLICATION = 32512
% IDC_ARROW = 32512
% CS_OWNDC = 32
% CS_DBLCLKS = &H8
% 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
% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_SYSMENU = 0x80000
% WS_OVERLAPPED = WS_SYSMENU
% WS_POPUP = 0x80000000
% WS_DLGFRAME = 0x400000
% WS_VISIBLE = 0x10000000
'defines...
INT WHITE_BRUSH = 8
'declarations...
Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Any) As Long
Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (sys lpModuleName) as Long
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as WNDCLASSEX) as Long
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 Long
Declare Function TranslateMessage Lib "user32.dll" (byref lpMsg as MSG) as Long
Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as MSG) as Long
Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function UpdateWindow Lib "user32.dll" (ByVal lhwnd As Long) As Long
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Declare Function CreateMenu Lib "user32.dll" () As Long
Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Dim wcx as WNDCLASSEX
Dim wm as MSG
Dim hwnd,style, Wx, Wy, Ww, Wh, wparent as Long
Dim wcaption,ClassName as String
'wcaption = "MyWindow"
classname = "Oxygen"
style = WS_OVERLAPPEDWINDOW
Wx=0 : Wy=0 : Ww=640 : Wh=480
wparent = 0 'HWND_DESKTOP
'-------------------------------
'FILL WNDCLASSEX structure
inst = GetModuleHandle 0
wcx.cbSize = sizeOf(WNDCLASSEX)
wcx.style = CS_DBLCLKS
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 = "MyWindowEx"
'create window -------------------------------
Hwnd = CreateWindowEx 0,ClassName , wcaption, style, Wx, Wy, Ww, Wh, wparent, 0, inst,0
ShowWindow Hwnd,SW_SHOW
'create Menu
'Appendmenu hMenu , wFlags, wIDNewItem, lpNewItem
int mainMenu,submenu1
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1,0,100,strptr "New")
AppendMenu (submenu1,0,101,strptr "Open")
AppendMenu (submenu1,0,102,strptr "Save")
AppendMenu (submenu1,0,103,strptr "Quit")
'set submwnu on main menu
AppendMenu (mainMenu,16,submenu1,strptr "File")
'...............................................
SetMenu hwnd ,mainMenu
'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
'never put default return inside select
Return DefWindowProc(Hwnd,wMsg,wParam,lParam)
End Function
'------------------------------------------
-
Charles
I cannot create toolbar with a043 version
is this still valid typedef struct
typedef struct tagINITCOMMONCONTROLSEX {
DWORD dwSize;
DWORD dwICC;
} INITCOMMONCONTROLSEXtype, *LPINITCOMMONCONTROLSEX;
and then in declaration:
Declare InitCommonControlsEx Lib "comctl32.dll" Alias "InitCommonControlsEx" (INITCOMMONCONTROLSEXtype*ic ) as sys
in old A041 this way work, do I must remove Alias ?
-
I've tested Roland's dialog.inc with corewin, instead of minwin, and that works fine.
Both use unprototyped declarations.
Both of these work because the compiler will always pass UDTs byref, for unprototyped declarations.
InitCommonControlsEx(iccex)
InitCommonControlsEx(@iccex)
So try commenting out your declaration.
sub init_common_controls(optional dword classes=0)
' create a structure of INITCOMMONCONTROLSEX
INITCOMMONCONTROLSEXt iccex
iccex.dwSize=sizeof(iccex)
'Register Common Controls
if classes!=0 then
'set own value
iccex.dwICC=classes
else
'use default
iccex.dwICC= 0xffff
end if
InitCommonControlsEx(@iccex)
end sub
from windata.inc
type INITCOMMONCONTROLSEXt
DWORD dwSize;
DWORD dwICC;
end type
-
Charles
I just tried ( few minutes back)
corewin and not work for me
also as i say typdef struct for intitcommoncontrols not work on old way we use ( I use in my awinh.inc)
opertors & and @ not work in A043 like in A041 like in C samples i use
yes they work in C way in old version and i don't know why you remove it from oxygen.dll
ok
I will try ordinary TYPE like you suggested:
type INITCOMMONCONTROLSEXt
DWORD dwSize;
DWORD dwICC;
end type
then i will see if work.
By the way corewin on first look is easier but is
huge .... kernel.inc,user.inc it is far larger than just awinh.inc I use before
-
Charles
Do you can compile this example with 043
'skeleton VB way...
$ filename "Menu.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 sys
hIcon as sys
hCursor as sys
hbrBackground as sys
lpszMenuName as sys
lpszClassName as sys
hIconSm AS sys
End Type
Type POINTAPI
x as long
y as long
End Type
Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
Type MSG
hwnd as sys
message as int
wParam as sys
lParam as sys
time as dword
pt as POINTAPI
End Type
'constants
% IDI_WINLOGO = 32517
% IDI_APPLICATION = 32512
% IDC_ARROW = 32512
% CS_OWNDC = 32
% CS_DBLCLKS = &H8
% 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
% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_SYSMENU = 0x80000
% WS_OVERLAPPED = WS_SYSMENU
% WS_POPUP = 0x80000000
% WS_DLGFRAME = 0x400000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
'defines...
INT WHITE_BRUSH = 8
'bm bitmaps
% BM_SETIMAGE = 247
% IMAGE_BITMAP = 0
% COLOR_BTNFACE = 15
% ILC_MASK = 1
% ILC_COLOR8 = 8
% ILC_COLOR16 = 16
% PS_SOLID = 0
% SRCCOPY = 0xCC0020
'tooltips constants .................................................
% TB_SETTOOLTIPS = 1060
% EBTOOLTIPS = 256
% TBSTYLE_TOOLTIPS = &H100
% TBSETTIP = 9
% TTS_ALWAYSTIP = &H1
% TTS_NOPREFIX = &H2
% TTS_BALLOON = &H40 ' 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 = &H1
% TTF_CENTERTIP = &H2
% TTF_SUBCLASS = &H10
% CCS_ADJUSTABLE = 32
% CCS_NODIVIDER = 64
% TBSTYLE_FLAT = &H800
% 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 sys
End Type
'toolbar button UDT
TYPE TBBUTTON
iBitmap as long
idCommand as long
fsState as byte
fsStyle as byte
bReserved[0] as byte
bReserved[1] as byte
dwData as long
iString as sys
END TYPE
TYPE TBADDBITMAP
sys hInst
sys nID
END TYPE
Type NMHDR
hwndFrom as sys
idFrom as sys
code as sys
End Type
'typdef structure for intit_common_controlsEx
Type INITCOMMONCONTROLSEX_TYPE
dwSize As dword
dwICC As dword
End Type
'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 sys,byval green as sys,byval blue as sys) as sys
Declare Function SetToolTip (byval _tthwnd as INT) As INT
Declare SUB AddTButton(byval twnd as int,byval id as int,byval iNum as int,byval tip as string)
'declarations...
! LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwType As Long, ByVal dwWidth As Long, ByVal dwHeight As Long, ByVal dwFlags As Long) As Long
Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Any) As Long
Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (sys lpModuleName) as Long
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as WNDCLASSEX) as Long
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 Long
Declare Function TranslateMessage Lib "user32.dll" (byref lpMsg as MSG) as Long
Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as MSG) as Long
Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function UpdateWindow Lib "user32.dll" (ByVal lhwnd As Long) As Long
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
! SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal dwMsg As Long,byVal wParam As Long,byRef lParam As Long) As Long
Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Declare Function CreateMenu Lib "user32.dll" () As Long
Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
'/// COMCTL32.DLL ///////////
'Declare InitCommonControlsEx Lib "comctl32.dll" (INITCOMMONCONTROLSEX_TYPE *ic) as sys
Declare Function InitCommonControlsEx Lib "comctl32.dll" ( lpInitCtrls As INITCOMMONCONTROLSEX_TYPE) As Long
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 sys
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 sys
Declare Function ImageList_AddMasked Lib "comctl32.dll" (byval hImageList as sys,byval hBitmap as sys,byval crMask as sys) as sys
Dim wcx as WNDCLASSEX
Dim wm as MSG
Dim win,style, Wx, Wy, Ww, Wh, wparent as Long
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
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 = "MyWindowEx"
'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
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1,0,100,strptr "New")
AppendMenu (submenu1,0,101,strptr "Open")
AppendMenu (submenu1,0,102,strptr "Save")
AppendMenu (submenu1,0,103,strptr "Quit")
'set submwnu on main menu
AppendMenu (mainMenu,16,submenu1,strptr "File")
'...............................................
'SetMenu win ,mainMenu
'-----------------------------------------------
'TOOLBAR-------------------------------------------------------------
Dim tbb as TBBUTTON
Dim AddBmp as TBADDBITMAP
' setting common control mode
Dim ice as INITCOMMONCONTROLSEX_TYPE
ice.dwSize = sizeOf(ice )
ice.dwICC = 4
' initialize common controls 32
InitCommonControlsEx(ice )
with Addbmp
.hinst = -1
.nID = 0
end with
INT htbar
INT toolID = 99
'add handlers
INT hImageList,hImage,iNum,id
'create toolbar -----------------------------------------------------
'htbar = SetToolbar (win, 0 , 0, toolID)
htbar = SetToolBar (win, 0,0, toolID)
Dim pHdr as NMHDR
MoveWindow(htbar, 0, 0, 440, 32,0)
' Set the imagelist used with default images
int hImageList = ImageList_Create(24, 24, ILC_MASK OR ILC_COLOR8, 1, 0)
int hImage = LoadImage(0, "rCodetb24.bmp", 0, 336, 24, 24)
ImageList_AddMasked hImageList, hImage, RGB(231,223,231)
DeleteObject hImage
'set image list
SendMessage htbar,TB_SETIMAGELIST,0, hImageList
'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")
'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
'never put default return inside 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_CHILD | WS_VISIBLE
If _tbflag = 0
_tbflag = 1342179328 | TBSTYLES |4 | &H100
'ELSE
'_tbflag=1342179328 | TBSTYLES |4 | _tbflag
End If
hTBControl = CreateWindowEx(_ex,"TOOLBARWINDOW32","",_tbflag,0,0,0,0,_tbhwnd, cID,0,0)
' _hfont = GetStockObject(17)
'SendMessage hTBControl,WM_SETFONT,_hfont,0
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)
'add button
tbb.iBitmap = iNum
tbb.idCommand = id
tbb.fsState = 4
tbb.fsStyle = 0
tbb.dwData = 0
SendMessage htbar , 1044, 1, tbb
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(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
Return color
End Function
-
Charles
I have found on Jose forum version for power basic
this looks simple:
TYPE INIT_COMMON_CONTROLSEX
dwSize AS DWORD ' size of this structure
dwICC AS DWORD ' flags indicating which classes to be initialized
END TYPE
then declaration:
DECLARE FUNCTION InitCommonControlsEx LIB "ComCtl32.dll" ALIAS "InitCommonControlsEx" (icc AS INIT_COMMON_CONTROLSEX) AS LONG
and i tried that method but nothing ::)
-
Just one thing Charles:
When api function MoveWindow() is added
then ToolTop control work but Toolbar - still is not visible ?
I really cannot understand why?
As i said before all this things works when compiled with old 041
even (as i mention in one old topic ) Dlib( pureBasic) way work in old release.
is there a chance that sizeof instruction not work properly ?
-
Don't give up Aurel even if Charles may seem to be slow to respond.
Maybe he needs time to fathom and comprehend the real depths of despair of a beginner user that is faced with heaps of mutually exclusive sets of header files, on the one hand, and dead O2 code, on the other ...
... before he takes one final strategic decision to do away with any headers in principle and altogether -- forever.
I am not mocking or trolling. I am dead serious as I could ever be.
-
Hey Mike
I will try all possible options and must be solution of course
because all that things work before .
In fact it is not problem only with toolbar control, scintilla also not work properly
something is really really very strange.
First error is crazy . wrong signature of o2 exe ...geee i never see such a error before.
I forget to check xblite version of toolbar...
ufff..
-
DUH!
PEOPLE IT IS STILL AN ALPHA PRODUCT.
OF COURSE IT WILL CHANGE. NOTHING IS WRITTEN IN STONE!!!!
-
OK OK Aurel, I understand your problems and pains but if I or anybody else tells you what to do right now about your particular piece of code, we all won't have any protection against similar cases happening in the future for years and years to come.
Our future is in Charles' hands now. My FBSL is vivid proof it can be done. What else can we do to make him believe that there is a real problem he's facing now and is about to face at all times in the future, as well as a working solution to this problem that, if accepted NOW before it's too late to reshuffle the entire engine, will guarantee there will be no "header hell" again in the foreseeable future?
THIS IS THE MOMENT OF TRUTH!!!
-
Hi Aurel,
Taking out your bespoke headers.
Working ok until LoadImage.
I need one of these: "rCodetb24.bmp"
Hi Mike,
I would be delighted to scrap basic-style headers, at least, but they are there to provide a compatibility bridge with the Qbasic genre.
However, we could say 'use them at your own peril!'
-
Hi Charles,
Hoping to get off easy again? ;)
-
Mike i agree that some things not work in old version
but i can handle that quirks and most of my samples
work as it should be.
Charles
new awih035 is not to large and i will add it in attachment
also i will add toolbar image too
menu example work but is strange ...no images etc... scintilla not work too.
don't worry to much i can always back to old version of oxygen which work - let say fine ;)
here is menu example ...with so called toolbar ::)
'skeleton VB way...
$ filename "Menu.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 sys
hIcon as sys
hCursor as sys
hbrBackground as sys
lpszMenuName as sys
lpszClassName as sys
hIconSm AS sys
End Type
Type POINTAPI
x as long
y as long
End Type
Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
Type MSG
hwnd as sys
message as int
wParam as sys
lParam as sys
time as dword
pt as POINTAPI
End Type
'constants
% IDI_WINLOGO = 32517
% IDI_APPLICATION = 32512
% IDC_ARROW = 32512
% CS_OWNDC = 32
% CS_DBLCLKS = &H8
% 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
% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_SYSMENU = 0x80000
% WS_OVERLAPPED = WS_SYSMENU
% WS_POPUP = 0x80000000
% WS_DLGFRAME = 0x400000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
'defines...
INT WHITE_BRUSH = 8
'bm bitmaps
% BM_SETIMAGE = 247
% IMAGE_BITMAP = 0
% COLOR_BTNFACE = 15
% ILC_MASK = 1
% ILC_COLOR8 = 8
% ILC_COLOR16 = 16
% PS_SOLID = 0
% SRCCOPY = 0xCC0020
'tooltips constants .................................................
% TB_SETTOOLTIPS = 1060
% EBTOOLTIPS = 256
% TBSTYLE_TOOLTIPS = &H100
% TBSETTIP = 9
% TTS_ALWAYSTIP = &H1
% TTS_NOPREFIX = &H2
% TTS_BALLOON = &H40 ' 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 = &H1
% TTF_CENTERTIP = &H2
% TTF_SUBCLASS = &H10
% CCS_ADJUSTABLE = 32
% CCS_NODIVIDER = 64
% TBSTYLE_FLAT = &H800
% 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 sys
End Type
indexbase 0
'toolbar button UDT
TYPE TBBUTTON
iBitmap as long
idCommand as long
fsState as byte
fsStyle as byte
bReserved[0] as byte
bReserved[1] as byte
dwData as long
iString as long
END TYPE
TYPE TBADDBITMAP
sys hInst
sys nID
END TYPE
Type NMHDR
hwndFrom as sys
idFrom as sys
code as sys
End Type
'typdef structure for intit_common_controlsEx
Type INITCOMMONCONTROLSEX_TYPE
dwSize As dword
dwICC As dword
End Type
'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 sys,byval green as sys,byval blue as sys) as sys
Declare Function SetToolTip (byval _tthwnd as INT) As INT
Declare SUB AddTButton(byval twnd as int,byval id as int,byval iNum as int,byval tip as string)
'declarations...
! LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwType As Long, ByVal dwWidth As Long, ByVal dwHeight As Long, ByVal dwFlags As Long) As Long
Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Any) As Long
Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (sys lpModuleName) as Long
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as WNDCLASSEX) as Long
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 Long
Declare Function TranslateMessage Lib "user32.dll" (byref lpMsg as MSG) as Long
Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as MSG) as Long
Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function UpdateWindow Lib "user32.dll" (ByVal lhwnd As Long) As Long
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
! SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal dwMsg As Long,byVal wParam As Long,byRef lParam As Long) As Long
! MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Declare Function CreateMenu Lib "user32.dll" () As Long
Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
'/// COMCTL32.DLL ///////////
'Declare InitCommonControlsEx Lib "comctl32.dll" (INITCOMMONCONTROLSEX_TYPE *ic) as sys
Declare Function InitCommonControlsEx Lib "comctl32.dll" ( lpInitCtrls As INITCOMMONCONTROLSEX_TYPE) As Long
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 sys
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 sys
Declare Function ImageList_AddMasked Lib "comctl32.dll" (byval hImageList as sys,byval hBitmap as sys,byval crMask as sys) as sys
Dim wcx as WNDCLASSEX
Dim wm as MSG
Dim win,style, Wx, Wy, Ww, Wh, wparent as Long
Dim wcaption,ClassName as String
'wcaption = "MyWindow"
classname = "Oxygen"
style = WS_OVERLAPPEDWINDOW
Wx=100 : Wy=100 : Ww=800 : Wh=600
wparent = 0 'HWND_DESKTOP
'-------------------------------
'FILL WNDCLASSEX structure
inst = GetModuleHandle 0
wcx.cbSize = sizeOf(WNDCLASSEX)
wcx.style = CS_DBLCLKS
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 = "MyWindowEx"
'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
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1,0,100,strptr "New")
AppendMenu (submenu1,0,101,strptr "Open")
AppendMenu (submenu1,0,102,strptr "Save")
AppendMenu (submenu1,0,103,strptr "Quit")
'set submwnu on main menu
AppendMenu (mainMenu,16,submenu1,strptr "File")
'...............................................
SetMenu win ,mainMenu
'-----------------------------------------------
'TOOLBAR-------------------------------------------------------------
Dim tbb as TBBUTTON
Dim AddBmp as TBADDBITMAP
' setting common control mode
Dim ice as INITCOMMONCONTROLSEX_TYPE
ice.dwSize = sizeOf(ice)
ice.dwICC = 4
' initialize common controls 32
InitCommonControlsEx(ice )
with Addbmp
.hinst = -1
.nID = 0
end with
INT htbar
INT toolID = 99
'add handlers
INT hImageList,hImage
'create toolbar -----------------------------------------------------
'htbar = SetToolbar (win, 0 , 0, toolID)
htbar = SetToolBar (win, 0,0, toolID)
'Dim pHdr as NMHDR
MoveWindow(htbar, 0, 0, 540, 52,0)
' Set the imagelist used with default images
int hImageList = ImageList_Create(24, 24, ILC_MASK OR ILC_COLOR8, 1, 0)
int hImage = LoadImage(0, "rCodetb24.bmp", 0, 336, 24, 24)
ImageList_AddMasked hImageList, hImage, RGB(231,223,231)
'DeleteObject hImage
'set image list
SendMessage htbar,TB_SETIMAGELIST,0, hImageList
'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")
SendMessage htbar , 1054, sizeof(tbb),0
Sendmessage htbar , 1044, 14 , &tbb 'addbuttons
' Tell the toolbar to resize itself, and show it.
SendMessage (htbar, 1952, 0, 0) 'autosize
'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
'never put default return inside 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_CHILD | WS_VISIBLE
If _tbflag = 0
_tbflag = 1342179328 | TBSTYLES |4 | &H100
'ELSE
'_tbflag=1342179328 | TBSTYLES |4 | _tbflag
End If
hTBControl = CreateWindowEx(_ex,"TOOLBARWINDOW32","",_tbflag,0,0,0,0,_tbhwnd, cID,0,0)
' _hfont = GetStockObject(17)
'SendMessage hTBControl,WM_SETFONT,_hfont,0
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)
'add button
tbb.iBitmap = iNum
tbb.idCommand = id
tbb.fsState = 4
tbb.fsStyle = NULL
tbb.dwData = NULL
SendMessage htbar , 1054, sizeof(tbb),0
SendMessage htbar , 1044, 1, &tbb 'addbutton
'SendMessage (htbar, 1952, 0, 0) 'autosize
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(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
Return color
End Function
-
Thanks Aurel,
With that bmp file, I have your toolbar working. Further testing will be much easier now.
-
Hi Charles
The worst thing is that we can compile program without error
so i don't get it what might be problem - compiled - OK
but then when i run exe then things not work..
maybe problem with pointers or operators & ...
or #lookahead ... ::)
-
Hi Charles
I found what is problem with my awinh.inc
I check every function to detect where is problem and problem is in
function Sendmessage
when i bind this function like:
dim user32 = LoadLibrary "user32.dll"
bind user32
(
Sendmessage SendMessageA
)
and comment
'Declare Function SendMssage ... ...
then my program work
So as i suspect before Sendmessage use wrong variable types in declaration.
I am searching trough web but there are different declares with different variable types.
I also cannot found in oxygen pack what you use to declare SendMessage function
becuse your bind work but declared not..
-
Charles
Most used types i see is this one:
Declare Function SendMessage Lib "user32.dll" _Alias "SendMessageA" ( ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Is that correct ?
Then i found one VB example with sendmessge call where is used byval lParam member
so i tried same for Imagelist:
'set image list
SendMessage htbar, 1072, 1,byval hImageList
and my toolbar become visible
So as conclusion ...do i must use always byVal ?
or just when is needed?
still is mistery to me your declaration?
-
Charles
Here is example which work( i hope) ,,but i am still not sure about SendMessage types.
'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
'bm bitmaps
% BM_SETIMAGE = 247
% 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
'/// 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
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1,0,120,strptr "New")
AppendMenu (submenu1,0,121,strptr "Open")
AppendMenu (submenu1,0,122,strptr "Save")
AppendMenu (submenu1,0,123,strptr "Quit")
'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,tImg
'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
-
Hi Aurel,
I would treat all SendMessage params as byval sys. Sometimes you are passing a buffer pointer in one of the params, which requires the full 32/64bit width, so an int or dword is not sufficient. But wMsg only uses the lower 32 bits.
With our unprototyped declarations (corewin & minwin) & your bind blocks, O2 will automatically pass string params as the strptr, and items like RECT or POINT will be passed as their '@' pointers.
In Types, all handles (hinstance, hwnd,hicon etc), and pointers (LPCSTR etc) are sys
-
Sometimes you are passing a buffer pointer in one of the params
Yes Charles you have a right abd it looks that type Any can hold string buffer or char buffer without problems like
for example in :
SendMessage hsci,SCI_SETTEXT,0,strptr(tx)
so do you agree about type Any which is used in many declaration we can find on web?
-
You would have to use byval any in your declaration. In O2, this would be ok for strings, but you would have to pass the strptr explicitly for char and asciiz.
Similarly, you would need to pass '@' pointers for RECT etc.
But Unprotyped is smarter, and less work :)
-
Yes Charles i agree that is less work of course
but i want to clear some things...
I found in PowerBasic for Windows include folder WinAPI
4 type of declaration:
DECLARE FUNCTION SendMessageA LIB "User32.dll" ALIAS "SendMessageA" _
(BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION SendMessageW LIB "User32.dll" ALIAS "SendMessageW" _
(BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
BYVAL lParam AS LONG) AS LONG
#IF %DEF(%UNICODE)
DECLARE FUNCTION SendMessage LIB "User32.dll" ALIAS "SendMessageW" _
(BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
BYVAL lParam AS LONG) AS LONG
#ELSE
DECLARE FUNCTION SendMessage LIB "User32.dll" ALIAS "SendMessageA" _
(BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, _
BYVAL lParam AS LONG) AS LONG
#ENDIF ' NOT %UNICODE
Charles
I am now confused... ::)
Which one is right or which one you use inside Bind()
I have problem when i use lParam as sys
then
sendmessage hsci, sci_settext ,0, strptr(tx)
simply not work , or in another word my char buffer is not recognized and scintilla not show text
if i use lParam as Any
then i must do this
sendmessage edit,wm_text,0 ,byval strptr(tx) -> tx is string type
do you maybe use sendmessageW in your bind() ?
This is absolutely crazy
-
Hi Aurel,
if you use corewin.inc why do you not simply use the unprototyped SendMessage function and apply the arguments given in the Win32 Help File:
LRESULT SendMessage(
HWND hWnd, // handle of destination window
UINT Msg, // message to send
WPARAM wParam, // first message parameter
LPARAM lParam // second message parameter
);
HWND, WPARAM, LPARAM is sys, MSG is a value.
Roland
-
Hi Aurel,
I would simply reject all of those declarations. They cannot be used for a 64bit binary. Using CoreWin, MinWin, or the old bind blocks, resolves the problem, but you must also provide accurately defined types.
Unfortunately, just because something appears to work, it does not prove it is correct, and if it is incorrect, the program will fail under different conditions.
-
Yessssss Roland! You nailed down both the problem and solution exactly! Bingo!
There are too many WinAPIs and user defined functions where the exact interpretation of function arguments would depend not so much on the function prototype but on other circumstances, and in this particular case, on what SendMessage()'s Msg value (i.e. the particular WM_... message) is!
This is where strongly typed function prototypes are nothing but pure evil: they won't let you pass WPARAM and LPARAM values flexibly but will require that you breed a bunch of SendMessage() aliases for all possible occasions.
Just use unprototyped SendMessage(), look up in MSDN what WPARAM and LPARAM args a particular WM_... message requires, and pass numeric literals or vars for direct (byval) args, or @numvars for (byref) arg addresses, or simple udtvar or strvar names (or strptr strvar) for byref UDTs and strings. Every MSDN page has the Parameters section that explains in plain English whether each argument the WinAPI expects is a literal (byval) value or a (byref) address.
What other declaration or prototype an intelligent human being would ever need?!