Hi All
Thanks for the help with the previous post.
I am now going forward by leaps and bounds.
One more question please.
I see a lot of old post on this, but perhaps someone had found the solution by now.
The tabcontrol is something i use extensively.
But it has a background i cannot get rid off or change the colour.
(See the Image)
It would be great if one could modify that to just plain white to blend in with the rest of the tool.
Anyone of you did something like that in the past perhaps?
-Thanks Peter
Could you supply some test code that shows the problem? I will look at it and probe it with some tools and report back what I found (if anything) and how I found it.
I just looked at other applications using the tab control using a "control spy" program. It show that the tabs are all the same control. Therefore you would have to handle that during the WM_DRAWITEM message for that control (ownerdraw)
Example PB code:#Compile Exe
#Include "win32api.inc"
#Include "commctrl.inc"
Global hinstance&
Global prevtabproc&
Function WinMain(ByVal hinst&,ByVal hprev&,ByVal cmdline As Asciiz Ptr,ByVal cmdshow&) As Long
hinstance&=hinst&
initcommoncontrols
''create class and register it with windows
Dim wclassname As Asciiz*80
Dim wcaption As Asciiz*80
wclassname="TestColorTabs"
Dim wclass As wndclass
wclass.Style=%cs_hredraw Or %cs_vredraw
wclass.lpfnwndproc=CodePtr(wndproc)
wclass.cbclsextra=0
wclass.cbwndextra=0
wclass.hinstance=hinstance&
wclass.hicon=%Null
wclass.hcursor=loadcursor(%Null,ByVal %idc_arrow)
wclass.hbrbackground=%Null ''getstockobject(%gray_brush)
wclass.lpszmenuname=%Null
wclass.lpszclassname=VarPtr(wclassname)
registerclass wclass
''get size - user defined size or default size
Dim wndrect As rect
systemparametersinfo %spi_getworkarea,0,wndrect,0
xsize&=((wndrect.nright-wndrect.nleft)+1-64)
ysize&=((wndrect.nbottom-wndrect.ntop)+1-64)
xstt&=wndrect.nleft+32
ystt&=wndrect.ntop+32
''create window
wcaption="Test Color Tabs"
Style&=%WS_OVERLAPPEDWINDOW Or %WS_THICKFRAME Or %WS_CLIPSIBLINGS
hwnd&=createwindow(wclassname, _ ''window class name
wcaption, _ ''window caption
Style&, _ ''window style
xstt&, _ ''initial x position
ystt&, _ ''initial y position
xsize&, _ ''initial x size
ysize&, _ ''initial y size
%Null, _ ''parent window handle
%Null, _ ''window menu handle
hinstance&, _ ''program instance handle
%Null) ''creation parameters
showwindow hwnd&,cmdshow&
updatewindow hwnd&
Dim wmsg As tagmsg
While IsTrue(getmessage(wmsg,ByVal %Null,0,0))
translatemessage wmsg
dispatchmessage wmsg
Wend
Function=wmsg.wparam
End Function
Function wndproc(ByVal hwnd&,ByVal msg&,ByVal wparam&,ByVal lparam&) As Long
Static ztext As Asciiz*256
Static htoolbar&,hstatuswin&,htab&
Dim rc As rect
Dim disptr As drawitemstruct Ptr
Dim ti As tc_item
Select Case msg&
Case %WM_CREATE
''create controls
' getclientrect hwnd&,rc
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''create tooltips
Dim tbb(0 To 2) As Static tbbutton
tbb(0).ibitmap=%std_filenew
tbb(0).idcommand=9001
tbb(0).fsstate=%TBSTATE_ENABLED
tbb(0).fsstyle=%TBSTYLE_BUTTON
tbb(0).dwdata=0
tbb(0).istring=0
tbb(1).ibitmap=%std_fileopen
tbb(1).idcommand=9002
tbb(1).fsstate=%TBSTATE_ENABLED
tbb(1).fsstyle=%TBSTYLE_BUTTON
tbb(1).dwdata=0
tbb(1).istring=0
tbb(2).ibitmap=%std_filesave
tbb(2).idcommand=9003
tbb(2).fsstate=%TBSTATE_ENABLED
tbb(2).fsstyle=%TBSTYLE_BUTTON
tbb(2).dwdata=0
tbb(2).istring=0
tbb(3).ibitmap=0
tbb(3).idcommand=0
tbb(3).fsstate=%TBSTATE_ENABLED
tbb(3).fsstyle=%TBSTYLE_SEP
tbb(3).dwdata=0
tbb(3).istring=0
tbb(4).ibitmap=%std_cut
tbb(4).idcommand=9004
tbb(4).fsstate=%TBSTATE_ENABLED
tbb(4).fsstyle=%TBSTYLE_BUTTON
tbb(4).dwdata=0
tbb(4).istring=0
tbb(5).ibitmap=%std_copy
tbb(5).idcommand=9005
tbb(5).fsstate=%TBSTATE_ENABLED
tbb(5).fsstyle=%TBSTYLE_BUTTON
tbb(5).dwdata=0
tbb(5).istring=0
tbb(6).ibitmap=%std_paste
tbb(6).idcommand=9006
tbb(6).fsstate=%TBSTATE_ENABLED
tbb(6).fsstyle=%TBSTYLE_BUTTON
tbb(6).dwdata=0
tbb(6).istring=0
tbb(7).ibitmap=%std_delete
tbb(7).idcommand=9007
tbb(7).fsstate=%TBSTATE_ENABLED
tbb(7).fsstyle=%TBSTYLE_BUTTON
tbb(7).dwdata=0
tbb(7).istring=0
tbb(8).ibitmap=0
tbb(8).idcommand=0
tbb(8).fsstate=%TBSTATE_ENABLED
tbb(8).fsstyle=%TBSTYLE_SEP
tbb(8).dwdata=0
tbb(8).istring=0
tbb(9).ibitmap=%std_properties
tbb(9).idcommand=9008
tbb(9).fsstate=%TBSTATE_ENABLED
tbb(9).fsstyle=%TBSTYLE_BUTTON
tbb(9).dwdata=0
tbb(9).istring=0
tbb(10).ibitmap=%std_find
tbb(10).idcommand=9009
tbb(10).fsstate=%TBSTATE_ENABLED
tbb(10).fsstyle=%TBSTYLE_BUTTON
tbb(10).dwdata=0
tbb(10).istring=0
tbb(11).ibitmap=%std_print
tbb(11).idcommand=9010
tbb(11).fsstate=%TBSTATE_ENABLED
tbb(11).fsstyle=%TBSTYLE_BUTTON
tbb(11).dwdata=0
tbb(11).istring=0
tbb(12).ibitmap=%std_help
tbb(12).idcommand=9011
tbb(12).fsstate=%TBSTATE_ENABLED
tbb(12).fsstyle=%TBSTYLE_BUTTON
tbb(12).dwdata=0
tbb(12).istring=0
Style&=%WS_CHILD Or %WS_BORDER Or %WS_VISIBLE Or %SBS_SIZEGRIP
hstatuswin&=createstatuswindow(Style&,"",hwnd&,9999)
Style&=%WS_CHILD Or %TBSTYLE_TOOLTIPS Or %TBSTYLE_FLAT
htoolbar&=createtoolbarex(hwnd&,Style&,9000,12,%hinst_commctrl, _
%idb_std_large_color,tbb(0),13, _
0,0,100,30, _
Len(tbbutton))
sendmessage htoolbar&,%tb_autosize,0,0
showwindow htoolbar&,%SW_SHOW
getwindowrect htoolbar&,rc
toolheight&=rc.nbottom-rc.ntop
getwindowrect hstatuswin&,rc
statheight&=rc.nbottom-rc.ntop
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' this code was previously in error
getclientrect hwnd&,rc
x1&=0
y1&=toolheight&
x2&=rc.nright-rc.nleft
y2&=(rc.nbottom-rc.ntop)-(toolheight&+statheight&)
Style&=%WS_CHILD Or %WS_VISIBLE Or %TCS_TABS Or %TCS_OWNERDRAWFIXED _
Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN
htab&=createwindow("SysTabControl32","",Style&, _
x1&,y1&,x2&,y2&,hwnd&,1000,hinstance&,%Null)
inserttab htab&,0,"Test1"
inserttab htab&,1,"Test2"
inserttab htab&,2,"Test3"
inserttab htab&,3,"Test4"
inserttab htab&,4,"Test5"
inserttab htab&,5,"Test6"
''subclass the tab control
prevtabproc&=setwindowlong(htab&,%gwl_wndproc,CodePtr(tabsubclassproc))
Case %WM_DRAWITEM
If wparam&=1000 Then ''tab control
disptr=lparam&
' -------------------
SaveDC @disptr.hdc
' -------------------
tabheight&=(@disptr.rcitem.nbottom-@disptr.rcitem.ntop)
pg&=@disptr.itemid
If @disptr.itemstate=%ods_selected Then
@disptr.rcitem.ntop=@disptr.rcitem.ntop+2
fcolor&=RGB(255,255,255)
bcolor&=RGB(128,128,255)
Else
fcolor&=RGB(0,0,0)
bcolor&=RGB(176,176,255)
End If
hbrush&=createsolidbrush(bcolor&)
selectobject @disptr.hdc,hbrush&
settextcolor @disptr.hdc,fcolor&
setbkcolor @disptr.hdc,bcolor&
fillrect @disptr.hdc,@disptr.rcitem,hbrush&
ti.mask=%TCIF_TEXT
ti.psztext=VarPtr(ztext)
ti.cchtextmax=SizeOf(ztext)
Call tabctrl_getitem(getdlgitem(hwnd&,wparam&),@disptr.itemid,ti)
Style&=%dt_singleline Or %dt_center Or %dt_top
drawtext @disptr.hdc,ztext,Len(ztext),@disptr.rcitem,Style&
deleteobject hbrush&
' -------------------
RestoreDC @disptr.hdc, 1
' -------------------
Function=1
Exit Function
End If
Case %WM_PAINT
' dim ps as paintstruct
' hdc&=beginpaint(hwnd&,ps)
'
' endpaint hwnd&,ps
Case %WM_MOVE
invalidaterect hwnd&,ByVal %Null,%false
updatewindow hwnd&
Case %WM_NOTIFY
Dim nmh As nmhdr Ptr
nmh=lparam&
Select Case @nmh.idfrom
Case 1000 ''main tabs
Select Case @nmh.code
Case %TCN_SELCHANGING
Case %TCN_SELCHANGE
End Select
End Select
Case %wm_syscommand
If (wparam& And &hfff0)<>%SC_CLOSE Then Exit Select
destroywindow hwnd&
Function=1
Exit Function
Case %WM_COMMAND
Case %WM_DESTROY
''remove subclass
setwindowlong htab&,%gwl_wndproc,prevtabproc&
postquitmessage 0
Function=0
Exit Function
End Select
Function=defwindowproc(hwnd&,msg&,wparam&,lparam&)
End Function
Function SetColor (ByVal Color As Byte) As Word
' the windows api GradientFill routine wants r/g/b colors to be
' 16 bit words with the 8 bit color values left shifted 8 bits.
' this takes care of that.
Local clr As Word
clr = Color
Shift Left clr, 8
Function = clr
End Function
Sub PaintTabBg(ByVal hCtl As Long,ByVal hdc As Long,ByVal r As Long, ByVal g As Long, ByVal b As Long)
' this paints the actual tab body
Local rc As Rect
Local Xin As Long
Local Yin As Long
Local r2 As Long, g2 As Long, b2 As Long, offset As Long
Dim vert(1) As TRIVERTEX
Dim gRect As GRADIENT_RECT
GetClientRect hCtl, rc
Xin = rc.nRight - rc.nLeft
Yin = rc.nBottom - rc.nTop
vert(0).x = 0
vert(0).y = 0
vert(0).Red = SetColor(r)
vert(0).Green = SetColor(g)
vert(0).Blue = SetColor(b)
vert(0).Alpha = &h0000
vert(1).x = Xin
vert(1).y = Yin
offset=128
r2=r-offset
If r2<0 Then r2=0
g2=g-offset
If g2<0 Then g2=0
b2=b-offset
If b2<0 Then b2=0
vert(1).Red = SetColor(r2)
vert(1).Green = SetColor(g2)
vert(1).Blue = SetColor(b2)
vert(1).Alpha = &h0000
gRect.UpperLeft = 0
gRect.LowerRight = 1
GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
End Sub
Function tabsubclassproc(ByVal hwnd&,ByVal msg&,ByVal wparam&,ByVal lparam&) As Long
Dim rc As rect
Select Case msg&
Case %wm_erasebkgnd
PaintTabBg hwnd&,wparam&,128,128,255
Function=1
Exit Function
End Select
Function=callwindowproc(prevtabproc&,hwnd&,msg&,wparam&,lparam&)
End Function
Function inserttab(ByVal hctl&,ByVal i&,ByVal txt$) As Long
Dim tbctl As tc_item
Dim ztext As Asciiz*255
ztext=txt$
tbctl.mask=%TCIF_TEXT
tbctl.psztext=VarPtr(ztext)
tbctl.cchtextmax=Len(txt$)
tbctl.iimage=%Null
Function=sendmessage(hctl&,%tcm_insertitem,i&,VarPtr(tbctl))
End Function
Coded by Jim Seekamp (fixed by Chriss Boss). From PB's forum here: https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/37127-tab-control-and-gradient-shading-problem (https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/37127-tab-control-and-gradient-shading-problem)
It is very doable in FF. As a bonus, the PB code also shows how you can gradient fill the entire tab as use any color you wish.
Hi David
I assumed it was not going to be a simple background change selection.....
I just dragged the Tabcontrol, using Firefly onto the form.
I can easily change the different pages of the tab's by changing the background colour of each child form.
The Tabcontrol by itself had this "bar" that runs along the top of the Tabcontrol that uses a system colour for which there is no settings to change.
I assume it uses the system colours for a form and not the background colour of the form its placed upon.
I will play around with what you have me, thank you for the help.
-Peter