It is currently Thu May 23, 2013 12:53 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 16 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Add Close buttons to Panel Tabs
PostPosted: Sun Jul 29, 2007 4:13 am 
Offline
PureBasic Bullfrog
PureBasic Bullfrog
User avatar

Joined: Wed Jul 06, 2005 5:42 am
Posts: 6465
Code:
;=======================================================
; 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.

_________________
Veni, vidi, vici.


Top
 Profile  
 
 Post subject: Re: Add Close buttons to Panel Tabs
PostPosted: Sun Jul 29, 2007 5:25 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Fri Apr 25, 2003 5:24 pm
Posts: 6561
Not bad. :)

_________________
"Every program has at least one bug and can be shortened by at least one
instruction — from which, by induction, it is evident that every program
can be reduced to one instruction that does not work." - Ken Arnold.


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 5:58 am 
Offline
Addict
Addict

Joined: Mon May 29, 2006 1:01 am
Posts: 1966
Location: Outback
Nice. :)

_________________
Dare2 cut down to size


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 12:45 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Jul 22, 2003 5:02 pm
Posts: 1496
Location: Nantes, France
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:
;=======================================================
; 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

_________________
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 1:05 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Fri Apr 25, 2003 5:24 pm
Posts: 6561
@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.

_________________
"Every program has at least one bug and can be shortened by at least one
instruction — from which, by induction, it is evident that every program
can be reduced to one instruction that does not work." - Ken Arnold.


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 4:07 pm 
Offline
Addict
Addict

Joined: Wed Apr 07, 2004 12:51 am
Posts: 2358
Location: England
Another great bit of code. :)


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 6:19 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Aug 05, 2003 11:30 pm
Posts: 405
ok here is my version, the clos "X" looks nice and better i think.

Code:
;=======================================================
; 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

_________________
my live space


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 6:37 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue Nov 08, 2005 7:59 am
Posts: 165
Location: Germany
... and my version :

Code:
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:
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()


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 7:20 pm 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2558
Location: Southwest OH - USA
hallodri wrote:
... and my version :



Nice.

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

cheers


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 7:34 pm 
Offline
PureBasic Expert
PureBasic Expert
User avatar

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 9870
Location: Beyond the pale...
rsts wrote:
hallodri wrote:
... and my version :



Nice.

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

cheers


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

_________________
I may look like a mule, but I'm not a complete ass.

eScript
Arctic Reports
nxSoftware


Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 7:37 pm 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2558
Location: Southwest OH - USA
@srod :D

Very nice.

cheers

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


Last edited by rsts on Sun Jul 29, 2007 7:40 pm, edited 1 time in total.

Top
 Profile  
 
 Post subject:
PostPosted: Sun Jul 29, 2007 7:39 pm 
Offline
PureBasic Expert
PureBasic Expert
User avatar

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 9870
Location: Beyond the pale...
rsts wrote:
@srod :D

Very nice.

cheers


No, that's hallodri's excellent work.

_________________
I may look like a mule, but I'm not a complete ass.

eScript
Arctic Reports
nxSoftware


Top
 Profile  
 
 Post subject:
PostPosted: Thu Aug 09, 2007 9:02 am 
Offline
Enthusiast
Enthusiast

Joined: Tue Aug 05, 2003 11:30 pm
Posts: 405
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:
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

_________________
my live space


Top
 Profile  
 
 Post subject: Re: Add Close buttons to Panel Tabs
PostPosted: Tue Jul 05, 2011 7:34 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Apr 04, 2006 6:27 am
Posts: 308
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 ... 82(v=vs.85).aspx


Top
 Profile  
 
 Post subject: Re: Add Close buttons to Panel Tabs
PostPosted: Tue Jul 05, 2011 7:42 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 4715
Location: Berlin - Germany
Code:
PtInRect_(@br, cp\x | (cp\y << 32))

_________________
PureBasic 5.11 | Windows 7 SP1 (x64) | Linux Mint 14 (x64) | RealSource

The use of EnableExplicit is free of charge and avoids errors.


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 16 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye