Print

Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

[Petrus Vorster]

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

[David Kenny]

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.

[David Kenny]

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:

Code: [Select]

#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

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.

[Petrus Vorster]

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