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
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
Comment