Hi all
I have a question to a tabnotify.o2bas example (Demos,/winGui folder)
Its possible to Change the color Background of the whole tab Control for example to blue?
Either this must Work with WM_Ctlcolorbtn or WM_drawitem
Oxygen Code below
' how to colorize background to a tabcontrol (sdk)
' oxygen basic, 14-01-2024 by frank bruebach
'
$ filename "t.exe"
'uses rtl64
uses WinUtil
'uses console
indexbase 0
% EDGE_RAISED=5
% EDGE_SUNKEN=10
% BF_RECT=15
% WM_DRAWITEM=43
% ETO_OPAQUE=2
% ETO_CLIPPED=4
% ODS_SELECTED=1
% GWL_HINSTANCE -6
type SIZE
long cx
long cy
end type
type DRAWITEMSTRUCT
UINT CtlType
UINT CtlID
UINT itemID
UINT itemAction
UINT itemState
sys hwndItem
sys hDC
RECT rcItem
sys itemData 'ulong_ptr
end type
% IDB_BUTTON 100
sys hWndStdButton
% IDC_OWNERDRAWN 1000
sys hWndClrButton
% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0
type TCITEM
int mask,dwState,dwStateMask
char* pszText
int cchTextMax,iImage
sys lParam
end type
typedef TCITEM TC_ITEM
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes
function RGB(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
return color
end function
% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
' Initialize common controls.
INITCOMMONCONTROLSEXt icex
icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
icex.dwICC = ICC_TAB_CLASSES
InitCommonControlsEx(&icex)
sys hInstance=inst
MainWindow 480,360,WS_OVERLAPPEDWINDOW
function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
static sys hwndTab, hwndStatic
drawitemstruct disptr
DRAWITEMSTRUCT ptDrawItem
select uMsg
case WM_CREATE
' Get the dimensions of the parent window's client area, and
' create a tab control child window of that size.
RECT rcClient
TCITEM tie
GetClientRect(hwnd, &rcClient)
hwndTab = CreateWindowEx(0,WC_TABCONTROL, "",
WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
0, 0, rcClient.right, rcClient.bottom,
hwnd, null, hInstance, null)
if (hwndTab = null) then
mbox "Create Tab Control failed"
return null
end if
' Add tabs for each day of the week.
tie.mask = TCIF_TEXT | TCIF_IMAGE
tie.iImage = -1
int i
for i = 0 to <DAYS_IN_WEEK
' Load the day string
tie.pszText=day[i]
if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
mbox "InsertItem Tab failed"
DestroyWindow(hwndTab)
return null
end if
next i
' Creates a child window (a static control) to occupy the tab control's display area.
' hwndTab - handle of the tab control.
hwndStatic = CreateWindowEx(0,WC_STATIC, "",
WS_CHILD | WS_VISIBLE | WS_BORDER,
100, 100, 100, 100, ' Position and dimensions; example only.
hwndTab, null, hInstance, ' g_hInst is the global instance handle
null)
SendMessage(hwndStatic, WM_SETTEXT, 0, strptr day[0]) 'Sunday
case WM_SIZE
' Handles the WM_SIZE message for the main window by resizing the tab control.
' hwndTab - handle of the tab control.
' lParam - the lParam parameter of the WM_SIZE message.
' RECT rc
' Resize the tab control to fit the client are of main window.
' SetWindowPos(hwndTab, HWND_TOP, 0, 0, GET_X_LPARAM(lParam), GET_Y_LPARAM(lParam), SWP_SHOWWINDOW)
int x=loword(lParam) : int y=hiword(lParam)
SetWindowPos(hwndTab, HWND_TOP, 0,0, x,y, SWP_SHOWWINDOW)
case WM_NOTIFY
' Handles notifications from the tab control, as follows:
' TCN_SELCHANGING - always returns FALSE to allow the user to select a different tab.
' TCN_SELCHANGE - loads a string resource and displays it in a
' static control on the selected tab.
' hwndTab - handle of the tab control.
' lParam - the lParam parameter of the WM_NOTIFY message.
NMHDR pnmhdr at lParam
select pnmhdr.code
case TCN_SELCHANGING
' Return FALSE to allow the selection to change.
return FALSE
case TCN_SELCHANGE
'' int iPage = TabCtrl_GetCurSel(hwndTab)
int iPage = SendMessage(hwndTab, TCM_GETCURSEL, 0,0)
SendMessage(hwndStatic, WM_SETTEXT, 0, strptr day[iPage])
end select
return TRUE
static int bcolor=RGB(128, 0, 0) '0xaabbee
static sys hbrush
'------------------- //
case WM_CTLCOLORBTN
'------------------- //
sys hdc=wparam
sys hwn=lparam
RECT rec
if hwn=hwndStatic 'hwndTab
GetClientRect hwn,@rcClient
sys hbr=CreateSolidBrush bcolor
FillRect hdc,@rcClient,hbr
SetBkColor hdc,bcolor
SetTextColor hdc,0x90
DrawText hDC,"Press",-1,@rcClient,0x25
DeleteObject hbr
return hbr
endif
'----------------
case WM_DRAWITEM
'----------------
select case wParam
case if not hwndStatic then 'hwndTab
'get the pointer to the item-drawing info
DRAWITEMSTRUCT *ptDrawItem
'error ------------ //
'ptDrawItem=lParam
'error ------------ //
hbrush=createsolidbrush(bcolor)
SetBkColor wParam, RGB(128, 0, 0) ' set text background color
SetTextColor wParam, %YELLOW ' set text color
end select
case WM_CLOSE
DestroyWindow(hwnd)
case WM_DESTROY
PostQuitMessage(0)
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
return 0
end function
Help is Welcome thanks
Regards Frank
Hi Frank, I think this example will help. I've also included references below.
$filename "t.exe"
'uses RTL64
uses WinUtil
sys hchw[2] 'child windows
function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
===============================================================
indexbase 0
static sys hdc
static RECT r
'==========
select wMsg
===========
case WM_CREATE
'=============
SetWindowText hwnd,"Right-Click"
int style
string stys
style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
stys="static"
hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 100, hinst, null)
stys="button"
'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 101, hinst, null)
stys="edit"
style=WS_CHILD | WS_VISIBLE '| ES_READONLY
hchw[2]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 102, hinst, null)
SetWindowText hchw[1],"ok"
SetWindowText hchw[2],"Message Here"
static sys hsbr=CreateSolidBrush 0xf0ffff
SendMessage hwnd,WM_SIZE,0,0
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
case WM_DESTROY
================
PostQuitMessage 0
case WM_MOUSEMOVE
=================
static short mx,my
mx=loword lparam
my=hiword lparam
case WM_RBUTTONDOWN
===================
static int ms
if not ms
ms=1
ShowWindow hchw[0],1
ShowWindow hchw[1],1
ShowWindow hchw[2],1
endif
case WM_CTLCOLORSTATIC
======================
sys hdc=wparam
sys hwn=lparam
if hwn=hchw[0]
return hsbr
endif
case WM_CTLCOLOREDIT
====================
sys hdc=wparam
sys hwn=lparam
int fcolor=0x880000
int bcolor=0xf0ffff
RECT rec
if hwn=hchw[2]
GetClientRect hwn,@rec
'sys hbr=CreateSolidBrush bcolor
'FillRect hdc,@rec,hbr
'DeleteObject hbr
'
SetBkColor hdc,bcolor
'SetTextColor hdc,fcolor
'DrawText hDC,"text text",-1,@rec,0x25
return hsbr
endif
case WM_CTLCOLORBTN
===================
sys hdc=wparam
sys hwn=lparam
int bcolor=0x0020e0
int fcolor=0xeeeeee
RECT rec
if hwn=hchw[1]
GetClientRect hwn,@rec
sys hbr=CreateSolidBrush bcolor
FillRect hdc,@rec,hbr
SetBkColor hdc,bcolor
SetTextColor hdc,fcolor
DrawText hDC,"OK",-1,@rec,0x25
DeleteObject hbr
return 0
endif
case WM_COMMAND
===============
if wparam=101 'popup ok button
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
ms=0
endif
case WM_KEYDOWN
===============
if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
case WM_SIZE
============
RECT rc
GetClientRect(hwnd, rc)
int px=rc.right \2 - 100
int py=rc.bottom \2 -35
'child window, position x,y size x.y, show
MoveWindow(hchw[0], px,py, 200, 70, TRUE)
MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE)
MoveWindow(hchw[2], px+5,py+5, 190, 30 TRUE)
case WM_DESTROY
DeleteObject hsbr
PostQuitMessage 0
case else
=========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
'
end function ' WndProc
MainWindow 320,220,WS_OVERLAPPEDWINDOW
https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-drawitemstruct
https://learn.microsoft.com/en-us/windows/win32/controls/wm-drawitem
'
'BUTTON DEMOS USING WM_DRAWITEM
.\demos\WinDynDialogs\Ownerdrawn.o2bas
.\demos\WinGUI\ButtonColored.o2bas
.\demos\WinGUI\DragAndDropTool.o2bas
.\demos\WinGUI\UniversalButton.o2bas
.\inc\Dialogs.inc
'
'BUTTON DEMOS USING WM_CTLCOLORBTN
.\demos\WinGUI\ButtonOwnerDraw.o2bas
INCLUDING EDITBOX BACKGROUND
.\demos\WinGUI\MessageWindow.o2bas
Thank you Charles two examples in WinGui Folder I didnt know yet
1) One solution I have found already for colorizing the right click window
2) another way I have to Go with drawitem cause If I am including a tab Control the First way doesn't Work
See you nice evening
You can also colorize the main window background
At the end of WM_CREATE:
SendMessage hwnd,WM_ERASEBKGND,0,0
then
case WM_ERASEBKGND
==================
int bcolor=0x000080
RECT r
GetClientRect hwnd,@r
sys hbr=CreateSolidBrush bcolor
'wparam is hdc
FillRect wparam,@r,hbr
DeleteObject hbr
return 1
Is there a way to use this :
SendMessage hwnd,WM_ERASEBKGND,0,0
from any part of code ?
Now thats my Second attempt with the tab Control Here with color and right click example but the tab Pages dont visualized correct
And I am using wm_paint too for hwndtab control.. wm_erasebkgnd paint the Main window Here
Something is Missing or the Setup is wrong ;)
'
' test oxygen tab control and colorizing winmain and right click
' tabcontrol isn't correct visualized here, 14-15/01/2024, frank bruebach
'
$filename "t.exe"
'uses RTL64
uses WinUtil
sys hchw[2] 'child windows
'---------------------------------------------------------------
% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0
type TCITEM
int mask,dwState,dwStateMask
char* pszText
int cchTextMax,iImage
sys lParam
end type
typedef TCITEM TC_ITEM
% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
' Initialize common controls.
INITCOMMONCONTROLSEXt icex
icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
icex.dwICC = ICC_TAB_CLASSES
InitCommonControlsEx(&icex)
sys hInstance=inst
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes
function RGB(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
return color
end function
function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
===============================================================
indexbase 0
static sys hwndTab, hwndStatic
static sys hdc
static RECT r
'==========
select wMsg
===========
case WM_CREATE
'=============
SetWindowText hwnd,"Right-Click"
'--------------------------------------1) tabcontrol ------------- //
RECT rcClient
TCITEM tie
GetClientRect(hwnd, &rcClient)
hwndTab = CreateWindowEx(0,WC_TABCONTROL, "",
WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
10,30,300,300, ''rcClient.right, rcClient.bottom,
hwnd, null, hInstance, null)
if (hwndTab = null) then
mbox "Create Tab Control failed"
return null
end if
' Add tabs for each day of the week.
tie.mask = TCIF_TEXT | TCIF_IMAGE
tie.iImage = -1
int i
for i = 0 to <DAYS_IN_WEEK
' Load the day string
tie.pszText=day[i]
if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
mbox "InsertItem Tab failed"
DestroyWindow(hwndTab)
return null
end if
next i
'----------------------------------------------- //
'------------------ 2) hwndtab in hchw[i] ------ //
int style
string stys
style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
stys="static" 'WS_EX_CLIENTEDGE
hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 100, hinst, null)
stys="button"
'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 101, hinst, null)
stys="edit"
style=WS_CHILD | WS_VISIBLE '| ES_READONLY
hchw[2]=CreateWindowEx(WS_EX_CLIENTEDGE,stys, null, style, 0,0,0,0, hwndtab, 102, hinst, null)
SetWindowText hchw[1],"ok"
SetWindowText hchw[2],"take a Message Here"
static sys hsbr=CreateSolidBrush RGB(128, 128, 0) '0xf0ffff
SendMessage hwnd,WM_SIZE,0,0
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
SendMessage hwnd,WM_ERASEBKGND,0,0
case WM_DESTROY
================
PostQuitMessage 0
case WM_MOUSEMOVE
=================
static short mx,my
mx=loword lparam
my=hiword lparam
case WM_RBUTTONDOWN
===================
static int ms
if not ms
ms=1
ShowWindow hchw[0],1
ShowWindow hchw[1],1
ShowWindow hchw[2],1
endif
case WM_CTLCOLORSTATIC
======================
sys hdc=wparam
sys hwn=lparam
if hwn=hchw[0]
return hsbr
endif
case WM_CTLCOLOREDIT
====================
sys hdc=wparam
sys hwn=lparam
int fcolor=0x880000
int bcolor= rgb(125,125,255) '0xf0ffff
RECT rec
if hwn=hchw[2]
GetClientRect hwn,@rec
'sys hbr=CreateSolidBrush bcolor
'FillRect hdc,@rec,hbr
'DeleteObject hbr
'
SetBkColor hdc,bcolor
'SetTextColor hdc,fcolor
'DrawText hDC,"text text",-1,@rec,0x25
return hsbr
endif
case WM_CTLCOLORBTN
===================
sys hdc=wparam
sys hwn=lparam
int bcolor=0x0020e0
int fcolor= rgb(125,125,0) '0xeeeeee
RECT rec
if hwn=hchw[1]
GetClientRect hwn,@rec
sys hbr=CreateSolidBrush bcolor
FillRect hdc,@rec,hbr
SetBkColor hdc,bcolor
SetTextColor hdc,fcolor
DrawText hDC,"OK",-1,@rec,0x25
DeleteObject hbr
return 0
endif
'------------
case WM_PAINT
=============
static as sys hdc
static as String txt
static as PaintStruct Paintst
dim as rect crect 'for WndProc and TimerProc
GetClientRect hWndTab,cRect 'hWndTab
hDC=BeginPaint hWndTab,Paintst
sys hbr=CreateSolidBrush rgb(125,255,100) 'bcolor greeny
FillRect hdc,@cRect,hbr
SetBkColor hdc,yellow
SetTextColor hdc,red
DrawText hDC,"testFile for coloring text and background",-1,cRect,0x25
EndPaint hWndTab,Paintst
case WM_ERASEBKGND
==================
int bcolor= rgb(255,0,0) '0x000080
RECT r
GetClientRect hwnd,@r
sys hbr=CreateSolidBrush bcolor
'wparam is hdc
FillRect wparam,@r,hbr
DeleteObject hbr
return 1
case WM_COMMAND
===============
if wparam=101 'popup ok button
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
ms=0
endif
case WM_KEYDOWN
===============
if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
case WM_SIZE
============
RECT rc
GetClientRect(hwnd, rc)
int px=rc.right \2 - 100
int py=rc.bottom \2 -35
'child window, position x,y size x.y, show
MoveWindow(hchw[0], px,py, 300, 170, TRUE) '200, 70 right click window size
'MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE)
MoveWindow(hchw[1], px+165,py+55, 40, 40 TRUE) 'ok button
MoveWindow(hchw[2], px+15,py+15, 190, 30 TRUE)
case WM_DESTROY
DeleteObject hsbr
PostQuitMessage 0
case else
=========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
'
end function ' WndProc
MainWindow 520,420,WS_OVERLAPPEDWINDOW
'You can also colorize the main window background
'At the end of WM_CREATE:
'CodeSelect
'SendMessage hwnd,WM_ERASEBKGND,0,0
'then
'CodeSelect
Thx Zlatko but I am Not Sure Here about correct Handling yet Charles gave this advice in His Last Post too I have included all Yesterday
Regards Frank
Hi Aurel,
this call is needed only once to create the initial background on WM_CREATE. Then windows can have full control of WM_ERASEBACKGROUND thereafter
SendMessage hwnd,WM_ERASEBKGND,0,0
Good morning all...
the Problem still remains with colorizing the tabcontrol with right click example...
If I am using for the childwindows hwnd I have Got the Grey tab Control with weekly days all OK so far...
If I am using for childwindows with hwndtab in IT and use below wm_paint in wndproc I can colorize the tab Control with createsilidbrush rgb(125,255,100) a greeny color the tab Pages dont appear
Oxygen running uncolorized tab Control example
'--- test tabcontrol + rightclick test 2 oxygen
'--- 14-16-012024, by frank bruebach
'
$filename "t.exe"
'uses RTL64
uses WinUtil
' three childwindows
sys hchw[3] 'child windows
% COLOR_WINDOW 5
% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0
type TCITEM
int mask,dwState,dwStateMask
char* pszText
int cchTextMax,iImage
sys lParam
end type
typedef TCITEM TC_ITEM
% EDGE_RAISED=5
% EDGE_SUNKEN=10
% BF_RECT=15
% WM_DRAWITEM=43
% ETO_OPAQUE=2
% ETO_CLIPPED=4
% ODS_SELECTED=1
% GWL_HINSTANCE -6
type SIZE
long cx
long cy
end type
type DRAWITEMSTRUCT
UINT CtlType
UINT CtlID
UINT itemID
UINT itemAction
UINT itemState
sys hwndItem
sys hDC
RECT rcItem
sys itemData 'ulong_ptr
end type
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes
function RGB(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
return color
end function
% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
string stest="Hello Editor"
' Initialize common controls.
INITCOMMONCONTROLSEXt icex
icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
icex.dwICC = ICC_TAB_CLASSES
InitCommonControlsEx(icex)
sys hInstance=inst
'typedef struct _TRIVERTEX {
'long x
'long y
'COLOR16 RED
'COLOR16 GREEN
'COLOR16 BLUE
'COLOR16 Alpha
'} TRIVERTEX, *PTRIVERTEX, *LPTRIVERTEX
% GRADIENT_FILL_RECT_H = &H00000000???
% GRADIENT_FILL_RECT_V = &H00000001234
% GRADIENT_FILL_TRIANGLE = &H00000002???
% GRADIENT_FILL_OP_FLAG = &H000000ff???
declare function GradientFill lib "MSIMG32.DLL" lib "GradientFill" ( _
byval hdc as dword _ ' __in HDC hdc
, byref pVertex as float _ 'TRIVERTEX _ ' __in PTRIVERTEX pVertex
, byval nVertex as dword _ ' __in ULONG nVertex
, byref pMesh as sys _ ' __in PVOID pMesh
, byval nMesh as dword _ ' __in ULONG nMesh
, byval ulMode as dword _ ' __in ULONG ulMode
) as long ' BOOL
function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
===============================================================
indexbase 0
static sys hdc
static RECT r
static RECT rcClient
static sys hwndTab, hwndStatic
'==========
select wMsg
===========
case WM_CREATE
'=============
SetWindowText hwnd,"Right-Click + gradient win + tab"
'------ 1) tabcontrol go
' Get the dimensions of the parent window's client area, and
' create a tab control child window of that size.
RECT rcClient
TCITEM tie
GetClientRect(hwnd, rcClient)
hwndTab = CreateWindowEx(WS_EX_CLIENTEDGE,WC_TABCONTROL, "",
WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
10, 50, 350, 250, 'rcClient.right, rcClient.bottom
hwnd, null, hInstance, null)
if (hwndTab = null) then
mbox "Create Tab Control failed"
return null
end if
' Add tabs for each day of the week.
tie.mask = TCIF_TEXT | TCIF_IMAGE
tie.iImage = -1
int i
for i = 0 to <DAYS_IN_WEEK
' Load the day string
tie.pszText=day[i]
if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
mbox "InsertItem Tab failed"
DestroyWindow(hwndTab)
return null
end if
next i
'------ 2) right click child windows go, but not if hwnd = hwndtab ! :-)
'
int style
string stys
style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
stys="static" 'WS_EX_CLIENTEDGE
hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 100, hinst, null)
stys="button"
'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 101, hinst, null)
stys="edit"
style=WS_CHILD | WS_VISIBLE '| ES_READONLY
hchw[2]=CreateWindowEx(WS_EX_CLIENTEDGE,stys, null, style, 0,0,0,0, hwnd, 102, hinst, null)
SetWindowText hchw[1],"ok"
SetWindowText hchw[2],"take a Message Here"
static sys hsbr=CreateSolidBrush RGB(128, 128, 0) '0xf0ffff
SendMessage hwnd,WM_SIZE,0,0
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
SendMessage hwnd,WM_ERASEBKGND,0,0
case WM_DESTROY
================
PostQuitMessage 0
case WM_MOUSEMOVE
=================
static short mx,my
mx=loword lparam
my=hiword lparam
case WM_RBUTTONDOWN
===================
static int ms
if not ms
ms=1
ShowWindow hchw[0],1
ShowWindow hchw[1],1
ShowWindow hchw[2],1
endif
case WM_CTLCOLORSTATIC
======================
sys hdc=wparam
sys hwn=lparam
if hwn=hchw[0]
return hsbr
endif
case WM_CTLCOLOREDIT
====================
sys hdc=wparam
sys hwn=lparam
int fcolor=0x880000
int bcolor= rgb(125,125,255) '0xf0ffff
RECT rec
if hwn=hchw[2]
GetClientRect hwn,@rec
'sys hbr=CreateSolidBrush bcolor
'FillRect hdc,@rec,hbr
'DeleteObject hbr
'
SetBkColor hdc,bcolor
'SetTextColor hdc,fcolor
'DrawText hDC,"text text",-1,@rec,0x25
return hsbr
endif
case WM_CTLCOLORBTN
===================
sys hdc=wparam
sys hwn=lparam
int bcolor=0x0020e0
int fcolor= rgb(125,125,0) '0xeeeeee
RECT rec
if hwn=hchw[1]
GetClientRect hwn,@rec
sys hbr=CreateSolidBrush bcolor
FillRect hdc,@rec,hbr
SetBkColor hdc,bcolor
SetTextColor hdc,fcolor
DrawText hDC,"OK",-1,@rec,0x25
DeleteObject hbr
return 0
endif
'------------
case WM_PAINT
=============
static as sys hdc
static as String txt
static as PaintStruct Paintst
dim as rect crect 'for WndProc and TimerProc
GetClientRect hWnd,cRect
hDC=BeginPaint hWnd,Paintst
SetBkColor hdc,yellow
SetTextColor hdc,red
DrawText hDC,"testFile for coloring text and background",-1,cRect,0x25
EndPaint hWnd,Paintst
case WM_ERASEBKGND
==================
int bcolor=0x000080
RECT r
GetClientRect hwnd,@r
sys hbr=CreateSolidBrush bcolor
FillRect wparam,@r,hbr
DeleteObject hbr
return 1
case WM_COMMAND
===============
if wparam=101 'popup ok button
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
ms=0
endif
case WM_KEYDOWN
===============
if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
case WM_SIZE
============
RECT rc
GetClientRect(hwnd, rc)
int px=rc.right \2 - 100
int py=rc.bottom \2 -35
'child window, position x,y size x.y, show
MoveWindow(hchw[0], px,py, 300, 300, TRUE) '200, 70 right click window size
'MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE) 'ok button
MoveWindow(hchw[1], px+165,py+95, 40, 40 TRUE)
MoveWindow(hchw[2], px+15,py+15, 190, 30 TRUE) 'Editbox
case WM_DESTROY
DeleteObject hsbr
PostQuitMessage 0
case else
=========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
'
end function ' WndProc
MainWindow 520,420,WS_OVERLAPPEDWINDOW
Here is my Second example with greeny tab Control but tab Pages arent correct and arent displayed Here.. right click Works too for child Windows
Help is Welcome thanks in advance
One little Thing is Not correct
' tabcontrol oxygen with hwndtab in childwindows
' test 2, 14-16/01/2024
'
$filename "t.exe"
'uses RTL64
uses WinUtil
' three childwindows
sys hchw[3] 'child windows
% COLOR_WINDOW 5
% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0
type TCITEM
int mask,dwState,dwStateMask
char* pszText
int cchTextMax,iImage
sys lParam
end type
typedef TCITEM TC_ITEM
% EDGE_RAISED=5
% EDGE_SUNKEN=10
% BF_RECT=15
% WM_DRAWITEM=43
% ETO_OPAQUE=2
% ETO_CLIPPED=4
% ODS_SELECTED=1
% GWL_HINSTANCE -6
type SIZE
long cx
long cy
end type
type DRAWITEMSTRUCT
UINT CtlType
UINT CtlID
UINT itemID
UINT itemAction
UINT itemState
sys hwndItem
sys hDC
RECT rcItem
sys itemData 'ulong_ptr
end type
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes
function RGB(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
return color
end function
% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
string stest="Hello Editor"
' Initialize common controls.
INITCOMMONCONTROLSEXt icex
icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
icex.dwICC = ICC_TAB_CLASSES
InitCommonControlsEx(icex)
sys hInstance=inst
'typedef struct _TRIVERTEX {
'long x
'long y
'COLOR16 RED
'COLOR16 GREEN
'COLOR16 BLUE
'COLOR16 Alpha
'} TRIVERTEX, *PTRIVERTEX, *LPTRIVERTEX
% GRADIENT_FILL_RECT_H = &H00000000???
% GRADIENT_FILL_RECT_V = &H00000001234
% GRADIENT_FILL_TRIANGLE = &H00000002???
% GRADIENT_FILL_OP_FLAG = &H000000ff???
declare function GradientFill lib "MSIMG32.DLL" lib "GradientFill" ( _
byval hdc as dword _ ' __in HDC hdc
, byref pVertex as float _ 'TRIVERTEX _ ' __in PTRIVERTEX pVertex
, byval nVertex as dword _ ' __in ULONG nVertex
, byref pMesh as sys _ ' __in PVOID pMesh
, byval nMesh as dword _ ' __in ULONG nMesh
, byval ulMode as dword _ ' __in ULONG ulMode
) as long ' BOOL
function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
===============================================================
indexbase 0
static sys hdc
static RECT r
static RECT rcClient
static sys hwndTab, hwndStatic
'==========
select wMsg
===========
case WM_CREATE
'=============
SetWindowText hwnd,"Right-Click + gradient win + tab"
'------ 1) tabcontrol
' Get the dimensions of the parent window's client area, and
' create a tab control child window of that size.
RECT rcClient
TCITEM tie
GetClientRect(hwnd, rcClient)
hwndTab = CreateWindowEx(WS_EX_CLIENTEDGE,WC_TABCONTROL, "",
WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
10, 50, 350, 250, 'rcClient.right, rcClient.bottom
hwnd, null, hInstance, null)
if (hwndTab = null) then
mbox "Create Tab Control failed"
return null
end if
' Add tabs for each day of the week.
tie.mask = TCIF_TEXT | TCIF_IMAGE
tie.iImage = -1
int i
for i = 0 to <DAYS_IN_WEEK
' Load the day string
tie.pszText=day[i]
if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
mbox "InsertItem Tab failed"
DestroyWindow(hwndTab)
return null
end if
next i
SendMessage hwndTab,WM_ERASEBKGND,0,0
'------ 2) child windows hwndtab in it :-)
int style
string stys
style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
stys="static" 'WS_EX_CLIENTEDGE
hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 100, hinst, null)
stys="button"
'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 101, hinst, null)
stys="edit"
style=WS_CHILD | WS_VISIBLE '| ES_READONLY
hchw[2]=CreateWindowEx(WS_EX_CLIENTEDGE,stys, null, style, 0,0,0,0, hwndtab, 102, hinst, null)
SetWindowText hchw[1],"ok"
SetWindowText hchw[2],"take a Message Here"
static sys hsbr=CreateSolidBrush RGB(128, 128, 0) '0xf0ffff
SendMessage hwnd,WM_SIZE,0,0
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
SendMessage hwnd,WM_ERASEBKGND,0,0
case WM_DESTROY
================
PostQuitMessage 0
case WM_MOUSEMOVE
=================
static short mx,my
mx=loword lparam
my=hiword lparam
case WM_RBUTTONDOWN
===================
static int ms
if not ms
ms=1
ShowWindow hchw[0],1
ShowWindow hchw[1],1
ShowWindow hchw[2],1
endif
'-------------
case WM_PAINT
=============
static as sys hdc
static as String txt
static as PaintStruct Paintst
dim as rect crect 'for WndProc and TimerProc
GetClientRect hWndTab,cRect
hDC=BeginPaint hWndTab,Paintst
sys hbr=CreateSolidBrush rgb(125,255,100) 'bcolor
FillRect hdc,@cRect,hbr
'SetBkColor hdc,yellow
SetTextColor hdc,red
DrawText hDC,"testFile for coloring text and background",-1,cRect,0x25
EndPaint hWndTab,Paintst
case WM_CTLCOLORSTATIC
======================
sys hdc=wparam
sys hwn=lparam
if hwn=hchw[0]
return hsbr
endif
if hwn=hwndTab
return hsbr
endif
case WM_CTLCOLOREDIT
====================
sys hdc=wparam
sys hwn=lparam
int fcolor=0x880000
int bcolor= rgb(125,125,255) '0xf0ffff
RECT rec
if hwn=hchw[2]
GetClientRect hwn,@rec
'sys hbr=CreateSolidBrush bcolor
'FillRect hdc,@rec,hbr
'DeleteObject hbr
'
SetBkColor hdc,bcolor
'SetTextColor hdc,fcolor
'DrawText hDC,"text text",-1,@rec,0x25
return hsbr
endif
if hwn=hwndTab
GetClientRect hwn,@rec
'sys hbr=CreateSolidBrush bcolor
'FillRect hdc,@rec,hbr
'DeleteObject hbr
'
SetBkColor hdc,bcolor
'SetTextColor hdc,fcolor
'DrawText hDC,"text text",-1,@rec,0x25
return hsbr
endif
case WM_CTLCOLORBTN
===================
sys hdc=wparam
sys hwn=lparam
int bcolor=0x0020e0
int fcolor= rgb(125,125,0) '0xeeeeee
RECT rec
if hwn=hchw[1]
GetClientRect hwn,@rec
sys hbr=CreateSolidBrush bcolor
FillRect hdc,@rec,hbr
SetBkColor hdc,bcolor
SetTextColor hdc,fcolor
DrawText hDC,"OK",-1,@rec,0x25
DeleteObject hbr
return 0
endif
if hwn=hwndTab
GetClientRect hwn,@rec
sys hbr=CreateSolidBrush bcolor
FillRect hdc,@rec,hbr
SetBkColor hdc,bcolor
SetTextColor hdc,fcolor
DrawText hDC,"OK2",-1,@rec,0x25
DeleteObject hbr
return 0
endif
case WM_ERASEBKGND
==================
int bcolor=0x000080
RECT r
GetClientRect hwnd,@r
sys hbr=CreateSolidBrush bcolor
'wparam is hdc
FillRect wparam,@r,hbr
DeleteObject hbr
return 1
case WM_COMMAND
===============
if wparam=101 'popup ok button
ShowWindow hchw[0],0
ShowWindow hchw[1],0
ShowWindow hchw[2],0
ms=0
endif
case WM_KEYDOWN
===============
if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0 'ESCAPE
case WM_SIZE
============
RECT rc
GetClientRect(hwnd, rc)
int px=rc.right \2 - 100
int py=rc.bottom \2 -35
'child window, position x,y size x.y, show
MoveWindow(hchw[0], px,py, 300, 300, TRUE) '200, 70 right click window size
'MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE) 'ok button
MoveWindow(hchw[1], px+165,py+95, 40, 40 TRUE)
MoveWindow(hchw[2], px+15,py+15, 190, 30 TRUE) 'Editbox
case WM_DESTROY
DeleteObject hsbr
PostQuitMessage 0
case else
=========
function=DefWindowProc hWnd,wMsg,wParam,lParam
end select
'
end function ' WndProc
MainWindow 520,420,WS_OVERLAPPEDWINDOW
A Screenshot of this example I couldnt built Strange
Frank
something is wrong with your window paint and erase back
because when we move windows he tend to remove sys buttons and windows frame
at least on my win7 64 bit
Also
you put a lot of stuff under WM_CREATE which is not
good as far as I can tell you from my experience ?
..and why is your "GLOBAL" code under Callback function?
hmm ..i will check this better
Frank
This is set of functions i use for TabControl
Function SetTabControl (byval _tbhwnd as INT,byval _tx as INT,byval _ty as INT,byval _tw as INT,byval _th as INT,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
If _tbflag=0
_tbflag=WS_CHILD | WS_VISIBLE| TCS_HOTTRACK
End If
hTabControl = CreateWindowEx(_ex,"SysTabControl32","",_tbflag,_tx,_ty,_tw,_th,_tbhwnd,cID,0,0)
_hfont = GetStockObject(17)
SendMessage hTabControl,WM_SETFONT,_hfont,0
UpdateWindow _tbhwnd
Function = hTabControl
End Function
'=====================================================================================
'AddTab
Function AddTab (byval hwnd as INT ,byval tbpos as INT,byval tbtext as String ) as INT
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tbtext)
tie.cchTextMax=Len(tbtext)
tie.iImage = -1
SendMessage(hWnd,0x1307,tbpos,&tie)
End Function
'=====================================================================================
Function SetTabText (cntID as INT,tbIndex as INT,tabText as String)
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tabText)
tie.cchTextMax=Len(tabtext)
tie.iImage = -1
SendMessage(cntID,TCM_SETITEM,tbIndex,&tie)
Return
End Function
'=====================================================================================
SUB SetSelectedTab (cntID as INT,index as INT)
Sendmessage (cntID,TCM_SETCURSEL,index,0)
'Return tbIndex
End Sub
'=====================================================================================
Function GetSelectedTab (cntID as INT) as INT
INT tbIndex
tbIndex = Sendmessage (cntID,TCM_GETCURSEL,0,0)
Return tbIndex
End Function
'=====================================================================================
Function GetTabText (cntID as INT,tbIndex as INT) as string
string tabText=Space(256)
TC_ITEM tie
tie.mask=1
tie.pszText = strptr tabText
tie.cchTextMax = 256
tie.iImage = -1
Sendmessage (cntID,TCM_GETITEM,tbIndex,&tie)
Return tabText
End Function
'=====================================================================================
Function GetTabCount (cntID as INT) as INT
INT tbCount
tbCount = Sendmessage (cntID,TCM_GETITEMCOUNT,0,0)
Return tbCount
End Function
'=====================================================================================
Function DeleteTab (cntID as INT, index as INT ) as INT
Sendmessage (cntID,TCM_DELETEITEM,index,0)
Return 0
End Function
Frank
you declare GradientFill api function and then you don't use it ?
just create mess-up with other code ?
declare function GradientFill lib "MSIMG32.DLL" lib "GradientFill" ( _
byval hdc as dword _ ' __in HDC hdc
, byref pVertex as float _ 'TRIVERTEX _ ' __in PTRIVERTEX pVertex
, byval nVertex as dword _ ' __in ULONG nVertex
, byref pMesh as sys _ ' __in PVOID pMesh
, byval nMesh as dword _ ' __in ULONG nMesh
, byval ulMode as dword _ ' __in ULONG ulMode
) as long ' BOOL
also what is this :
MainWindow 520,420,WS_OVERLAPPEDWINDOW
you don't have handler of this main window, it is too limited
kind of tik-tok style ;D
main window should be :
hwnd = CreateWindowEx 0, ClassName, caption, style, Wx, Wy, Ww, Wh, wparent, 0, inst, 0
oups
i just looked into WinUtil
so this is for MainWindow
CreateMainWindow 'MACRO WITH OPENGL OVERRIDE
i think that MainWindow is just wrapper but it looks that is for openGL ?
Hi Aurel
WinUtil.inc is used for most of the windows demos, OpenGl demos, and IDEs. The meta-programming is a bit complicated but provides flexibility.
Hi Frank,
Have you thought about using buttons and edit-boxes to make you own Tab control? I think it would make customizing easier.
1) Yes Charles better to build Buttons Labels and so on.. for own tabcontrol... I found already an old Powerbasic example but I Had a Problem with the gradientfill function I have translated but I think I dont need to use IT Here
2) I will Go another way with owner Draw for my Editor
Regards frank
My Idea of a new Editor goes more and more this Direction with color Buttons and reduce all to Minimum ...
Dummy Demo Pictures below
IT took nearly two hours in Work together build this Setup but I Like IT :)
Hi Frank
Where is code for above example Test color tabs ?
with green and red tabs...i am interested
maybe can be used for themes for example BLACK THEME for editor
a main resizable modal dialog with a tab control, each tab control have a sub tab-modeless-dialog with his own controls
those sub tab-modeless-dialog have to be sibbling of the tab control, not child.
all messages from all tab-modeless-dialog goes to TabsCommonDialogProc callback,
one could create one callback for each dialog.
code is ansi, some minor changes are needed for wide unicode.
GradientFill is used to draw the background.
See Raymond Chen tab control (https://devblogs.microsoft.com/oldnewthing/20191015-00/?p=102996)
TabControl.png
'a main resizable modal dialog with a tab control, each tab control have a sub tab-modeless-dialog with his own controls
'those sub tab-modeless-dialog have to be sibbling of the tab control, not child.
'all messages from all tab-modeless-dialog goes to TabsCommonDialogProc callback,
'one could create one callback for each dialog.
'code is ansi, some minor changes are needed for wide unicode.
GradientFill is used to draw the background.
'See Raymond Chen https://devblogs.microsoft.com/oldnewthing/20191015-00/?p=102996
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res"
//KickSwitch -64
//KickEnd
#autodim off
indexbase 0
uses "Dialogs.inc"
%MainDialogButton01 101
%MainDialogButtonIDCANCEL IDCANCEL
%Dialog0Frame 0101
%Dialog0ButtonOk 0102
%Dialog0Edit 0201
%Dialog1Frame 1101
%Dialog1ButtonOk 1102
%Dialog1Edit 1201
%Dialog2Frame 2101
%Dialog2ButtonOk 2102
%Dialog2Edit 2201
%DS_MODALFRAME 0x0080
%DS_3DLOOK 0x0004
%DS_NOFAILCREATE 0x0010
%DEFAULT_GUI_FONT 17
%GCL_HICON -14
%WS_EX_RIGHTCROLLBAR 0
%WM_APP 0x08000
%WM_MOVING 0x0216
%RDW_INVALIDATE 0x0001
%RDW_ALLCHILDREN 0x0080
%RDW_INVALIDATE 0x0001
%RDW_INTERNALPAINT 0x0002
%RDW_ERASE 0x0004
%SWP_NOSIZE 0x0001
%SWP_NOMOVE 0x0002
%SWP_NOZORDER 0x0004
%SWP_NOREDRAW 0x0008
%SWP_NOACTIVATE 0x0010
%SWP_FRAMECHANGED 0x0020
%SWP_SHOWWINDOW 0x0040
%SWP_HIDEWINDOW 0x0080
%SWP_NOCOPYBITS 0x0100
%SWP_NOOWNERZORDER 0x0200
%SWP_NOSENDCHANGING 0x0400
%SWP_DRAWFRAME %SWP_FRAMECHANGED
%SWP_NOREPOSITION %SWP_NOOWNERZORDER
%TCS_MULTILINE 0x0200
%TCIF_TEXT 1
%TCIF_IMAGE 2
%TCIF_PARAM 0x0008
%TCIF_STATE 0x0010
%TCM_FIRST 0x1300
%TCN_FIRST 0-550
%TCN_SELCHANGE %TCN_FIRST - 1
%TCN_SELCHANGING %TCN_FIRST - 2
%TCM_GETIMAGELIST %TCM_FIRST + 2
%TCM_SETIMAGELIST %TCM_FIRST + 3
%TCM_GETITEMCOUNT %TCM_FIRST + 4
%TCM_GETCURSEL %TCM_FIRST + 11
%TCM_INSERTITEMA %TCM_FIRST + 7
%TCM_ADJUSTRECT %TCM_FIRST + 40
%TCM_INSERTITEMW %TCM_FIRST + 62
%TCM_INSERTITEM %TCM_INSERTITEMW
%RDW_VALIDATE 0x0008
%RDW_NOINTERNALPAINT 0x0010
%RDW_NOERASE 0x0020
%RDW_NOCHILDREN 0x0040
%RDW_ALLCHILDREN 0x0080
%RDW_UPDATENOW 0x0100
%RDW_ERASENOW 0x0200
%RDW_FRAME 0x0400
%RDW_NOFRAME 0x0800
%WC_TABCONTROL "SysTabControl32"
%WC_STATIC "Static"
%ICC_TAB_CLASSES 8
%SWP_SHOWWINDOW 64
%SIZE_MINIMIZED 1
%HWND_TOP 0
%HWND_DESKTOP 0
%DeviceCount 7
string device[] = {"Monitor","Printer","Speaker","Mouse","USB","BlueTooth","Battery"}
word deviceBmp[] = {3, 7, 15, 18, 47, 55, 45}
type TCITEM 'TCITEMA TCITEMW
int mask, dwState, dwStateMask
char* pszText
int cchTextMax, iImage
sys lParam
end type
typedef TCITEM TC_ITEM
TYPE SP_CLASSIMAGELIST_DATA
dword cbSize 'DWORD
sys ImageList 'HIMAGELIST
sys Reserved 'ULONG_PTR
END TYPE
! SetupDiGetClassImageList lib "SetupApi.dll" alias "SetupDiGetClassImageList"(sys) as bool
! SetupDiDestroyClassImageList lib "SetupApi.dll" alias "SetupDiDestroyClassImageList"(sys) as bool
'______________________________________________________________________________
%GRADIENT_FILL_RECT_H 0x00000000
%GRADIENT_FILL_RECT_V 0x00000001
%GRADIENT_FILL_TRIANGLE 0x00000002
%GRADIENT_FILL_OP_FLAG 0x000000ff
TYPE GRADIENT_RECT '8 bytes
dword UpperLeft
dword LowerRight
END TYPE
TYPE TRIVERTEX '16 bytes
LONG x 'LONG
LONG y 'LONG
WORD Red 'COLOR16
WORD Green 'COLOR16
WORD Blue 'COLOR16
WORD Alpha 'COLOR16
END TYPE
! GradientFill lib "MSIMG32.DLL" alias "GradientFill"(sys, sys, dword, sys, dword, dword) as bool
'______________________________________________________________________________
sub DrawGradient(sys hDlg, sys hDC, short TabId)
GRADIENT_RECT GradientRect
dim TRIVERTEX Vertex(1)
Rect rc
GetClientRect(hDlg, rc)
Vertex(0).x = 0
Vertex(0).y = 0
Vertex(0).Red = 0x0010
Vertex(0).Green = 0x0010
Vertex(0).Blue = 0x0010
Vertex(1).x = rc.Right
Vertex(1).y = rc.Bottom
Vertex(1).Red = 0
Vertex(1).Green = 0
Vertex(1).Blue = 0xffff
GradientRect.UpperLeft = 0 'Vertex(0)
GradientRect.LowerRight = 1 'Vertex(1)
GradientFill(hDC, @Vertex(0, 0), 2, @GradientRect, 1, GRADIENT_FILL_RECT_V)
end sub
'_____________________________________________________________________________
function TabsCommonDialogProc(sys hTabDialog, uint uMsg, sys wParam, lParam) as int callback
'this is a common dialog used by every TABs dialog
static sys hTabControl, hBrush
static short TabId 'will be set in WM_ERASEBKGND
static long ClientSizeX, ClientSizeY
select case uMsg
case WM_INITDIALOG
dword RGB_BLUE = 0x00FF0000
hBrush = CreateSolidBrush(RGB_BLUE)
hTabControl = FindWindowEx(GetParent(hTabDialog), 0, "SysTabControl32", "wcTabControl-01")
return true
case WM_COMMAND
select case TabId
case 0 'Tab-Dialog-0
select case loword(wParam)
case Dialog0ButtonOk
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
Beep(5500, 50)
end if
case Dialog0Edit
if hiword(wParam) = EN_CHANGE THEN
end if
if hiword(wParam) = EN_SETFOCUS THEN
Beep(2500, 50)
end if
if hiword(wParam) = EN_KILLFOCUS THEN
end if
end select
case 1 'Tab-Dialog-1
select case loword(wParam)
case Dialog1ButtonOk
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
Beep(1500, 50)
end if
end select
case 2 'Tab-Dialog-2
select case loword(wParam)
case Dialog2ButtonOk
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
Beep(1500, 50) : Beep(3500, 50)
end if
end select
end select
CASE WM_ERASEBKGND
'display each TAB dialog with a gradient background color
TabId = SendMessage(hTabControl, TCM_GETCURSEL, 0, 0)
DrawGradient(hTabDialog, wParam, TabId)
gosub MoveControl
Return(1)
case WM_CTLCOLOREDIT 'WM_CTLCOLORBTN | WM_CTLCOLORMSGBOX | WM_CTLCOLORSTATIC | WM_CTLCOLORSCROLLBAR | WM_CTLCOLORLISTBOX
select GetDlgCtrlID(lParam)
'edit control colorisation
case Dialog0Edit, Dialog1Edit, Dialog2Edit
SetTextColor(wParam, 0x00FFFF) 'yellow
SetBkColor(wParam, 0xFF0000) 'blue
return(hBrush) 'blue
case else
return(0)
end select
case WM_SIZE 'dialog size have changed
if wParam <> SIZE_MINIMIZED
ClientSizeX = loword(lParam)
ClientSizeY = hiword(lParam)
gosub MoveControl
endif
case WM_CLOSE
'DestroyWindow(hTabDialog)
case WM_DESTROY
if hBrush then DeleteObject(hBrush)
PostQuitMessage(0)
end select
return 0
MoveControl:
select case TabId
case 0
MoveWindow(GetDlgItem(hTabDialog, Dialog0Frame), 10, 10, ClientSizeX - 20, ClientSizeY - 20, %TRUE)
MoveWindow(GetDlgItem(hTabDialog, Dialog0ButtonOk), 30, 40, 110, 25, %TRUE)
MoveWindow(GetDlgItem(hTabDialog, Dialog0Edit), 150, 45, 50, 16, %TRUE)
case 1
MoveWindow(GetDlgItem(hTabDialog, Dialog1Frame), 10, 10, ClientSizeX - 20, ClientSizeY - 20, %TRUE)
MoveWindow(GetDlgItem(hTabDialog, Dialog1ButtonOk), 30, 40, 110, 25, %TRUE)
MoveWindow(GetDlgItem(hTabDialog, Dialog1Edit), 150, 45, 50, 16, %TRUE)
case 2
MoveWindow(GetDlgItem(hTabDialog, Dialog2Frame), 10, 10, ClientSizeX - 20, ClientSizeY - 20, %TRUE)
MoveWindow(GetDlgItem(hTabDialog, Dialog2ButtonOk), 30, 40, 110, 25, %TRUE)
MoveWindow(GetDlgItem(hTabDialog, Dialog2Edit), 150, 45, 50, 16, %TRUE)
end select
ret
end function
'______________________________________________________________________________
function MainDialogProc(sys hDlg, uint uMsg, sys wParam, lParam) as int callback
'creation of tab control and all needed tab-dialogs with their control
static SP_CLASSIMAGELIST_DATA ClassImageListData
static sys hIcon, hFont, hTabControl, ImageList
static short TabId, TabIdPrv
dim static sys hTabDlg[6]
select case uMsg
case WM_INITDIALOG
hIcon = ExtractIcon(GetModuleHandle(0), "Shell32.dll", 294) 'o icon
SetClassLongPtr(hDlg, GCL_HICON, hIcon)
hFont = GetStockObject(DEFAULT_GUI_FONT) 'DeleteObject not really needed becose StockObject
SendMessage(GetDlgItem(hDlg, MainDialogButton01), WM_SETFONT, hFont, 0)
SendMessage(GetDlgItem(hDlg, MainDialogButtonIDCANCEL), WM_SETFONT, hFont, 0)
'create main tab control container
hTabControl = CreateWindowEx(0, WC_TABCONTROL, "wcTabControl-01",
WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE | TCS_MULTILINE | WS_TABSTOP,
0, 0, 100, 100, 'remove TCS_MULTILINE for one row only tabs
hDlg, null, GetModuleHandle(0), null)
if hTabControl = null : mbox "Create Tab Control failed" : return null : endif
SendMessage(hTabControl, WM_SETFONT, hFont, 0)
'steal bmp image list from SetupDi api
ClassImageListData.cbSize = SIZEOF(SP_CLASSIMAGELIST_DATA)
SetupDiGetClassImageList(@ClassImageListData)
SendMessage(hTabControl, TCM_SETIMAGELIST, 0, ClassImageListData.ImageList)
'create seven (DeviceCount) TAB item
TCITEM TabItem
TabItem.mask = TCIF_TEXT | TCIF_IMAGE | TCIF_PARAM
for TabId = 0 to < %DeviceCount
TabItem.pszText = device[TabId]
TabItem.cchTextMax = len(device[TabId])
TabItem.iImage = deviceBmp[TabId] 'select an icon in the image list
TabItem.lParam = TabId 'if more or less than 4 bytes of application-defined data exist per tab,
'an application must define a structure and use it instead of the TCITEM structure.
'The first member of the application-defined
if SendMessage(hTabControl, TCM_INSERTITEMA, TabId, @TabItem) = -1 then
mbox "InsertItem Tab failed" : DestroyWindow(hTabControl)
return null
endif
next
'create seven (DeviceCount) hidden tab-dialog, only view one
TabId = 0
Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
GroupBox("Frame - " + device(TabId) + " " + str(TabId), Dialog0Frame, 1, 1, 118, 38)
PushButton("IDOK 0", Dialog0ButtonOk, 20, 25, 40, 12)
Control("[edit 0]", Dialog0Edit, "Edit", ES_LEFT | ES_NOHIDESEL | WS_TABSTOP, 76, 28, 40, 8, WS_EX_LEFT | WS_EX_STATICEDGE)
hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)
TabId = 1
Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
GroupBox("Frame - " + device(TabId) + " " + str(TabId), Dialog1Frame, 1, 1, 118, 38)
PushButton("IDOK 1", Dialog1ButtonOk, 20, 25, 40, 12)
Control("[edit 1]", Dialog1Edit, "Edit", ES_LEFT | ES_NOHIDESEL | WS_TABSTOP, 76, 28, 40, 8, WS_EX_LEFT | WS_EX_STATICEDGE)
hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)
TabId = 2
Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
GroupBox("Frame - " + device(TabId) + " " + str(TabId), Dialog2Frame, 1, 1, 118, 38)
PushButton("IDOK 2", Dialog2ButtonOk, 20, 25, 40, 12)
Control("[edit 2]", Dialog2Edit, "Edit", ES_LEFT | ES_NOHIDESEL | WS_TABSTOP, 76, 28, 40, 8, WS_EX_LEFT | WS_EX_STATICEDGE)
hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)
for TabId = 3 to < DeviceCount
Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)
next
TabId = 0 : ShowWindow(hTabDlg(TabId), SW_SHOW)
return true
case WM_COMMAND
select case loword(wParam)
case MainDialogButton01
if hiword(wParam) = BN_CLICKED | hiword(wParam) = 1
Beep(3500, 50)
endif
case MainDialogButtonIDCANCEL
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
EndDialog(hDlg, null)
end if
end select
case WM_SIZE 'main dialog size have changed
if wParam <> SIZE_MINIMIZED
long ClientSizeX = loword(lParam) 'client area width in pixels.
long ClientSizeY = hiword(lParam) 'client area height in pixels.
MoveWindow(hTabControl, 10, 10, ClientSizeX - 20, ClientSizeY - 50, %TRUE)
gosub TabClientRectAjust 'TabId must be set right before gosub 'ADJUSTRECT
MoveWindow(GetDlgItem(hDlg, MainDialogButton01), 20, ClientSizeY - 32, 90, 25, %TRUE)
MoveWindow(GetDlgItem(hDlg, MainDialogButtonIDCANCEL), ClientSizeX - 110, ClientSizeY - 32, 90, 25, %TRUE)
endif
case WM_NOTIFY 'tab selection
NMHDR pNotifyMessageHeader at lParam
if pNotifyMessageHeader.hwndFrom = hTabControl then
'tab notification: NM_CLICK, NM_DBLCLK, NM_RCLICK, NM_RDBLCLK, NM_RELEASEDCAPTURE,
' TCN_FOCUSCHANGE, TCN_GETOBJECT, TCN_KEYDOWN, TCN_SELCHANGE, TCN_SELCHANGING.
if pNotifyMessageHeader.code = TCN_SELCHANGING then 'sent before the selection changes
TabIdPrv = SendMessage(hTabControl, TCM_GETCURSEL, 0, 0)
ShowWindow(hTabDlg(TabIdPrv), SW_HIDE)
elseif pNotifyMessageHeader.code = TCN_SELCHANGE then 'sent after the selection changes
TabId = SendMessage(hTabControl, TCM_GETCURSEL, 0, 0)
gosub TabClientRectAjust
ShowWindow(hTabDlg(TabId), SW_SHOWNORMAL)
endif
endif
case WM_CLOSE
EndDialog(hDlg, null)
case WM_DESTROY
if ClassImageListData.ImageList then ImageList_Destroy(@ClassImageListData) 'in this case, don't use SetupDiDestroyClassImageList()
if hIcon then DestroyIcon(hIcon)
end select
return 0
TabClientRectAjust:
rect rcTabControl
GetWindowRect(hTabControl, rcTabControl)
MapWindowPoints(HWND_DESKTOP, hDlg, rcTabControl, 2)
SendMessage(hTabControl, TCM_ADJUSTRECT, false, rcTabControl) 'window rectangle
MoveWindow(hTabDlg(TabId), rcTabControl.left, rcTabControl.top,
rcTabControl.right - rcTabControl.left,
rcTabControl.bottom - rcTabControl.top, %TRUE)
ret
end function
'______________________________________________________________________________
sub winmain()
sys hDlg
MSG wMsg
init_common_controls()
Dialog(0, 0, 300, 200, "OxygenBASIC" + sizeof(sys) * 8 + " - TAB control - Sizeable", WS_CAPTION |
WS_SIZEBOX | WS_MINIMIZEBOX | WS_MAXIMIZEBOX | WS_SYSMENU | DS_CENTER, 9, "Segoe UI", 0)
PushButton("Button", MainDialogButton01, 40, 85, 40, 12)
PushButton("Close", MainDialogButtonIDCANCEL, 130, 85, 40, 12)
CreateModalDialog(null, @MainDialogProc, 0)
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'
updated Dialogs.inc for safer memory buffer
'library functions for creating dialogs at runtime in memory
'coded according to Win32 Help file
'
'based on
'dialogs.bas in:
'https://www.freebasic.net/forum/viewtopic.php?t=5667
'dialogs.inc in:
'MASM32 SDK
'Pierre Bellisle memory buffer modification, search for "2024-02-01:"
uses corewin
uses generics
#ifdef review
uses console
#endif
'some classes for using InitCommonControlsEx
% WC_HEADER="SysHeader32"
% TOOLBARCLASSNAME="ToolbarWindow32"
% STATUSCLASSNAME="msctls_statusbar32"
% TRACKBAR_CLASS="msctls_trackbar32"
% UPDOWN_CLASS="msctls_updown32"
% PROGRESS_CLASS="msctls_progress32"
% WC_LISTVIEW="SysListView32"
% WC_TREEVIEW="SysTreeView32"
% WC_TABCONTROL="SysTabControl32"
% ANIMATE_CLASS="SysAnimate32"
% RICHEDIT_CLASS10A="RICHEDIT"
% RICHEDIT_CLASS="RichEdit20A"
% MSFTEDIT_CLASS="RichEdit50W"
% MONTHCAL_CLASS="SysMonthCal32"
% DATETIMEPICK_CLASS="SysDateTimePick32"
% WC_IPADDRESS="SysIPAddress32"
% HOTKEY_CLASS="msctls_hotkey32"
% REBARCLASSNAME="ReBarWindow32"
% WC_PAGESCROLLER="SysPager"
% WC_NATIVEFONTCTL="NativeFontCtl"
% WC_COMMCTRL_DRAGLISTMSG="commctrl_DragListMsg"
% WC_COMBOBOXEX="ComboBoxEx32"
% TOOLTIPS_CLASS="tooltips_class32"
'==============================================================================
'Items needed to run dialogs.inc
% DS_SETFONT=0x40
% SS_LEFT=0
% SS_CENTER=1
% SS_RIGHT=2
% SS_ICON=3
% SS_BITMAP=0x0E
% SS_NOTIFY=0x0100
% CBS_SIMPLE=1
% CBS_DROPDOWN=2
% CBS_DROPDOWNLIST=3
% CBS_SORT=0x0100
% CBS_HASSTRINGS=0x0200
% ES_SAVESEL=0x8000
'some often used constants
% DS_CENTER=0x0800
% LR_LOADFROMFILE=0x0010
% IMAGE_BITMAP=0
% IMAGE_ICON=1
% ICON_SMALL=0
% ICON_BIG=1
% WM_SETICON=0x80
% STM_SETIMAGE=0x172
% SWP_NOMOVE=2
% SWP_NOREDRAW=8
% COLOR_WINDOW=5
% SM_CXBORDER=5
% SM_CYBORDER=6
% SWP_NOZORDER=4
% HWND_TOPMOST= -1
% HORZRES=8
% VERTRES=10
% ODS_SELECTED=1
% WM_DRAWITEM=0x2B
% SRCCOPY=0xCC0020
% SB_SETTEXT=0x401
% SB_SETPARTS=0x404
'MultiByteToWideChar
% CP_ACP=0
% MB_PRECOMPOSED=1
'WinApi types
packed type DLGTEMPLATE 'template for dialog box
dword style
dword dwExtendedStyle
word cdit 'number of items
short x 'in dialog box units
short y
short cx 'width
short cy 'height
end type
'immediately followed by some data
packed type DLGITEMTEMPLATE 'template for a control in a dialog box
dword style
dword dwExtendedStyle
short x 'in dialog box units
short y
short cx 'width
short cy 'height
word id 'control identifier
end type
'immediately followed by some data
'needed for menus
% GRAYED=MF_GRAYED
% CHECKED=MF_CHECKED
% OWNERDRAW=MF_OWNERDRAW
string tab=chr(9)
'needed for accelerators
% FVIRTKEY=1 'TRUE
% FNOINVERT=0x02
% FSHIFT=0x04
% FCONTROL=0x08
% FALT=0x10
type ACCEL
byte fVirt
word key
word cmd
end type
'====================================================================
sys g_memptr 'points to an address in memory
int g_dialog_width 'for centering a control in a dialog.
int g_Ccount 'controls actually created
sys g_lpdtptr 'pointer to initial DLGTEMPLATE struc
string sDialogTemplate '2024-02-01
'====================================================================
'macros
macro align_2(v) {v+=1 : v = v and -2}
macro align_4(v) {v+=3 : v = v and -4}
macro make_ustring(text,memptr, count)
int count = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED,
text,
-1,
memptr,
len(text)+1 )
memptr += count*2
end macro
macro set_val(i,v) {i=v : g_memptr+=sizeof(i)}
'====================================================================
' Create a modal dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' DialogBoxIndirectParam function does not return until EndDialog.
' rval returns whatever was specified as result of EndDialog.
'
function CreateModalDialog( sys hParent, sys *lpDialogProc, dwInitParam, optional lpdt=g_lpdtptr) as sys
sys rval
rval = DialogBoxIndirectParam( GetModuleHandle(null),
lpdt,
hParent,
@lpDialogProc,
dwInitParam )
if rval=-1 then
mbox "Creating modal Dialog failed. Stop!"
#ifdef review
printl "Error: rval = " rval
printl "Enter to end ... ": waitkey
#endif
ExitProcess(0)
end if
sDialogTemplate = "" '2024-02-01
return rval
end function
'====================================================================
' Create a modeless dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' CreateDialogIndirectParam function will use DestroyWindow to return
' rval normally returns the handle to the dialog window.
'
' WS_VISIBLE style is required for a modeless dialog to be visible.
'
function CreateModelessDialog( sys hParent, sys *lpDialogProc, lParamInit, optional lpdt=g_lpdtptr) as sys
sys rval
rval = CreateDialogIndirectParam( GetModuleHandle(null),
lpdt,
hParent,
@lpDialogProc,
lParamInit )
if rval=0 then
mbox "Cannot create modeless Dialog. Stop!"
#ifdef review
printl "Error: rval = " rval
printl "Enter to end ... ": waitkey
#endif
ExitProcess(0)
end if
sDialogTemplate = "" '2024-02-01
return rval
end function
'====================================================================
' Initialize the essential members of the DLGTEMPLATE structure,
' the menu, class, and title arrays, and optionally the font
' point size and typeface array. Returns a pointer to the next
' WORD following the title or typeface array in g_memptr, and a
' pointer to the allocated memory in lpdt.
'
' Parameter cdit must match the number of controls defined.
' If the value is too high then the function that creates the
' dialog will fail. If the value is too low then one or more
' of the controls will not be created.
'
'
sub Dialog( short x,y,cx,cy, string title, dword style,
optional short pointSize=0, string typeFace="", dword extStyle=0)
int e = int(title) : if e != 0 or title=0 then mbox "Warning: title in Dialog probably not a string"
#ifdef review
printl "sub Dialog: try to create Dialog template structure"
#endif
sDialogTemplate=nuls(20480) '2024-02-01
g_lpdtptr=strptr(sDialogTemplate) '2024-02-01
word cdit at g_lpdtptr+sizeof(dword)*2 'lpdt.cdit
cdit = 0
g_dialog_width = cx
DLGTEMPLATE lpdt at g_lpdtptr
lpdt.style = style
lpdt.dwExtendedStyle = extStyle
lpdt.cdit = cdit
lpdt.x = x
lpdt.y = y
lpdt.cx = cx
lpdt.cy = cy
' Set g_memptr to the menu array that follows the structure.
g_memptr = g_lpdtptr + sizeof(lpdt)
word menu_ at g_memptr : set_val(menu_, 0)
word class_ at g_memptr : set_val(class_, 0)
'title array and set g_memptr to next WORD following the title array.
make_ustring( title, g_memptr )
'if DS_SETFONT then point size and typeface
if style and DS_SETFONT then
word pointsize_ at g_memptr : set_val(pointsize_, pointSize)
make_ustring( typeFace, g_memptr )
end if
g_Ccount=0
end sub
'====================================================================
' General-purpose control definition starting at g_memptr, initializes
' the essential members of a DLGITEMTEMPLATE structure and
' the class, caption and creation data arrays.
'
' For the class array - six predefined system (User32) classes -
' use "BUTTON", "EDIT", "STATIC", "LISTBOX", "SCROLLBAR", and "COMBOBOX".
' For common controls use the class strings defined for comctl32.dll.
'
' Caption array can specify the caption or initial text for the control,
' or the ordinal value of a resource in the executable file.
' Specify a caption or initial text in the caption parameter,
' or an ordinal value in the rid (ResourceID) parameter. If the
' rid parameter is non-zero then the caption parameter is ignored.
'
' There is no support for creation data.
'
' The tab order of the controls in a dialog is determined by the order in which
' the controls are created and which controls have the WS_TABSTOP style.
'
' To center the control in the dialog horizontally specify -1 for the x parameter.
' This feature will not work correctly for an auto-sized control.
'
sub control( string caption, word cid, string _class, dword style=0, short x,y,cx,cy,
optional extStyle = 0, short rid=0 )
if x = -1 then x = (g_dialog_width - cx) / 2
'--------------------------------------------------------------
'must be dword boundary
'--------------------------------------------------------------
align_4(g_memptr)
'initialize the essential members of the structure.
'establish the base style as WS_CHILD or WS_VISIBLE.
DLGITEMTEMPLATE lpdit at g_memptr
lpdit.style = WS_CHILD or WS_VISIBLE or style
lpdit.dwExtendedStyle = extStyle
lpdit.x = x
lpdit.y = y
lpdit.cx = cx
lpdit.cy = cy
lpdit.id = cid
'set g_memptr to the class array that follows the structure.
g_memptr += sizeof(lpdit)
'initialize the class array and set g_memptr to the next WORD
make_ustring( _class, g_memptr )
'initialize the caption array and set g_memptr to the next WORD
if rid then
word class_ at g_memptr : set_val(class_, 0xffff)
word rid_ at g_memptr : set_val(rid_, rid)
else
make_ustring( caption, g_memptr )
end if
'skip the first element of the creation data, set it to zero (no creation data).
align_2(g_memptr)
word create_data at g_memptr : set_val(create_data, 0)
g_Ccount+=1
#ifdef review
printl "Controls created: " g_Ccount
#endif
word cdit at g_lpdtptr+sizeof(dword)*2 'lpdt.cdit
cdit=g_Ccount
end sub
'====================================================================
' The following specialized control definition procedures are
' simply wrappers for the general-purpose procedure.
'====================================================================
'PUSHBUTTON, PUSHBOX, DEFPUSHBUTTON, CHECKBOX, AUTOCHECKBOX, AUTO3STATE, STATE3, RADIOBUTTON, AUTORADIOBUTTON, GROUPBOX
sub PushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_PUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
sub PushBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_PUSHBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
sub DefPushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_DEFPUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
sub CheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_CHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub AutoCheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub Auto3State( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_AUTO3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub State3( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub RadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub AutoRadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub GroupBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "BUTTON", BS_GROUPBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================
'EDITTEXT, MultiLineText
sub EditText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "EDIT", ES_LEFT or WS_BORDER or WS_TABSTOP or ES_AUTOHSCROLL or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
sub MultiLineText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "EDIT", ES_LEFT|WS_BORDER|WS_TABSTOP|WS_GROUP|WS_VSCROLL|WS_HSCROLL|ES_MULTILINE|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_WANTRETURN|style,x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================
'LTEXT, RTEXT, CTEXT, ICON, Bitmap
sub Ltext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "STATIC", SS_LEFT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub Rtext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "STATIC", SS_RIGHT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub Ctext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "STATIC", SS_CENTER or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub Icon( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "STATIC", SS_ICON or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
sub Bitmap( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
Control( caption, cid, "STATIC", SS_BITMAP or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================
'LISTBOX
sub ListBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "LISTBOX", WS_VSCROLL or WS_BORDER or WS_TABSTOP or LBS_NOTIFY or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================
'SimpleCombo, SortedCombo, COMBOBOX, DropDownList
sub SimpleCombo( string caption,word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
sub SortedCombo( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or CBS_SORT or WS_TABSTOP or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
sub ComboBox(string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "COMBOBOX", CBS_SIMPLE or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
sub DropDownList( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWNLIST or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================
'SCROLLBAR, VScrollBar
sub ScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "SCROLLBAR", SBS_HORZ or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub
sub VScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( "", cid, "SCROLLBAR", SBS_VERT or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub
'====================================================================
' To use a Rich Edit control your app must first call LoadLibrary to load the appropriate DLL
' RICHED32.DLL for version 1.
' RICHED20.DLL for version 2 or 3,
' MSFTEDIT.DLL for version 4.1
'====================================================================
' This procedure is coded for version 1.
sub RichEdit1( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, RICHEDIT_CLASS10A, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
' This procedure is coded for version 2 or 3.
sub RichEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, RICHEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
' This procedure is coded for version 4.1.
sub MsftEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
Control( caption, cid, MSFTEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================
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
/*
0x0001 or ' ICC_LISTVIEW_CLASSES - list view and header control classes.
0x0002 or ' ICC_TREEVIEW_CLASSES - tree view and tooltip control classes.
0x0004 or ' ICC_BAR_CLASSES - toolbar, status bar, trackbar, and tooltip control classes.
0x0008 or ' ICC_TAB_CLASSES - tab and tooltip control classes.
0x0010 or ' ICC_UPDOWN_CLASS - up-down control class.
0x0020 or ' ICC_PROGRESS_CLASS - progress bar control class.
0x0040 or ' ICC_HOTKEY_CLASS - hot key control class.
0x0080 or ' ICC_ANIMATE_CLASS - animate control class.
0x00ff or ' ICC_WIN95_CLASSES - animate control, header, hot key,
' list view, progress bar, status bar, tab,
' tooltip, toolbar, trackbar, tree view,
' and up-down control classes.
0x0100 or ' ICC_DATE_CLASSES - date and time picker control class.
0x0200 or ' ICC_USEREX_CLASSES - ComboBoxEx class.
0x0400 or ' ICC_COOL_CLASSES - rebar control class.
0x0800 or ' ICC_INTERNET_CLASSES - IP address class.
0x1000 or ' ICC_PAGESCROLLER_CLASS - pager control class.
0x2000 or ' ICC_NATIVEFNTCTL_CLASS - native font control class
0x4000 or ' ICC_STANDARD_CLASSES - one of the intrinsic User32 control classes.
' The user controls include button, edit, static,
' listbox, combobox, and scroll bar.
0x8000 ' ICC_LINK_CLASS - hyperlink control class.
*/
end if
InitCommonControlsEx(@iccex)
end sub
'==============================================================================
'Menus, PopupMenus
int g_MnuLv[10] 'Main Menu or PopupMenu and 9 levels of SubMenus
int g_Midx 'Menu index
macro MENU(hMenu)
hMenu=CreateMenu
g_Midx=1
g_MnuLv[1]=hMenu
end macro
'Vertical Main Popup Menu
macro PopupMENU(hMenu)
hMenu=CreatePopupMenu
g_Midx=1
g_MnuLv[1]=hMenu
end macro
sub BEGIN(optional int none=0)
end sub
sub POPUP(string item)
sys hSubM=CreateMenu
g_Midx+=1 : g_MnuLv[g_Midx]=hSubM
AppendMenu( g_MnuLv[g_Midx-1], MF_POPUP, g_MnuLv[g_Midx], item )
end sub
sub MENUITEM(string item, optional sys id=0, uint uflags=MF_STRING)
if lcase(item) = "separator" then
AppendMenu(g_MnuLv[g_Midx], MF_SEPARATOR, 0, 0)
else
AppendMenu(g_MnuLv[g_Midx], uflags, id, item )
end if
end sub
sub ENDMenu(optional int=0)
g_Midx-=1
end sub
'==============================================================================
But what if i use Windows ..not Dialogs
all work?
Then you replace dialogs with windows.
Aurel,
Yes it should work, look at SDK Tab control (https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/55526-close-tabcontrol-right-button-click?p=665548#post665548) on PowerBASIC site.
It could make life it easier if you want to convert code to SDK.
Okay Pierre ;)
Hi Charles,
in Dialogs.inc Pierre replaced sys ValidMemPointer with string sDialogTemplate and if this is results in a safer memory buffer then inc\Dialogs.inc should be replaced? I tested the files in demos\WinDynDialogs and almost all demos ran ok, two or three apps are faulty, but the reason is not because of dialogs.inc. They need to be examined a little more closely.
Hi Roland,
To explain a little, this sDialogTemplate buffer is used in the Dialog() to create a template for
DialogBoxIndirectParam() for modal or CreateDialogIndirectParam() for modeless dialog.
This buffer must be valid from the time Dialog() is called until
CreateModalDialog()/CreateModelessDialog() finishes.
As it was, the buffer itself was local to the Dialog() sub.
That explain all my GPF when I create multiples dialog.
I know some did not get any, still the old code will bite sooner or later.
So I made the buffer global and, to be clean, I free it on
CreateModalDialog()/CreateModelessDialog() exit.
Never had any problem since...
Hi Pierre,
thank you for the info. I know you're much better and more experienced at programming than I am, and I'm glad you've explored further into dialogs.inc. It's still somewhat experimental and could use a few improvements / expansions. But compared to the demos in Freebasic / Masm it performs quite well. In /demos/WinDynDialogs/Pgbar3d.o2bas I was also able to convert an app of Borje Hagsten, although I do not know much about PB, so I think some kind of DDT programming should also be possible.
I would like to ask a question about Kickstart (which I am not currently using, but I will start to check it). KickResource uses Resource.res. Is Resource.res a file that is generally used and what does Resource.rc look like?
Kickstart....is that google Google's online coding competitions :o
Hi Roland,
I really like this Dialogs.inc, it make life easy when you want to use dialogs.
Resource.rc is a classic rc file that, in this case, use an external xml manifest, mainly to have Microsoft.Windows.Common-Controls v6.
The program GoRC.exe in your tool folder will convert this .rc file to a .res file that the compiler will use to create the final exe.
In kick, you may specify a .rc, then Kick will call GoRC to generate the .res file.
If you specify a .res then it will be used directly when calling the compiler.
Aurel, see Kick - o2 precompiler (http://forum.it-berater.org/index.php/topic,5893.0.html)
Here is a zip made from the .rc and the manifest.
Ha ..that one is yours ..i guess
but why he called it kickstart...ok..
You guessed right Aurel.
I don't think anybody is using Kick beside me.
So the name is almost unknown.
Probably Roland saw a squirrel start running at the same time he wrote it...
Many thanks, Pierre,
I've included your update of dialogs.inc, and of course, your TabControlColor example. (demos\WinDynDialogs)
Continuous Update:
https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic.zip
Hi Pierre
I have troubles to get this work properly
I mean ..how to change at runtime color of edit control
i tried this:
ASE WM_CTLCOLOREDIT
'by Pierre Bellisle..
select GetDlgCtrlID(lparam)
case ed1ID
if theme = 4 : SetBkColor(wparam, RGB(43,42,54)): end if
SetTextColor(wparam,RGB(240,230,230))
return darkBrush 'darkColor
case else
darkBrush = CreateSolidBrush(RGB(255,255,255))
SetBkColor( wparam, RGB(255,255,255))
if theme <> 4 : SetTextColor( wparam,RGB(0,0,0)) : end if
return darkBrush
end select