''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''' THIS WORKS FOR XP, BUT I'M NOT SURE HOW IT WILL WORK ON OTHER PLATFORMS '''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' $TYPECHECK On '''' Included in the zip file '''' $RESOURCE Close_Bmp AS "Close.bmp" '''' Make a new rect (it wouldn't work with QRECT) '''' TYPE xTC_RECT Left AS INTEGER Top AS INTEGER Right AS INTEGER Bottom AS INTEGER END TYPE DIM TC_RECT AS xTC_RECT CONST GWL_WNDPROC = (-4) CONST GWL_STYLE = (-16) CONST WS_CHILD = &H40000000 CONST WS_VISIBLE = &H10000000 CONST WS_CLIPSIBLINGS = &H4000000 Const WS_CLIPCHILDREN = &H2000000 CONST WS_OVERLAPPED = &H0 CONST TCS_MULTILINE = &H200 CONST TCM_GETITEMRECT = &h130A CONST TCM_GETITEMCOUNT = &h1304 CONST TCM_DELETEITEM = &h1308 DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" (hWnd AS LONG,nIndex AS LONG, dwNewLong AS LONG) AS LONG DECLARE FUNCTION SendMessageA LIB "user32" ALIAS "SendMessageA" (hWnd AS LONG, Msg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG DECLARE FUNCTION GetParent LIB "user32" ALIAS "GetParent" (hWnd AS LONG) AS LONG DECLARE SUB DeleteTab DECLARE SUB TabChanged DECLARE SUB Initialize CREATE Form AS QFORM Caption = "Tab Control with Close Buttons" Width = 320 Height = 240 WindowState = 2 Center ShowHint = 1 OnShow = Initialize CREATE Tc AS QTABCONTROL Align = 5 'alClient AddTabs "Tab Control Item_1", "Tab Control Item_2", "Tab Control Item_3", "Tab Control Item_4" TabHeight = 23 OnChange = TabChanged CREATE CloseBtn AS QCOOLBTN Width = 19 Height = 19 BmpHandle = Close_Bmp Flat = 1 Visible = 0 Hint = "Close Tab" OnClick = DeleteTab END CREATE CREATE Panel0 AS QPANEL Align = 5 'alClient BevelOuter = 0 'bvNone CREATE Re AS QRICHEDIT Align = 5 'alClient END CREATE END CREATE END CREATE END CREATE DEFLNG NewStyle = WS_CHILD OR WS_VISIBLE OR WS_CLIPSIBLINGS OR TCS_MULTILINE OR WS_OVERLAPPED OR WS_CLIPCHILDREN DEFLNG hTc DEFLNG RetVal DEFINT Amount0 '''' QTABCONTROL doesn't have a tab count field so we need to make one '''' DEFINT Tc.TabCount = 0 '''' This will be used for the padding at the right of the tab '''' DEFSTR Gap = SPACE$(10) SetWindowLong(Form.Handle, -8, 0) SetWindowLong(Application.Handle, -8, Form.Handle) Form.ShowModal SUB DeleteTab '''' Remember the last TabIndex '''' DEFINT LastTab = Tc.TabIndex '''' Delete the selected tab '''' RetVal = SendMessageA(hTc, TCM_DELETEITEM, Tc.TabIndex, 0) '''' Get the tab control tab count '''' Tc.TabCount = SendMessageA(hTc, TCM_GETITEMCOUNT, 0, 0) '''' Select a new tab '''' IF LastTab <= Tc.TabCount-1 THEN Tc.TabIndex = LastTab ELSE Tc.TabIndex = LastTab - 1 END IF '''' Update '''' TabChanged END SUB SUB TabChanged '''' Get the tab control tab count '''' Tc.TabCount = SendMessageA(hTc, TCM_GETITEMCOUNT, 0, 0) '''' Trim the spaces from the right side of every tab '''' FOR Amount0 = 0 TO Tc.TabCount-1 Tc.Tab(Amount0) = RTRIM$(Tc.Tab(Amount0)) NEXT Amount0 '''' Add padding to the right of the tab so we can make room for the button '''' IF Tc.TabIndex <> 0 THEN Tc.Tab(Tc.TabIndex) = Tc.Tab(Tc.TabIndex) & Gap END IF '''' Get the rect of the selected tab '''' RetVal = SendMessageA(hTc, TCM_GETITEMRECT, Tc.TabIndex, TC_RECT) '''' Let's see the rect '''' Re.Clear Re.AddStrings "WITH TC_RECT" Re.AddStrings " .Left = " & STR$(TC_RECT.Left) Re.AddStrings " .Top = " & STR$(TC_RECT.Top) Re.AddStrings " .Right = " & STR$(TC_RECT.Right) Re.AddStrings " .Bottom = " & STR$(TC_RECT.Bottom) Re.AddStrings "END WITH" Re.AddStrings Re.AddStrings "Rect Width: " & STR$(TC_RECT.Right - TC_RECT.Left) Re.AddStrings "Rect Height: " & STR$(TC_RECT.Bottom - TC_RECT.Top) '''' Align and show the button if not on tab index 0'''' IF RetVal <> 0 THEN IF Tc.TabIndex <> 0 THEN CloseBtn.Top = TC_RECT.Top + 2 CloseBtn.Left = TC_RECT.Right - CloseBtn.Width - 2 CloseBtn.Visible = 1 ELSE CloseBtn.Visible = 0 END IF END IF END SUB SUB Initialize '''' Get the handle of the tab control '''' hTc = GetParent(Panel0.Handle) SetWindowLong(hTc, GWL_STYLE, NewStyle) END SUB