Announcement

Collapse
No announcement yet.

Tab Control and gradient shading problem

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Tab Control and gradient shading problem

    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
    Code:
    #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

  • #2
    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.
    Chris Boss
    Computer Workshop
    Developer of "EZGUI"
    http://cwsof.com
    http://twitter.com/EZGUIProGuy

    Comment


    • #3
      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

      Comment


      • #4
        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

        Comment


        • #5
          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

          Comment


          • #6
            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.

            Code:
            #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
            
            '------------------------------------------------------------------------------

            Comment


            • #7
              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.

              Code:
              #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
              '------------------------------------------------------------------------------
              Chris Boss
              Computer Workshop
              Developer of "EZGUI"
              http://cwsof.com
              http://twitter.com/EZGUIProGuy

              Comment


              • #8
                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

                Code:
                    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
                Last edited by BOB MECHLER; 26 Jan 2008, 10:36 AM. Reason: More info

                Comment


                • #9
                  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:
                  Code:
                           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:

                  Code:
                  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??
                  Jim Seekamp

                  Comment


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

                    Code:
                    #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
                    Last edited by Jim Seekamp; 5 May 2009, 04:40 PM.
                    Jim Seekamp

                    Comment


                    • #11
                      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:

                      Code:
                      #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]@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&
                                 ' -------------------
                                 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
                      Chris Boss
                      Computer Workshop
                      Developer of "EZGUI"
                      http://cwsof.com
                      http://twitter.com/EZGUIProGuy

                      Comment


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

                        Comment


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

                          Code:
                          #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:
                          Attached Files
                          Last edited by Chris Boss; 5 May 2009, 11:59 PM.
                          Chris Boss
                          Computer Workshop
                          Developer of "EZGUI"
                          http://cwsof.com
                          http://twitter.com/EZGUIProGuy

                          Comment

                          Working...
                          X