TAB - Two Icons on TAB

Date: 02-16-2022

Return to Index

 
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
'#Include "commctrl.inc"
'#Resource Manifest, 1, "files\xptheme.xml"
#Resource Icon tabiconA "images\wide.ico"
#Resource Icon tabiconB "images\wideb.ico"
%IDM_Close = 500
%IDC_Tab   = 501
Global hDlg, hTab, hImgListTab,hPage1,hPage2 As Dword, Dirty() As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Two-Icon TAB Test",300,300,300,100, %WS_SysMenu, 0 To hDlg
   Control Add Tab, hDlg, %IDC_Tab, "", 10,20,250,60
   Control Handle hDlg, %IDC_Tab To hTab
 
   'image list
   ImageList New Icon 30,12,24,2 To hImgListTab  ' w,h,depth,size
   ImageList Add Icon hImgListTab, "tabicona"          '1
   ImageList Add Icon hImgListTab, "tabiconb"          '2
   Tab Set ImageList hDlg, %IDC_Tab, hImgListTab
 
   'pages
   Tab Insert Page hDlg, %IDC_Tab, 1,1,"Page1" To hPage1
   Tab Insert Page hDlg, %IDC_Tab, 2,1,"Page2Page2" To hPage2
 
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x,y,iReturn,iSelTab As Long, pt As PointAPI, HT As TC_HitTestInfo, r As Rect
   Select Case Cb.Msg
      Case %WM_InitDialog
         ReDim Dirty(1)
      Case %WM_SetCursor
         If Cb.WParam = hTab And Hi(Word,Cb.LParam) = %WM_LButtonDown Then
            GetCursorPos pt : ScreenToClient htab, pt : HT.pt = pt
            iSelTAB = SendMessage(hTab, %TCM_HitTest, 0, VarPtr(HT))  'zero based
            SendMessage(hTAB, %TCM_GetItemRect, iSelTab, VarPtr(r))
            Dirty(0) Xor= 1
            SetTABIcon iSelTAB
            Select Case HT.pt.x
               Case r.nLeft+9  To r.nLeft+21 ': Dialog Set Text hDlg, Str$(iSelTAB) + Str$(r.nLeft) + "Clicked on left icon"
               Case r.nLeft+22 To r.nLeft+24 ': Dialog Set Text hDlg, Str$(iSelTAB) + Str$(r.nLeft) + "Clicked betweens icons"
               Case r.nLeft+25 To r.nLeft+36 ': Dialog Set Text hDlg, Str$(iSelTAB) + Str$(r.nLeft) + "Clicked on right icon"
               Case Else                     ': Dialog Set text hDlg, "Clicked nowhere being monitored"
            End Select
         End If
   End Select
End Function
 
Sub SetTABIcon(iTAB As Long)
   Local xtcItem As TC_ITEM
   xtcItem.mask = %TCIF_Image
   xtcItem.iImage = IIf(Dirty(0),1,0)   '0=clean icon  1=dirty icon
   SendMessage hTab, %TCM_SETITEM, iTAB, VarPtr(xtcItem)
End Sub
 
'gbs_01393
'Date: 10-17-2014

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm