PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Add Close buttons to Panel Tabs

https://www.purebasic.fr/english/viewtopic.php?t=28167

Page 1 of 2

Add Close buttons to Panel Tabs

Posted: Sun Jul 29, 2007 4:13 am
by netmaestro

Code: Select all

;=======================================================
; Demo: Add close buttons to panel tabs
; 
; netmaestro, July 2007
;
; Looks best with XP skins enabled
;=======================================================

Procedure ReAdjustTabButtons(hwnd, lParam)
  item = GetProp_(hwnd, "itemnumber")
  If item > lParam
    newitem = item-1
    SetProp_(hwnd, "itemnumber", newitem)
    SendMessage_(GetParent_(hwnd), #TCM_GETITEMRECT, newitem, tr.RECT)
    MoveWindow_(hwnd, tr\left+42,3,18,18,#True)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure ButtonProc(hwnd, msg, wParam, lParam)
  oldproc      = GetProp_(hwnd, "oldproc")
  itemnumber   = GetProp_(hwnd, "itemnumber")
  parent       = GetParent_(hwnd)
  gadgetnumber = GetDlgCtrlID_(hwnd)
  Select msg
    Case #WM_LBUTTONUP
      GetCursorPos_(@cp.POINT)
      GetWindowRect_(hwnd, @br.RECT)
      If PtInRect_(@br, cp\x, cp\y)
        DestroyWindow_(hwnd)
        RemoveGadgetItem(0,itemnumber)
        EnumChildWindows_(parent, @ReAdjustTabButtons(), itemnumber)
        numitems = SendMessage_(parent, #TCM_GETITEMCOUNT, 0, 0)
        If numitems = 0
          FreeGadget(GetDlgCtrlID_(parent))
        Else
          InvalidateRect_(parent, 0,1)
        EndIf
      EndIf
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      RemoveProp_(hwnd, "itemnumber")
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure

OpenWindow(0,0,0,320,240,"",$CA0001)
CreateGadgetList(WindowID(0))
PanelGadget(0,20,20,280,200)
AddGadgetItem(0,0,"Tab 0        ")
AddGadgetItem(0,1,"Tab 1        ")
AddGadgetItem(0,2,"Tab 2        ")

Dim tabbutton(2)

For i=0 To 2
  SendMessage_(GadgetID(0), #TCM_GETITEMRECT, i, @tr.RECT)
  tabbutton(i) = CreateWindowEx_(0,"Button","X",#WS_CHILD|#WS_VISIBLE,tr\left+42,3,18,18,GadgetID(0),i+1,GetModuleHandle_(0),0)
  SendMessage_(tabbutton(i), #WM_SETFONT, GetStockObject_(#DEFAULT_GUI_FONT),0)
  oldbuttonproc = SetWindowLong_(tabbutton(i), #GWL_WNDPROC, @ButtonProc())
  SetProp_(tabbutton(i), "oldproc", oldbuttonproc)
  SetProp_(tabbutton(i), "itemnumber", i)
Next

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
Code assumes the same width for all tabs, if they will vary you just need to use another Window Property to hold the x coordinate of the button in the specific tab.

Re: Add Close buttons to Panel Tabs

Posted: Sun Jul 29, 2007 5:25 am
by PB
Not bad. :)

Posted: Sun Jul 29, 2007 5:58 am
by Dare
Nice. :)

Posted: Sun Jul 29, 2007 12:45 pm
by Flype
hi netmaestro, it's interesting.

i can suggest 2 ideas to make it looks better.

1/ smaller close button using the 'middot' char (0xB7)
2/ relative width of tab.

Code: Select all

;=======================================================
; Demo: Add close buttons to panel tabs
;
; netmaestro, July 2007
;
; Looks best with XP skins enabled
;=======================================================

#PANEL_CLOSEBUTTON_WIDTH  = 14
#PANEL_CLOSEBUTTON_HEIGHT = 14
#PANEL_CLOSEBUTTON_TEXT   = "ยท" ; middot = 0xB7

Procedure ReAdjustTabButtons(hwnd, lParam)
  item = GetProp_(hwnd, "itemnumber")
  If item > lParam
    newitem = item - 1
    SetProp_(hwnd, "itemnumber", newitem)
    SendMessage_(GetParent_(hwnd), #TCM_GETITEMRECT, newitem, @tr.RECT)
    MoveWindow_(hwnd, tr\right - #PANEL_CLOSEBUTTON_WIDTH - 5, 5, #PANEL_CLOSEBUTTON_WIDTH, #PANEL_CLOSEBUTTON_HEIGHT, #True)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure ButtonProc(hwnd, msg, wParam, lParam)
  oldproc      = GetProp_(hwnd, "oldproc")
  itemnumber   = GetProp_(hwnd, "itemnumber")
  parent       = GetParent_(hwnd)
  gadgetnumber = GetDlgCtrlID_(hwnd)
  Select msg 
    Case #WM_LBUTTONUP
      GetCursorPos_(@cp.POINT)
      GetWindowRect_(hwnd, @br.RECT)
      If PtInRect_(@br, cp\x, cp\y)
        DestroyWindow_(hwnd)
        RemoveGadgetItem(0, itemnumber)
        EnumChildWindows_(parent, @ReAdjustTabButtons(), itemnumber)
        numitems = SendMessage_(parent, #TCM_GETITEMCOUNT, 0, 0)
        If numitems = 0
          FreeGadget(GetDlgCtrlID_(parent))
        Else
          InvalidateRect_(parent, 0, 1)
        EndIf
      EndIf
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      RemoveProp_(hwnd, "itemnumber")
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure

OpenWindow(0, 0, 0, 320, 240, "", $CA0001)
CreateGadgetList(WindowID(0))
PanelGadget(0, 20, 20, 280, 200)
AddGadgetItem(0, 0, "Properties")
AddGadgetItem(0, 1, "Options")
AddGadgetItem(0, 2, "Help")

Dim tabbutton(2)

For i = 0 To 2
  SetGadgetItemText(0, i, GetGadgetItemText(0, i) + Space(6))
  SendMessage_(GadgetID(0), #TCM_GETITEMRECT, i, @tr.RECT)
  tabbutton(i) = CreateWindowEx_(0, "Button", #PANEL_CLOSEBUTTON_TEXT, #WS_CHILD | #WS_VISIBLE, tr\right - #PANEL_CLOSEBUTTON_WIDTH - 5, 5, #PANEL_CLOSEBUTTON_WIDTH, #PANEL_CLOSEBUTTON_HEIGHT, GadgetID(0), i + 1, GetModuleHandle_(0), 0)
  SendMessage_(tabbutton(i), #WM_SETFONT, GetStockObject_(#DEFAULT_GUI_FONT), 0)
  oldbuttonproc = SetWindowLong_(tabbutton(i), #GWL_WNDPROC, @ButtonProc())
  SetProp_(tabbutton(i), "oldproc", oldbuttonproc)
  SetProp_(tabbutton(i), "itemnumber", i)
Next

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

Posted: Sun Jul 29, 2007 1:05 pm
by PB
@Flype:
Line 61: GetGadgetItemText(): Incorrect number of parameters.

[Edit] Oh, it works with v4.10 Beta 2, but not v4.02, I didn't realise.

Posted: Sun Jul 29, 2007 4:07 pm
by Derek
Another great bit of code. :)

Posted: Sun Jul 29, 2007 6:19 pm
by nicolaus
ok here is my version, the clos "X" looks nice and better i think.

Code: Select all

;=======================================================
; Demo: Add close buttons to panel tabs
;
; netmaestro, July 2007
;
; Looks best with XP skins enabled
;=======================================================

Procedure ReAdjustTabButtons(hwnd, lParam)
  item = GetProp_(hwnd, "itemnumber")
  If item > lParam
    newitem = item-1
    SetProp_(hwnd, "itemnumber", newitem)
    SendMessage_(GetParent_(hwnd), #TCM_GETITEMRECT, newitem, tr.RECT)
    MoveWindow_(hwnd, tr\left+42,3,14,14,#True)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure ButtonProc(hwnd, msg, wParam, lParam)
  oldproc      = GetProp_(hwnd, "oldproc")
  itemNumber   = GetProp_(hwnd, "itemnumber")
  Parent       = GetParent_(hwnd)
  GadgetNumber = GetDlgCtrlID_(hwnd)
  Select msg
    Case #WM_LBUTTONUP
      GetCursorPos_(@cp.POINT)
      GetWindowRect_(hwnd, @br.RECT)
      If PtInRect_(@br, cp\x, cp\y)
        DestroyWindow_(hwnd)
        RemoveGadgetItem(0,itemNumber)
        EnumChildWindows_(Parent, @ReAdjustTabButtons(), itemNumber)
        numitems = SendMessage_(Parent, #TCM_GETITEMCOUNT, 0, 0)
        If numitems = 0
          FreeGadget(GetDlgCtrlID_(Parent))
        Else
          InvalidateRect_(Parent, 0,1)
        EndIf
      EndIf
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      RemoveProp_(hwnd, "itemnumber")
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure

OpenWindow(0,0,0,320,240,"",$CA0001)
CreateGadgetList(WindowID(0))
PanelGadget(0,20,20,280,200)
AddGadgetItem(0,0,"Tab 0        ")
AddGadgetItem(0,1,"Tab 1        ")
AddGadgetItem(0,2,"Tab 2        ")

Dim tabbutton(2)

For i=0 To 2
  SendMessage_(GadgetID(0), #TCM_GETITEMRECT, i, @tr.RECT)
  tabbutton(i) = CreateWindowEx_(0,"Button","X",#WS_CHILD|#WS_VISIBLE,tr\left+42,3,14,14,GadgetID(0),i+1,GetModuleHandle_(0),0)
  SendMessage_(tabbutton(i), #WM_SETFONT, GetStockObject_(#DEFAULT_GUI_FONT),0)
  oldbuttonproc = SetWindowLong_(tabbutton(i), #GWL_WNDPROC, @ButtonProc())
  SetProp_(tabbutton(i), "oldproc", oldbuttonproc)
  SetProp_(tabbutton(i), "itemnumber", i)
  ;-- beginn by nicolaus
  style.l=GetWindowLong_(tabbutton(i),#GWL_STYLE)
  SetWindowLong_(tabbutton(i),#GWL_STYLE,style|#BS_FLAT)
  ;-- end by nicolaus
Next

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow

Posted: Sun Jul 29, 2007 6:37 pm
by hallodri
... and my version :

Code: Select all

Structure tc_extra
   oldproc.l
   lb_down.l
   c_item.l
EndStructure

;-
Procedure panel_subclass(hWnd,uMsg,wParam,lParam)
   Protected *tce.tc_extra = GetProp_(hWnd,"tc_extra")
   Protected *tci.TC_ITEM ,rc.RECT
   Protected hdc.l,itemcount.l,activeitem.l,item.l
   Protected w.l,hti.TC_HITTESTINFO,close.l
   
   If uMsg = #WM_PAINT
      CallWindowProc_(*tce\oldproc,hWnd,uMsg,wParam,lParam)
      
      activeitem = SendMessage_(hWnd,#TCM_GETCURSEL,0,0)
      itemcount  = SendMessage_(hWnd,#TCM_GETITEMCOUNT,0,0)
      hdc        = GetDC_(hWnd)
      
      For i = 0 To itemcount -1
         SendMessage_(hWnd, #TCM_GETITEMRECT, i ,rc.RECT) 
         
         If activeitem = i
            rc\left + 2 
            rc\top  - 1
         EndIf 
         
         rc\left   + (rc\right - rc\left) - 17
         rc\top    + 3
         rc\right  = rc\left + 8
         rc\bottom = rc\top  + 8
         
         Rectangle_(hdc,rc\left,rc\top,rc\left + 10,rc\top + 10)
         MoveToEx_(hdc,rc\left+2,rc\top+2,0)
         LineTo_(hdc,rc\left  + 8,rc\top + 8)
         MoveToEx_(hdc,rc\left+7,rc\top + 2,0)
         LineTo_(hdc,rc\left+1,rc\top+8)
         
      Next
      
      ReleaseDC_(hWnd,hdc)
      
      ProcedureReturn 
   EndIf
   
   If uMsg = #TCM_INSERTITEM
      *tci = lParam
      *tci\cchTextMax + 5
      temp.s = PeekS(*tci\pszText)
      temp + Space(5)
      *tci\pszText = @temp
   EndIf   
   
   If uMsg = #WM_LBUTTONDOWN
      hti\pt\x    = (lParam & $FFFF)
      hti\pt\y    = (lParam >> 16 & $FFFF)   
      item        = SendMessage_(hWnd,#TCM_HITTEST,0,@hti)
      
      If hti\flags & #TCHT_ONITEM
         
         SendMessage_(hWnd, #TCM_GETITEMRECT, item ,rc.RECT) 
         
         rc\left   + (rc\right - rc\left) - 17
         rc\top    + 3
         rc\right  = rc\left + 8
         rc\bottom = rc\top  + 8
         
         If PtInRect_(rc,hti\pt\x,hti\pt\y)
            *tce\lb_down = #True
            *tce\c_item  = item
         EndIf
         
      EndIf 
      
   EndIf
   
   If uMsg = #WM_LBUTTONUP
      hti\pt\x    = (lParam & $FFFF)
      hti\pt\y    = (lParam >> 16 & $FFFF)   
      item        = SendMessage_(hWnd,#TCM_HITTEST,0,@hti)
      
      If hti\flags & #TCHT_ONITEM And *tce\c_item = item
         
         SendMessage_(hWnd, #TCM_GETITEMRECT, item ,rc.RECT) 
         
         rc\left   + (rc\right - rc\left) - 17
         rc\top    + 3
         rc\right  = rc\left + 8
         rc\bottom = rc\top  + 8
         
         If PtInRect_(rc,hti\pt\x,hti\pt\y)
            RemoveGadgetItem(GetDlgCtrlID_(hWnd),item)
         EndIf
         
      EndIf 
      
   EndIf
   
   If uMsg = #WM_NCDESTROY
      RemoveProp_(hWnd,"tc_extra")
      FreeMemory(*tce)
      ProcedureReturn 0
   EndIf
   
   ProcedureReturn CallWindowProc_(*tce\oldproc,hWnd,uMsg,wParam,lParam)
EndProcedure

;- 
Procedure SetCloseTC(id) 
   Protected *tce.tc_extra 
   *tce = GetProp_(GadgetID(id),"tc_extra")
   If Not *tce
      *tce = AllocateMemory(SizeOf(tc_extra))
      SetProp_(GadgetID(id),"tc_extra",*tce)
   EndIf 
   *tce\oldproc = SetWindowLong_(GadgetID(id),#GWL_WNDPROC,@panel_subclass()) 
EndProcedure

Code: Select all

Procedure main()
   Protected hWnd
   Protected event
   
   hWnd = OpenWindow(0,#PB_Ignore,#PB_Ignore,500,500,"leer",#WS_OVERLAPPEDWINDOW)

   CreateGadgetList(hWnd)
   PanelGadget(0,0,0,500,500) : SetCloseTC(0)
   
   For i = 0 To 6
      AddGadgetItem(0,i,Str(i))
   Next
   
   AddGadgetItem(0,-1,"fff666666666666666666661")
   AddGadgetItem(0,-1,"fff266666666")
   
   Repeat
      event = WaitWindowEvent()
      
   Until event = #PB_Event_CloseWindow
	
EndProcedure:main()

Posted: Sun Jul 29, 2007 7:20 pm
by rsts
hallodri wrote:... and my version :
Nice.

Now all we need is one with a little red x icon.

cheers

Posted: Sun Jul 29, 2007 7:34 pm
by srod
rsts wrote:
hallodri wrote:... and my version :
Nice.

Now all we need is one with a little red x icon.

cheers

Code: Select all

Structure tc_extra 
   oldproc.l 
   lb_down.l 
   c_item.l 
EndStructure 

;- 
Procedure panel_subclass(hWnd,uMsg,wParam,lParam) 
   Protected *tce.tc_extra = GetProp_(hWnd,"tc_extra") 
   Protected *tci.TC_ITEM ,rc.RECT 
   Protected hdc.l,itemcount.l,activeitem.l,item.l 
   Protected w.l,hti.TC_HITTESTINFO,close.l 
    
   If uMsg = #WM_PAINT 
      CallWindowProc_(*tce\oldproc,hWnd,uMsg,wParam,lParam) 
      
      activeitem = SendMessage_(hWnd,#TCM_GETCURSEL,0,0) 
      itemcount  = SendMessage_(hWnd,#TCM_GETITEMCOUNT,0,0) 
      hdc        = GetDC_(hWnd) 
      pen=CreatePen_(#PS_SOLID,1,#Red)
      oldpen = SelectObject_(hdc,pen)

      For i = 0 To itemcount -1 
         SendMessage_(hWnd, #TCM_GETITEMRECT, i ,rc.RECT) 
         If activeitem = i 
            rc\left + 2 
            rc\top  - 1 
         EndIf 
          
         rc\left   + (rc\right - rc\left) - 17 
         rc\top    + 3 
         rc\right  = rc\left + 8 
         rc\bottom = rc\top  + 8 
         Rectangle_(hdc,rc\left,rc\top,rc\left + 10,rc\top + 10) 
         MoveToEx_(hdc,rc\left+2,rc\top+2,0) 
         LineTo_(hdc,rc\left  + 8,rc\top + 8) 
         MoveToEx_(hdc,rc\left+7,rc\top + 2,0) 
         LineTo_(hdc,rc\left+1,rc\top+8) 
      Next 
      SelectObject_(hdc,oldpen)
      DeleteObject_(pen)
      ReleaseDC_(hWnd,hdc) 
      
      ProcedureReturn 
   EndIf 
    
   If uMsg = #TCM_INSERTITEM 
      *tci = lParam 
      *tci\cchTextMax + 5 
      temp.s = PeekS(*tci\pszText) 
      temp + Space(5) 
      *tci\pszText = @temp 
   EndIf    
    
   If uMsg = #WM_LBUTTONDOWN 
      hti\pt\x    = (lParam & $FFFF) 
      hti\pt\y    = (lParam >> 16 & $FFFF)    
      item        = SendMessage_(hWnd,#TCM_HITTEST,0,@hti) 
      
      If hti\flags & #TCHT_ONITEM 
          
         SendMessage_(hWnd, #TCM_GETITEMRECT, item ,rc.RECT) 
          
         rc\left   + (rc\right - rc\left) - 17 
         rc\top    + 3 
         rc\right  = rc\left + 8 
         rc\bottom = rc\top  + 8 
          
         If PtInRect_(rc,hti\pt\x,hti\pt\y) 
            *tce\lb_down = #True 
            *tce\c_item  = item 
         EndIf 
          
      EndIf 
      
   EndIf 
    
   If uMsg = #WM_LBUTTONUP 
      hti\pt\x    = (lParam & $FFFF) 
      hti\pt\y    = (lParam >> 16 & $FFFF)    
      item        = SendMessage_(hWnd,#TCM_HITTEST,0,@hti) 
      
      If hti\flags & #TCHT_ONITEM And *tce\c_item = item 
          
         SendMessage_(hWnd, #TCM_GETITEMRECT, item ,rc.RECT) 
          
         rc\left   + (rc\right - rc\left) - 17 
         rc\top    + 3 
         rc\right  = rc\left + 8 
         rc\bottom = rc\top  + 8 
          
         If PtInRect_(rc,hti\pt\x,hti\pt\y) 
            RemoveGadgetItem(GetDlgCtrlID_(hWnd),item) 
         EndIf 
          
      EndIf 
      
   EndIf 
    
   If uMsg = #WM_NCDESTROY 
      RemoveProp_(hWnd,"tc_extra") 
      FreeMemory(*tce) 
      ProcedureReturn 0 
   EndIf 
    
   ProcedureReturn CallWindowProc_(*tce\oldproc,hWnd,uMsg,wParam,lParam) 
EndProcedure 

;- 
Procedure SetCloseTC(id) 
   Protected *tce.tc_extra 
   *tce = GetProp_(GadgetID(id),"tc_extra") 
   If Not *tce 
      *tce = AllocateMemory(SizeOf(tc_extra)) 
      SetProp_(GadgetID(id),"tc_extra",*tce) 
   EndIf 
   *tce\oldproc = SetWindowLong_(GadgetID(id),#GWL_WNDPROC,@panel_subclass()) 
EndProcedure 

 
;Code: 
Procedure main() 
   Protected hWnd 
   Protected event 
    
   hWnd = OpenWindow(0,#PB_Ignore,#PB_Ignore,500,500,"leer",#WS_OVERLAPPEDWINDOW) 

   CreateGadgetList(hWnd) 
   PanelGadget(0,0,0,500,500) : SetCloseTC(0) 
    
   For i = 0 To 6 
      AddGadgetItem(0,i,Str(i)) 
   Next 
    
   AddGadgetItem(0,-1,"fff666666666666666666661") 
   AddGadgetItem(0,-1,"fff266666666") 
    
   Repeat 
      event = WaitWindowEvent() 
      
   Until event = #PB_Event_CloseWindow 
    
EndProcedure

main()
:wink:

Thanks for the examples guys, very nice!

Posted: Sun Jul 29, 2007 7:37 pm
by rsts
@srod :D

Very nice.

cheers

(now to wait for netmaestro's responce :) )

Posted: Sun Jul 29, 2007 7:39 pm
by srod
rsts wrote:@srod :D

Very nice.

cheers
No, that's hallodri's excellent work.

Posted: Thu Aug 09, 2007 9:02 am
by nicolaus
ok one more version by me.
Now i have channged the callback so that the last selected item was
reselect if you close a item.
For all channges see the code with my commens

Code: Select all

Procedure ReAdjustTabButtons(hwnd, lParam)
  item = GetProp_(hwnd, "itemnumber")
  If item > lParam
    newitem = item-1
    SetProp_(hwnd, "itemnumber", newitem)
    SendMessage_(GetParent_(hwnd), #TCM_GETITEMRECT, newitem, tr.RECT)
    MoveWindow_(hwnd, tr\left+42,3,14,14,#True)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure ButtonProc(hwnd, msg, wParam, lParam)
  oldproc      = GetProp_(hwnd, "oldproc")
  itemNumber   = GetProp_(hwnd, "itemnumber")
  Parent       = GetParent_(hwnd)
  GadgetNumber = GetDlgCtrlID_(hwnd)
  Select msg
    Case #WM_LBUTTONUP
      ;-- beginn by nicolaus
      item = GetGadgetState(0)
      ;-- end by nicolaus
      GetCursorPos_(@cp.POINT)
      GetWindowRect_(hwnd, @br.RECT)
      If PtInRect_(@br, cp\x, cp\y)
        DestroyWindow_(hwnd)
        RemoveGadgetItem(0,itemNumber)
        EnumChildWindows_(Parent, @ReAdjustTabButtons(), itemNumber)
        numitems = SendMessage_(Parent, #TCM_GETITEMCOUNT, 0, 0)
        If numitems = 0
          FreeGadget(GetDlgCtrlID_(Parent))
        Else
          InvalidateRect_(Parent, 0,1)
        EndIf
        ;-- beginn by nicolaus
        If itemNumber > item
          SetGadgetState(0,item)
        ElseIf itemNumber < item
          SetGadgetState(0,item-1)
        EndIf
        ;-- end by nicolaus
      EndIf
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
      RemoveProp_(hwnd, "itemnumber")
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure

OpenWindow(0,0,0,320,240,"",$CA0001)
CreateGadgetList(WindowID(0))
PanelGadget(0,20,20,280,200)


Dim tabbutton(5)

For i=0 To 5
  ;-- beginn by nicolaus
  AddGadgetItem(0,i,"Tab "+Str(i))
  itemtext.s = GetGadgetItemText(0,i,0)
  ;-- end by nicolaus
  SendMessage_(GadgetID(0), #TCM_GETITEMRECT, i, @tr.RECT)
  tabbutton(i) = CreateWindowEx_(0,"Button","X",#WS_CHILD|#WS_VISIBLE,tr\left+42,3,14,14,GadgetID(0),i+1,GetModuleHandle_(0),0)
  SendMessage_(tabbutton(i), #WM_SETFONT, GetStockObject_(#DEFAULT_GUI_FONT),0)
  oldbuttonproc = SetWindowLong_(tabbutton(i), #GWL_WNDPROC, @ButtonProc())
  SetProp_(tabbutton(i), "oldproc", oldbuttonproc)
  SetProp_(tabbutton(i), "itemnumber", i)
  ;-- beginn by nicolaus
  style.l=GetWindowLong_(tabbutton(i),#GWL_STYLE)
  SetWindowLong_(tabbutton(i),#GWL_STYLE,style|#BS_FLAT)
  SetGadgetItemText(0,i,itemtext+"        ",0)
  ;-- end by nicolaus
Next

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow

Re: Add Close buttons to Panel Tabs

Posted: Tue Jul 05, 2011 7:34 pm
by X
Purebasic 4.51 (x64) line 24 error:

PtInRect_(@br, cp\x, cp\y)

Incorrect # of parameters. There are only supposed to be 2 parameters:

http://msdn.microsoft.com/en-us/library ... s.85).aspx

Re: Add Close buttons to Panel Tabs

Posted: Tue Jul 05, 2011 7:42 pm
by ts-soft

Code: Select all

PtInRect_(@br, cp\x | (cp\y << 32))
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited