Tab Control and gradient shading problem

[Chris Boss]

I combined Bob's code and Jim's code, so the tab control uses a gradient:

#COMPILE EXE
#INCLUDE "\pbwin90\winapi\win32api.inc"
#INCLUDE "\pbwin90\winapi\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:12) 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&=(@[email protected])
           pg&[email protected]
           IF @disptr.itemstate=%ods_selected THEN
             @[email protected]+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

I attached a screenshot of the gradient tab control below:

[Jim Seekamp]

Man, what a lame-brained error...
I never even thought of that.
Thanks for the help, Chris.

[Chris Boss]

The problems with your code was your calculations of the height of the tab control. Simply put, they were wrong. You used the rc variable (RECT) twice in two different API calls, so the value was changed later and so it was incorrect when you used it. Your tab control was coming out 23 pixels high.

I rewrote the calculation code to get the correct height for the tab control.

This code now works:

#COMPILE EXE
#INCLUDE "\pbwin90\winapi\win32api.inc"
#INCLUDE "\pbwin90\winapi\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:12) 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
           ' -------------------
           [EMAIL="tabheight&[email protected]@disptr.rcitem.ntop"]tabheight&[email protected]@disptr.rcitem.ntop[/EMAIL]
           [EMAIL="pg&[email protected]"]pg&[email protected][/EMAIL]
           IF @disptr.itemstate=%ods_selected THEN
             @[email protected]+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 tabsubclassproc(BYVAL hwnd&,BYVAL msg&,BYVAL wparam&,BYVAL lparam&) AS LONG
     DIM rc AS rect
     SELECT CASE msg&
       CASE %wm_erasebkgnd
         hdc&=wparam&
         getclientrect hwnd&,rc
         bcolor&=RGB(128,128,255)
         hbrush&=createsolidbrush(bcolor&)
         fillrect hdc&,rc,hbrush&
         deleteobject hbrush&
         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

[Jim Seekamp]

Here's a test program with the exact same problem...

#compile exe

#include "\pbwin90\winapi\win32api.inc"
#include "\pbwin90\winapi\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)
     ysize&=((wndrect.nbottom-wndrect.ntop)+1)
     xstt&=0
     ystt&=0

''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:12) 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

         '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         x1&=0
         y1&=toolheight&
         x2&=rc.nright-rc.nleft
         y2&=rc.nbottom-rc.ntop

         style&=%ws_child or %ws_visible or %tcs_tabs or %tcs_ownerdrawfixed _
                or %ws_clipsiblings

         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&
           tabheight&[email protected]@disptr.rcitem.ntop
           pg&[email protected]

           if @disptr.itemstate=%ods_selected then
             @[email protected]+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&

           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 tabsubclassproc(byval hwnd&,byval msg&,byval wparam&,byval lparam&) as long

     dim rc as rect

     select case msg&
       case %wm_erasebkgnd
         hdc&=wparam&

         getclientrect hwnd&,rc
         bcolor&=rgb(64,128,255)

         hbrush&=createsolidbrush(bcolor&)
         fillrect hdc&,rc,hbrush&
         deleteobject hbrush&

         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

[Jim Seekamp]

Hmmm.... even with subclassing, I can't get the tab's background to fill in: it comes in invisible (see-through!)

I subclassed the control:

         style&=%ws_child or %ws_visible or %tcs_tabs or %tcs_ownerdrawfixed _
                or %ws_clipsiblings

        htab&=actualsizecontrol("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))

I added the subclass function:

function tabsubclassproc(byval hwnd&,byval msg&,byval wparam&,byval lparam&) as long

     dim rc as rect

     select case msg&
       case %wm_erasebkgnd
         hdc&=wparam&
         getclientrect hwnd&,rc
         bcolor&=rgb(64,128,255)
         hbrush&=createsolidbrush(bcolor&)
         fillrect hdc&,rc,hbrush&
         deleteobject hbrush&

         function=1
         exit function
     end select
     function=callwindowproc(prevtabproc&,hwnd&,msg&,wparam&,lparam&)
end function

and got rid of the %wm_erasebkgnd in the main wndproc...
I left the %wm_drawitem (which still works) as is...

and prevtabproc is a global variable
Any ideas what's wrong??

[BOB MECHLER]

Using 'Beyond Compare' I understand this much better. It also became clear that if I had read the documentation on WM_ERASEBKGND I would have known that I already had the hDc. The repetition of the code after the WM message was unnecessary. I could have simply called the PaintTabBg Sub

    CASE %WM_ERASEBKGND
      CALL PaintTabBg(%IDC_SYSTABCONTROL32_1,wParam,192,224,192)
'        hDC=wParam  ' DC passed to this message from Beginpaint in wParam
'        r = 192
'        SHIFT LEFT r, 8
'        g = 224
'        SHIFT LEFT g, 8
'        b = 192
'        SHIFT LEFT b, 8
'        w = 255
'        SHIFT LEFT w, 8
'        GetClientRect hWnd, rc
'        Xin = rc.nRight - rc.nLeft-2            ' don't want to go all the way to the right, or we'll paint over the border
'        Yin = rc.nBottom - rc.nTop-2            ' don't want to go all the way to the bottom, or we'll paint over the border
'        vert(0).x      = 2                      ' start at pixel 2 so we don't paint over the border
'        vert(0).y      = 22                     ' start at pixel 22 so that we don't paint over the tabs
'        vert(0).Red    = w
'        vert(0).Green  = w
'        vert(0).Blue   = w
'        vert(0).Alpha  = &h0000
'        vert(1).x      = Xin
'        vert(1).y      = Yin
'        vert(1).Red    = r
'        vert(1).Green  = g
'        vert(1).Blue   = b
'        vert(1).Alpha  = &h0000
'        gRect.UpperLeft  = 0
'        gRect.LowerRight = 1
'        GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
        FUNCTION=%TRUE
        EXIT FUNCTION         ' must not let original window procedure get this message

The win32.hlp file I have is somewhat cryptic, in that it assumes a level and depth of knowledge I don't have yet. What is/are your favorite book(s) on the subject if I may ask.

Learned a lot.

Thanks,

Bob Mechler

[Chris Boss]

Good try, but some serious errors.

When you process messages in a subclass routine always read the API docs about that message to fully understand how that message works.

The WM_ERASEBKGND messages passes the DC in wParam. You weren't using it (your code never set the value of hDC so it ended up drawing on the desktop I think). Also use the hWnd parameter passed to the subclass function.

Next, when you process a message, instead of letting Windows handle it, in a subclass routine, don't forget to not only set the return value but also use:

EXIT FUNCTION

so the message is not passed on to the original window procedure call. If you don't then the message gets processed twice, once in your subclass routine and then again by the original window procedure (not good!).

There is no need to track the WM_MOVE message of the dialog, since Windows will generate the WM_ERASEBKGND message when needed. WM_ERASEBKGND is generated by the BeginPaint function used in WM_PAINT, so whenever WM_PAINT is generated, so will WM_ERASEBKGND.

Here is your code reworked. I removed the WM_MOVE processing and fixed your subclass routine.

#PBFORMS CREATED V1.50
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly.  See the PB/Forms documentation for
' more information.
' Named blocks begin like this:    #PBFORMS BEGIN ...
' Named blocks end like this:      #PBFORMS END ...
' Other PB/Forms metastatements such as:
'     #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
%USEMACROS = 1
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
    #INCLUDE "COMMCTRL.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1           =  101
%IDC_SYSTABCONTROL32_1 = 1001
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION SampleTabCtrl(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
    lCount AS LONG) AS LONG
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
GLOBAL hdlg AS LONG,NEED_REDRAW AS INTEGER
FUNCTION PBMAIN()
    PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
        %ICC_INTERNET_CLASSES)
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'====================================================================
FUNCTION Tab1SubClassProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                      BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'--------------------------------------------------------------------
  ' SubClass procedure
  '------------------------------------------------------------------
  LOCAL lRes AS DWORD, oldProc AS DWORD
  LOCAL lDisPtr AS DRAWITEMSTRUCT PTR
  LOCAL r AS LONG, g AS LONG, b AS LONG, w AS LONG, hDc AS LONG
  LOCAL hCtl&
  LOCAL rc AS Rect
  LOCAL Xin AS LONG
  LOCAL Yin AS LONG
  DIM vert(1) AS TRIVERTEX
  DIM gRect AS GRADIENT_RECT
  '------------------------------------------------------------------
  ' Messages shall normally be passed on to the original procedure
  ' with CallWindowProc for processing, which is why we stored the
  ' return value from SetWindowLong in the dialog's USER memory.
  ' However, it is perfectly ok to break some messages by not
  ' passing them on to the original procedure - see below.
  ' We'll use the GetParent API call to get parent dialog's handle.
  '------------------------------------------------------------------
  DIALOG GET USER GetParent(hWnd), 1 TO oldProc
  IF oldProc = 0 THEN EXIT FUNCTION
  '------------------------------------------------------------------
  SELECT CASE AS LONG wMsg
  '------------------------------------------------------------------
    CASE %WM_ERASEBKGND
        hDC=wParam  ' DC passed to this message from Beginpaint in wParam
        r = 192
        SHIFT LEFT r, 8
        g = 224
        SHIFT LEFT g, 8
        b = 192
        SHIFT LEFT b, 8
        w = 255
        SHIFT LEFT w, 8
        GetClientRect hWnd, rc
        Xin = rc.nRight - rc.nLeft-2            ' don't want to go all the way to the right, or we'll paint over the border
        Yin = rc.nBottom - rc.nTop-2            ' don't want to go all the way to the bottom, or we'll paint over the border
        vert(0).x      = 2                      ' start at pixel 2 so we don't paint over the border
        vert(0).y      = 22                     ' start at pixel 22 so that we don't paint over the tabs
        vert(0).Red    = w
        vert(0).Green  = w
        vert(0).Blue   = w
        vert(0).Alpha  = &h0000
        vert(1).x      = Xin
        vert(1).y      = Yin
        vert(1).Red    = r
        vert(1).Green  = g
        vert(1).Blue   = b
        vert(1).Alpha  = &h0000
        gRect.UpperLeft  = 0
        gRect.LowerRight = 1
        GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
        FUNCTION=%TRUE
        EXIT FUNCTION         ' must not let original window procedure get this message
  '------------------------------------------------------------------
  ' Pass on messages to original control procedure
  END SELECT
  FUNCTION = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)
END FUNCTION
'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
  LOCAL lDisPtr AS DRAWITEMSTRUCT PTR
  LOCAL ps AS PAINTSTRUCT
  LOCAL  pNMHDR AS NMHDR PTR
  LOCAL result AS LONG,hTab AS LONG,Rc AS RECT,hpen AS LONG,CurrentItemId AS LONG
  LOCAL hDC AS DWORD,I AS INTEGER
  LOCAL hEdit AS DWORD, oldProc AS DWORD, sText AS STRING
    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
          CONTROL HANDLE CBHNDL, %IDC_SYSTABCONTROL32_1 TO hEdit
          oldProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(Tab1SubClassProc))
          DIALOG SET USER CBHNDL, 1, oldProc
        CASE %WM_DESTROY
          DIALOG GET USER CBHNDL, 1 TO oldProc
          IF oldProc THEN  ' remove subclassing before exit
              CONTROL HANDLE CBHNDL, %IDC_SYSTABCONTROL32_1 TO hEdit
              SetWindowLong hEdit, %GWL_WNDPROC, oldProc
          END IF
        CASE %WM_PAINT
          CALL PaintBg(CBHNDL,192,224,192)
        CASE %WM_DRAWITEM
          IF CBCTL = %IDC_SYSTABCONTROL32_1 THEN
            lDisPtr = CBLPARAM
            IF @lDisPtr.CtlType <> %ODT_TAB THEN EXIT FUNCTION  ' make sure it's a tab
            IF @lDisPtr.itemAction = %ODA_DRAWENTIRE THEN CALL PaintTabBg(CBCTL,@lDisPtr.hdc,192,224,192)
            SELECT CASE @lDisPtr.ItemId
              CASE 0
                CALL TabLabel(@lDisPtr.ItemId,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Account Info 1")
              CASE 1
                CALL TabLabel(1,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Account Info 2")
              CASE 2
                CALL TabLabel(2,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Related Parties      ")
              CASE 3
                CALL TabLabel(3,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Recurring Payments   ")
              CASE 4
                CALL TabLabel(4,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Ticklers             ")
            END SELECT
            FUNCTION = %True
          END IF
        CASE %WM_NOTIFY
          ' Handle Notify messages for tooptips and tab page changes
          pNMHDR = CBLPARAM
          ' Is it a page change message?
          IF @pNMHDR.hWndFrom = GetDlgItem(CBHNDL, %IDC_SYSTABCONTROL32_1) THEN
              ' Get the current tab page number (zero based)
              CONTROL SEND CBHNDL, %IDC_SYSTABCONTROL32_1, %TCM_GETCURSEL, 0, 0 TO Result
              SELECT CASE @pNMHDR.Code
                 CASE %TCN_SELCHANGING ' The page is about to change
                   ' Code to hide any fields on the tab that is about to be moved away from
                      FUNCTION = 0
                  CASE %TCN_SELCHANGE   ' The page is changing
                      ' Code to show any fields on the tab that is about to be moved to
                      FUNCTION = 0
              END SELECT
          END IF
        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF
        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_SYSTABCONTROL32_1
            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Sample Code **
'------------------------------------------------------------------------------
FUNCTION SampleTabCtrl(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL lCount _
    AS LONG) AS LONG
    LOCAL i        AS LONG
    LOCAL hCtl     AS DWORD
    LOCAL szBuf    AS ASCIIZ * 32
    LOCAL tTC_Item AS TC_ITEM
    CONTROL HANDLE hDlg, lID TO hCtl
    tTC_Item.Mask    = %TCIF_TEXT
    tTC_Item.iImage  = -1
    tTC_Item.pszText = VARPTR(szBuf)
    szBuf = "Account Info Screen 1"
    TabCtrl_InsertItem(hCtl, 0, tTC_Item)
    szBuf = "Account Info Screen 2 "
    TabCtrl_InsertItem(hCtl, 1, tTC_Item)
    szBuf = "Related Parties       "
    TabCtrl_InsertItem(hCtl, 2, tTC_Item)
    szBuf = "Recurring Payments    "
    TabCtrl_InsertItem(hCtl, 3, tTC_Item)
    szBuf = "Ticklers              "
    TabCtrl_InsertItem(hCtl, 4, tTC_Item)
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    DIALOG NEW  hParent, "Tab Test", 73, 82, 521, 354, %WS_POPUP OR _
        %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
        %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
        OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE _
        OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD "SysTabControl32", hDlg, %IDC_SYSTABCONTROL32_1, _
        "SysTabControl32_1", 50, 20, 373, 300, %WS_CHILD OR %WS_VISIBLE OR _
        %WS_TABSTOP OR %TCS_SINGLELINE OR %TCS_RIGHTJUSTIFY OR %TCS_OWNERDRAWFIXED, %WS_EX_LEFT OR _
        %WS_EX_LTRREADING
#PBFORMS END DIALOG
    SampleTabCtrl  hDlg, %IDC_SYSTABCONTROL32_1, 5
    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
    FUNCTION = lRslt
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 PaintBg(BYVAL hDialog AS LONG, BYVAL r AS LONG, BYVAL g AS LONG, BYVAL b AS LONG)
     ' this is to paint the background of the dialog
     ' it's all straight out of the MSDN help file.  We can change the values
     ' if we like.
     LOCAL ps AS PAINTSTRUCT
     LOCAL rc AS Rect
     LOCAL hDc AS DWORD
     LOCAL Xin&
     LOCAL Yin&
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
     hDC = BeginPaint(hDialog, ps)
       ' Tile the background
     GetClientRect hdialog, rc
     Xin = rc.nRight - rc.nLeft
     Yin = rc.nBottom - rc.nTop
     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
     vert(1).Red    = SetColor(&hff)
     vert(1).Green  = SetColor(&hff)
     vert(1).Blue   = SetColor(&hff)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
     EndPaint hDialog, ps
END SUB
SUB PaintTabBg(BYVAL cid 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 hCtl&
     LOCAL rc AS Rect
     LOCAL Xin AS LONG
     LOCAL Yin AS LONG
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
     CONTROL HANDLE hdlg&, cid& TO hCtl&     ' get the handle to the control
     GetClientRect hCtl, rc
     Xin = rc.nRight - rc.nLeft-2            ' don't want to go all the way to the right, or we'll paint over the border
     Yin = rc.nBottom - rc.nTop-2            ' don't want to go all the way to the bottom, or we'll paint over the border
     vert(0).x      = 2                      ' start at pixel 2 so we don't paint over the border
     vert(0).y      = 22                     ' start at pixel 22 so that we don't paint over the tabs
     vert(0).Red    = SetColor(255)
     vert(0).Green  = SetColor(255)
     vert(0).Blue   = SetColor(255)
     vert(0).Alpha  = &h0000
     vert(1).x      = Xin
     vert(1).y      = Yin
     vert(1).Red    = SetColor(r)
     vert(1).Green  = SetColor(g)
     vert(1).Blue   = SetColor(b)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
END SUB
SUB TabLabel(BYVAL ItemId AS LONG, BYVAL cid AS LONG,BYVAL hdc AS LONG,BYVAL Selected AS LONG, BYVAL Txt$)
    LOCAL htab&
     LOCAL rc AS Rect
     LOCAL clr&
     LOCAL lZStr  AS ASCIIZ * 64
     LOCAL hFont&
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
    CONTROL HANDLE hdlg&, cid& TO hTab&                ' get the control's handle
    CALL TabCtrl_GetItemRect(hTab&, ItemId, rc)         ' get the rectangle to each item (tab label)
    clr& = 224                                          ' set default color
    IF selected& = %ODS_SELECTED THEN clr& = &hdf       ' if it's selected then change it
     vert(0).x      = rc.nLeft
     vert(0).y      = rc.nTop
     vert(0).Red    = SetColor(&hff)
     vert(0).Green  = SetColor(&hff)
     vert(0).Blue   = SetColor(&hff)
     vert(0).Alpha  = &h0000
     vert(1).x      = rc.nRight
     vert(1).y      = rc.nBottom
     vert(1).Red    = SetColor(clr&)
     vert(1).Green  = SetColor(clr&)
     vert(1).Blue   = SetColor(clr&)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
    IF Selected = %ODS_SELECTED THEN
        '*Use a bold font if selected
        hFont = CreateFont(-8,0,0,0,%FW_BOLD,0,0,0,0,0,0,0,0,"MS Sans Serif")
    ELSE
        '*Or a normal one if not selected
        hFont = CreateFont(-8,0,0,0,%FW_NORMAL,0,0,0,0,0,0,0,0,"MS Sans Serif")
    END IF
    hFont = SelectObject(hDC,hFont)         ' get the font
    lZstr = txt$                            ' copy the text to the nul terminated string
     SetBkMode hDc, %Transparent             ' set the bg for transparent
     SetTextColor hDc, GetSysColor(%COLOR_BTNTEXT)   ' set the foreground color to black
     TextOut hDc, rc.nLeft + 5, Rc.nTop + 3, lZStr, LEN (lZStr)  'draw the text
     CALL DeleteObject(SelectObject(hdc,hFont))      ' free the font handle
END SUB
'------------------------------------------------------------------------------

[BOB MECHLER]

I rewrote in using PBForms and tried to follow Chris's suggestion. What I came up with works but feel it might be improved. By subclassing the Tab Control and processing the WM_ERASEBKGND, I got it to redraw continuosly. Then I put in a global toggle variable based on %WM_MOVE in the main dialog callback. Don't know if it is the right way but it works so far.

#PBFORMS CREATED V1.50
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other   
' PB/Forms metastatements are placed at the beginning and 
' end of "Named Blocks" of code that should be edited     
' with PBForms only. Do not manually edit or delete these 
' metastatements or PB/Forms will not be able to reread   
' the file correctly.  See the PB/Forms documentation for 
' more information.                                       
' Named blocks begin like this:    #PBFORMS BEGIN ...     
' Named blocks end like this:      #PBFORMS END ...       
' Other PB/Forms metastatements such as:                  
'     #PBFORMS DECLARATIONS                               
' are used by PB/Forms to insert additional code.         
' Feel free to make changes anywhere else in the file.    
'------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES 
%USEMACROS = 1
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
    #INCLUDE "COMMCTRL.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS 
%IDD_DIALOG1           =  101
%IDC_SYSTABCONTROL32_1 = 1001
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION SampleTabCtrl(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
    lCount AS LONG) AS LONG
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
GLOBAL hdlg AS LONG,NEED_REDRAW AS INTEGER
FUNCTION PBMAIN()
    PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
        %ICC_INTERNET_CLASSES)

    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

'====================================================================
FUNCTION Tab1SubClassProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                      BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
'--------------------------------------------------------------------
  ' SubClass procedure
  '------------------------------------------------------------------
  LOCAL lRes AS DWORD, oldProc AS DWORD
  LOCAL lDisPtr AS DRAWITEMSTRUCT PTR
  LOCAL r AS LONG, g AS LONG, b AS LONG, w AS LONG, hDc AS LONG
  LOCAL hCtl&
  LOCAL rc AS Rect
  LOCAL Xin AS LONG
  LOCAL Yin AS LONG
  DIM vert(1) AS TRIVERTEX
  DIM gRect AS GRADIENT_RECT
  '------------------------------------------------------------------
  ' Messages shall normally be passed on to the original procedure
  ' with CallWindowProc for processing, which is why we stored the
  ' return value from SetWindowLong in the dialog's USER memory.
  ' However, it is perfectly ok to break some messages by not
  ' passing them on to the original procedure - see below.
  ' We'll use the GetParent API call to get parent dialog's handle.
  '------------------------------------------------------------------
  DIALOG GET USER GetParent(hWnd), 1 TO oldProc
  IF oldProc = 0 THEN EXIT FUNCTION
  '------------------------------------------------------------------
  SELECT CASE AS LONG wMsg
  '------------------------------------------------------------------
    CASE %WM_ERASEBKGND
      'this paints the actual TAB body
      IF NEED_REDRAW THEN
        CONTROL HANDLE hdlg&, %IDC_SYSTABCONTROL32_1 TO hCtl&     ' get the handle to the control
        RedrawWindow hCtl&, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
        r = 192
        SHIFT LEFT r, 8
        g = 224
        SHIFT LEFT g, 8
        b = 192
        SHIFT LEFT b, 8
        w = 255
        SHIFT LEFT w, 8
        GetClientRect hCtl, rc
        Xin = rc.nRight - rc.nLeft-2            ' don't want to go all the way to the right, or we'll paint over the border
        Yin = rc.nBottom - rc.nTop-2            ' don't want to go all the way to the bottom, or we'll paint over the border
        vert(0).x      = 2                      ' start at pixel 2 so we don't paint over the border
        vert(0).y      = 22                     ' start at pixel 22 so that we don't paint over the tabs
        vert(0).Red    = w
        vert(0).Green  = w
        vert(0).Blue   = w
        vert(0).Alpha  = &h0000
        vert(1).x      = Xin
        vert(1).y      = Yin
        vert(1).Red    = r
        vert(1).Green  = g
        vert(1).Blue   = b
        vert(1).Alpha  = &h0000
        gRect.UpperLeft  = 0
        gRect.LowerRight = 1
        GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v 
        FUNCTION=%TRUE
        NEED_REDRAW = 0
      END IF
  '------------------------------------------------------------------
  ' Pass on messages to original control procedure
  END SELECT
  FUNCTION = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)

END FUNCTION
'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
  LOCAL lDisPtr AS DRAWITEMSTRUCT PTR
  LOCAL ps AS PAINTSTRUCT
  LOCAL  pNMHDR AS NMHDR PTR
  LOCAL result AS LONG,hTab AS LONG,Rc AS RECT,hpen AS LONG,CurrentItemId AS LONG
  LOCAL hDC AS DWORD,I AS INTEGER
  LOCAL hEdit AS DWORD, oldProc AS DWORD, sText AS STRING

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
          CONTROL HANDLE CBHNDL, %IDC_SYSTABCONTROL32_1 TO hEdit
          oldProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(Tab1SubClassProc))
          DIALOG SET USER CBHNDL, 1, oldProc
        CASE %WM_DESTROY
          DIALOG GET USER CBHNDL, 1 TO oldProc
          IF oldProc THEN  ' remove subclassing before exit
              CONTROL HANDLE CBHNDL, %IDC_SYSTABCONTROL32_1 TO hEdit
              SetWindowLong hEdit, %GWL_WNDPROC, oldProc
          END IF
        CASE %WM_PAINT
          CALL PaintBg(CBHNDL,192,224,192)         
        CASE %WM_DRAWITEM
          IF CBCTL = %IDC_SYSTABCONTROL32_1 THEN
            lDisPtr = CBLPARAM
            IF @lDisPtr.CtlType <> %ODT_TAB THEN EXIT FUNCTION  ' make sure it's a tab
            IF @lDisPtr.itemAction = %ODA_DRAWENTIRE THEN CALL PaintTabBg(CBCTL,@lDisPtr.hdc,192,224,192)
            SELECT CASE @lDisPtr.ItemId
              CASE 0 
                CALL TabLabel(@lDisPtr.ItemId,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Account Info 1")
              CASE 1 
                CALL TabLabel(1,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Account Info 2")
              CASE 2 
                CALL TabLabel(2,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Related Parties      ")
              CASE 3 
                CALL TabLabel(3,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Recurring Payments   ")
              CASE 4 
                CALL TabLabel(4,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,"Ticklers             ")
            END SELECT    
            FUNCTION = %True
          END IF
        CASE %WM_NOTIFY
          ' Handle Notify messages for tooptips and tab page changes
          pNMHDR = CBLPARAM
          ' Is it a page change message?
          IF @pNMHDR.hWndFrom = GetDlgItem(CBHNDL, %IDC_SYSTABCONTROL32_1) THEN
    
              ' Get the current tab page number (zero based)
              CONTROL SEND CBHNDL, %IDC_SYSTABCONTROL32_1, %TCM_GETCURSEL, 0, 0 TO Result
              SELECT CASE @pNMHDR.Code
                 CASE %TCN_SELCHANGING ' The page is about to change
                   ' Code to hide any fields on the tab that is about to be moved away from
                      FUNCTION = 0
                  CASE %TCN_SELCHANGE   ' The page is changing
                      ' Code to show any fields on the tab that is about to be moved to
                      FUNCTION = 0
              END SELECT
          END IF 
        CASE %WM_MOVE
          NEED_REDRAW = -1  
        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_SYSTABCONTROL32_1

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Sample Code **
'------------------------------------------------------------------------------
FUNCTION SampleTabCtrl(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL lCount _
    AS LONG) AS LONG
    LOCAL i        AS LONG
    LOCAL hCtl     AS DWORD
    LOCAL szBuf    AS ASCIIZ * 32
    LOCAL tTC_Item AS TC_ITEM

    CONTROL HANDLE hDlg, lID TO hCtl

    tTC_Item.Mask    = %TCIF_TEXT
    tTC_Item.iImage  = -1
    tTC_Item.pszText = VARPTR(szBuf)
    szBuf = "Account Info Screen 1"
    TabCtrl_InsertItem(hCtl, 0, tTC_Item)
    szBuf = "Account Info Screen 2 "
    TabCtrl_InsertItem(hCtl, 1, tTC_Item)
    szBuf = "Related Parties       "
    TabCtrl_InsertItem(hCtl, 2, tTC_Item)
    szBuf = "Recurring Payments    "
    TabCtrl_InsertItem(hCtl, 3, tTC_Item)
    szBuf = "Ticklers              "
    TabCtrl_InsertItem(hCtl, 4, tTC_Item)
    
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->

    DIALOG NEW  hParent, "Tab Test", 73, 82, 521, 354, %WS_POPUP OR _
        %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
        %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
        OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE _
        OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR, TO hDlg
    CONTROL ADD "SysTabControl32", hDlg, %IDC_SYSTABCONTROL32_1, _
        "SysTabControl32_1", 50, 20, 373, 300, %WS_CHILD OR %WS_VISIBLE OR _
        %WS_TABSTOP OR %TCS_SINGLELINE OR %TCS_RIGHTJUSTIFY OR %TCS_OWNERDRAWFIXED, %WS_EX_LEFT OR _
        %WS_EX_LTRREADING
#PBFORMS END DIALOG

    SampleTabCtrl  hDlg, %IDC_SYSTABCONTROL32_1, 5

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
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 PaintBg(BYVAL hDialog AS LONG, BYVAL r AS LONG, BYVAL g AS LONG, BYVAL b AS LONG)

     ' this is to paint the background of the dialog
     ' it's all straight out of the MSDN help file.  We can change the values
     ' if we like.
     LOCAL ps AS PAINTSTRUCT
     LOCAL rc AS Rect
     LOCAL hDc AS DWORD
     LOCAL Xin&
     LOCAL Yin&
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
     hDC = BeginPaint(hDialog, ps)
       ' Tile the background
     GetClientRect hdialog, rc
     Xin = rc.nRight - rc.nLeft
     Yin = rc.nBottom - rc.nTop

     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
     vert(1).Red    = SetColor(&hff)
     vert(1).Green  = SetColor(&hff)
     vert(1).Blue   = SetColor(&hff)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
     EndPaint hDialog, ps 
     
END SUB
SUB PaintTabBg(BYVAL cid 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 hCtl&
     LOCAL rc AS Rect
     LOCAL Xin AS LONG
     LOCAL Yin AS LONG
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
     CONTROL HANDLE hdlg&, cid& TO hCtl&     ' get the handle to the control
     GetClientRect hCtl, rc
     Xin = rc.nRight - rc.nLeft-2            ' don't want to go all the way to the right, or we'll paint over the border
     Yin = rc.nBottom - rc.nTop-2            ' don't want to go all the way to the bottom, or we'll paint over the border
     vert(0).x      = 2                      ' start at pixel 2 so we don't paint over the border
     vert(0).y      = 22                     ' start at pixel 22 so that we don't paint over the tabs
     vert(0).Red    = SetColor(255)
     vert(0).Green  = SetColor(255)
     vert(0).Blue   = SetColor(255)
     vert(0).Alpha  = &h0000
     vert(1).x      = Xin
     vert(1).y      = Yin
     vert(1).Red    = SetColor(r)
     vert(1).Green  = SetColor(g)
     vert(1).Blue   = SetColor(b)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v 
     
END SUB

SUB TabLabel(BYVAL ItemId AS LONG, BYVAL cid AS LONG,BYVAL hdc AS LONG,BYVAL Selected AS LONG, BYVAL Txt$)

    LOCAL htab&
     LOCAL rc AS Rect
     LOCAL clr&
     LOCAL lZStr  AS ASCIIZ * 64
     LOCAL hFont&
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT

    CONTROL HANDLE hdlg&, cid& TO hTab&                ' get the control's handle
    CALL TabCtrl_GetItemRect(hTab&, ItemId, rc)         ' get the rectangle to each item (tab label) 
    clr& = 224                                          ' set default color
    IF selected& = %ODS_SELECTED THEN clr& = &hdf       ' if it's selected then change it
     vert(0).x      = rc.nLeft
     vert(0).y      = rc.nTop
     vert(0).Red    = SetColor(&hff)
     vert(0).Green  = SetColor(&hff)
     vert(0).Blue   = SetColor(&hff)
     vert(0).Alpha  = &h0000
     vert(1).x      = rc.nRight
     vert(1).y      = rc.nBottom
     vert(1).Red    = SetColor(clr&)
     vert(1).Green  = SetColor(clr&)
     vert(1).Blue   = SetColor(clr&)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v

    IF Selected = %ODS_SELECTED THEN
        '*Use a bold font if selected
        hFont = CreateFont(-8,0,0,0,%FW_BOLD,0,0,0,0,0,0,0,0,"MS Sans Serif")
    ELSE
        '*Or a normal one if not selected
        hFont = CreateFont(-8,0,0,0,%FW_NORMAL,0,0,0,0,0,0,0,0,"MS Sans Serif")
    END IF
    hFont = SelectObject(hDC,hFont)         ' get the font
    lZstr = txt$                            ' copy the text to the nul terminated string
     SetBkMode hDc, %Transparent             ' set the bg for transparent
     SetTextColor hDc, GetSysColor(%COLOR_BTNTEXT)   ' set the foreground color to black

     TextOut hDc, rc.nLeft + 5, Rc.nTop + 3, lZStr, LEN (lZStr)  'draw the text
     CALL DeleteObject(SelectObject(hdc,hFont))      ' free the font handle
END SUB

'------------------------------------------------------------------------------

[Michael Mattias]

Then they draw a thin gray line on the right and bottom and a white thin line on the left and top. Really can't distinquish it from the tab body.

Add WS_BORDER style?

If not, try WS_EX_STATICEDGE and/or WS_EX_CLIENTEDGE extended style. That should give you your border lines... (Hmm......Border line, Border line, I just keep on movin' my love, Over the border line...... betcha didn't know I am a big Madonna fan, did you?)

MCM

[BOB MECHLER]

I've seen some examples where they just do the tabs and replace the body with a number of additional dialogs. Then they draw a thin gray line on the right and bottom and a white thin line on the left and top. Really can't distinquish it from the tab body.

Didn't understand why at first but that seems to be a way to avoid the subclassing of the tab body.

Bob Mechler

[BOB MECHLER]

I understand what you're saying. I've only subclassed some textboxes but I'm sure I can find some code around the forum for tab controls.

Thanks for the additional information too.

Bob Mechler

[Chris Boss]

The answer is simple.

TAB controls only allow painting the TABs using ownerdraw and not the rest of the control (background).

You are cheating in your code, by attempting to paint the background during the WM_DRAWITEM message. It works, but the problem is the message is only generated when the TAB's need to be updated. If you move the dialog left or right off the screen and then back again, the tabs need repainting so it appears to work fine. But when you move the dialog off the screen moving downward and then back again, the tabs don't need to be repainted, so the control never generates the WM_DRAWITEM message, so your background painting code never gets called. Windows though does generate the WM_ERASEBKGND message for the Tab control (sent to the Tab controls window procedure) to repaint the background and it gets painted using the default color. Only part of the background needs to be repainted and so only part of it is invalidated, which means Windows repaints only the part that went off screen.

So how do you paint the ownerdraw tab controls background ?

Not in WM_DRAWITEM

You have to subclass the control and then process the WM_ERASEBKGND message and draw it there. The tabs though are painted in WM_DRAWITEM.

[BOB MECHLER]

The following compilable program is one test for different ways of ownerdrawing a tab control with gradient's etc. The cool code came from one of Chris Boss's example. The rest is some playing around I'm doing with macros.
Anyway, it's biggest problem is that if you move it off screen partially and come back the painted area becomes messed up. I need to know how to keep it painted or when to repaint the bod of the tab itself.

BOB MECHLER

#COMPILE EXE 
#INCLUDE "WIN32API.INC"
#INCLUDE "INITCTRL.INC"
%TAB1           = 1001
GLOBAL FLD AS LONG 'field number on screen
GLOBAL LST() AS STRING,lbcursel() AS LONG,cbcursel() AS LONG,VBUT AS INTEGER
GLOBAL TABHIT AS INTEGER
GLOBAL hfont1 AS LONG,hfont2 AS LONG
GLOBAL TabText()    AS ASCIIZ * 32
GLOBAL hdlg AS LONG
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 PaintBg(BYVAL hDialog AS LONG, BYVAL r AS LONG, BYVAL g AS LONG, BYVAL b AS LONG)

     ' this is to paint the background of the dialog
     ' it's all straight out of the MSDN help file.  We can change the values
     ' if we like.
     LOCAL ps AS PAINTSTRUCT
     LOCAL rc AS Rect
     LOCAL hDc AS DWORD
     LOCAL Xin&
     LOCAL Yin&
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
     hDC = BeginPaint(hDialog, ps)
       ' Tile the background
     GetClientRect hdialog, rc
     Xin = rc.nRight - rc.nLeft
     Yin = rc.nBottom - rc.nTop

     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
     vert(1).Red    = SetColor(&hff)
     vert(1).Green  = SetColor(&hff)
     vert(1).Blue   = SetColor(&hff)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
     EndPaint hDialog, ps 
     
END SUB

SUB PaintTabBg(BYVAL cid 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 hCtl&
     LOCAL rc AS Rect
     LOCAL Xin AS LONG
     LOCAL Yin AS LONG
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT
     CONTROL HANDLE hDlg, cid& TO hCtl&     ' get the handle to the control
     GetClientRect hCtl, rc
     Xin = rc.nRight - rc.nLeft-2            ' don't want to go all the way to the right, or we'll paint over the border
     Yin = rc.nBottom - rc.nTop-2            ' don't want to go all the way to the bottom, or we'll paint over the border
     vert(0).x      = 2                      ' start at pixel 2 so we don't paint over the border
     vert(0).y      = 22                     ' start at pixel 22 so that we don't paint over the tabs
     vert(0).Red    = SetColor(255)
     vert(0).Green  = SetColor(255)
     vert(0).Blue   = SetColor(255)
     vert(0).Alpha  = &h0000
     vert(1).x      = Xin
     vert(1).y      = Yin
     vert(1).Red    = SetColor(r)
     vert(1).Green  = SetColor(g)
     vert(1).Blue   = SetColor(b)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v 
     
END SUB

SUB TabLabel(BYVAL ItemId AS LONG, BYVAL cid AS LONG,BYVAL hdc AS LONG,BYVAL Selected AS LONG, BYVAL Txt$)

    LOCAL htab&
     LOCAL rc AS Rect
     LOCAL clr&
     LOCAL lZStr  AS ASCIIZ * 64
     LOCAL hFont&
     DIM vert(1) AS TRIVERTEX
     DIM gRect AS GRADIENT_RECT

    CONTROL HANDLE hdlg&, cid& TO hTab&                ' get the control's handle
    CALL TabCtrl_GetItemRect(hTab&, ItemId, rc)         ' get the rectangle to each item (tab label)
    clr& = 224                                          ' set default color
    IF selected& = %ODS_SELECTED THEN clr& = &hdf       ' if it's selected then change it
     vert(0).x      = rc.nLeft
     vert(0).y      = rc.nTop
     vert(0).Red    = SetColor(&hff)
     vert(0).Green  = SetColor(&hff)
     vert(0).Blue   = SetColor(&hff)
     vert(0).Alpha  = &h0000
     vert(1).x      = rc.nRight
     vert(1).y      = rc.nBottom
     vert(1).Red    = SetColor(clr&)
     vert(1).Green  = SetColor(clr&)
     vert(1).Blue   = SetColor(clr&)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v

    IF Selected = %ODS_SELECTED THEN
        '*Use a bold font if selected
        hFont = CreateFont(-8,0,0,0,%FW_BOLD,0,0,0,0,0,0,0,0,"MS Sans Serif")
    ELSE
        '*Or a normal one if not selected
        hFont = CreateFont(-8,0,0,0,%FW_NORMAL,0,0,0,0,0,0,0,0,"MS Sans Serif")
    END IF
    hFont = SelectObject(hDC,hFont)         ' get the font
    lZstr = txt$                            ' copy the text to the nul terminated string
     SetBkMode hDc, %Transparent             ' set the bg for transparent
     SetTextColor hDc, GetSysColor(%COLOR_BTNTEXT)   ' set the foreground color to black

     TextOut hDc, rc.nLeft + 5, Rc.nTop + 3, lZStr, LEN (lZStr)  'draw the text
     CALL DeleteObject(SelectObject(hdc,hFont))      ' free the font handle
END SUB

CALLBACK FUNCTION hdlgcb AS LONG
  LOCAL lDisPtr AS DRAWITEMSTRUCT PTR
  LOCAL ps AS PAINTSTRUCT
  LOCAL  pNMHDR AS NMHDR PTR
  LOCAL result AS LONG,hTab AS LONG,Rc AS RECT,hpen AS LONG,CurrentItemId AS LONG
  LOCAL hDC AS DWORD,I AS INTEGER
  STATIC hTCBrush    AS LONG  ' Maintain a custom background color brush for Tab Control
  SELECT CASE CBMSG
    CASE %WM_INITDIALOG
      hTCBrush = CreateSolidBrush( RGB(213,234,255))
    CASE %WM_DESTROY
      PostQuitMessage 0
    CASE %WM_PAINT
      IF CBHNDL = hDlg& THEN CALL PaintBg(hDlg&,192,224,192)         
    CASE %WM_DRAWITEM
      IF CBCTL = %TAB1 THEN
        lDisPtr = CBLPARAM
        IF @lDisPtr.CtlType <> %ODT_TAB THEN EXIT FUNCTION  ' make sure it's a tab
        IF @lDisPtr.itemAction = %ODA_DRAWENTIRE THEN CALL PaintTabBg(CBCTL,@lDisPtr.hdc,192,224,192) 
        CALL TabLabel(@lDisPtr.ItemId,CBCTL,@lDisPtr.hdc,@lDisPtr.ItemState,TabText( @lDisPtr.ItemId))
        FUNCTION = %True
      END IF
    CASE %WM_NOTIFY
      ' Handle Notify messages for tooptips and tab page changes
      pNMHDR = CBLPARAM
      ' Is it a page change message?
      IF @pNMHDR.hWndFrom = GetDlgItem(CBHNDL, %TAB1) THEN

          ' Get the current tab page number (zero based)
          CONTROL SEND CBHNDL, %TAB1, %TCM_GETCURSEL, 0, 0 TO Result
          SELECT CASE @pNMHDR.Code
             CASE %TCN_SELCHANGING ' The page is about to change
               ' Code to hide any fields on the tab that is about to be moved away from
                  FUNCTION = 0
              CASE %TCN_SELCHANGE   ' The page is changing
                  ' Code to show any fields on the tab that is about to be moved to
                  FUNCTION = 0
          END SELECT
      END IF
    CASE %WM_COMMAND

  END SELECT
END FUNCTION

%MAXTAB = 5

FUNCTION TABCTRL(hDlg AS LONG,Iid AS LONG,W AS LONG,H AS LONG,T AS INTEGER) AS LONG
  LOCAL TI AS TC_ITEM
  LOCAL MessageText AS STRING
  LOCAL x AS INTEGER,hCtl AS LONG
  CONTROL ADD "SysTabControl32", hDlg, Iid, "", 10, 20, _
      W, H,%WS_CHILD OR %WS_VISIBLE OR %TCS_RIGHTJUSTIFY OR %TCS_OWNERDRAWFIXED,0
  ' Add tabs to the control
  TI.Mask = %TCIF_TEXT    ' Text field is valid
  TI.iImage = -1          ' no image
  CONTROL HANDLE hdlg&, Iid TO hCtl&        
  FOR x = 0 TO T - 1
    MessageText = TabText(x)
    TI.pszText = STRPTR(MessageText)
    TabCtrl_InsertItem hCtl&, x, TI
  NEXT
  FUNCTION = 0 'Success
END FUNCTION

FUNCTION Wind(Cap AS STRING,Wid AS LONG,Hei AS LONG,ShowState AS LONG) AS LONG
  LOCAL SCRXSIZE AS INTEGER
  SCRXSIZE =GetSystemMetrics(%SM_CXSCREEN)
  IF SCRXSIZE < 800 THEN
    DIALOG FONT "Arial Bold",6
  ELSEIF SCRXSIZE = 800 THEN
    DIALOG FONT "Arial Bold",8
  ELSEIF SCRXSIZE = > 800 THEN
    DIALOG FONT "Arial Bold",10
  END IF
  DIALOG NEW 0,Cap,,,Wid ,Hei, %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU,0 TO hdlg&
  MENU NEW POPUP TO hPopup1&
  MENU ADD STRING, hPopup1&, "&Close", 1001, %MF_ENABLED
  ' Attach the popup menu to the menu bar
  MENU ADD POPUP,  hMenu&,   "&File",  hPopup1&,   %MF_ENABLED
  ' Create a popup menu
  MENU NEW POPUP TO hPopup2&
  MENU ADD STRING, hPopup2&, "Cut   Ctrl+X", 1002,%MF_ENABLED
  MENU ADD STRING, hPopup2&, "Copy  Ctrl+C", 1003,%MF_ENABLED
  MENU ADD STRING, hPopup2&, "Paste Ctrl+P", 1004,%MF_ENABLED
  MENU ADD POPUP,  hMenu&,   "&Edit",  hPopup2&,        %MF_ENABLED
  ' Attach the popup menu to the menu bar
  MENU ATTACH hMenu&, hdlg&
  DIALOG SHOW STATE hDlg&,ShowState
  DIALOG SHOW MODELESS hdlg& CALL hdlgcb
  FUNCTION = hdlg&
END FUNCTION
FUNCTION PBMAIN AS LONG
InitCommonControls
DIM hDlg AS LONG
DIM TabText(%MAXTAB) AS GLOBAL ASCIIZ * 32
'Create window 
hDlg = Wind("Tab Test",380,300,%SW_SHOW)
TabText(0) = "Account Info Screen 1"
TabText(1) = "Account Info Screen 2 "
TabText(2) = "Related Parties       "
TabText(3) = "Recurring Payments    "
TabText(4) = "Ticklers              "
'Establish tab
TABCTRL(hDlg,%TAB1,360,240,5)
'Put initial controls on screen
'SCRN1
DO
  DIALOG DOEVENTS TO CNT&
LOOP UNTIL CNT& = 0
END FUNCTION