* * *    
Главная » Статьи » Код PB

Просмотров: 1552 | Дата: 25.04.2024 | Коментарии (0)

Закрыть вкладки



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 = 1 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<<32)  
  *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<<32)  
  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  

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,"Главная")  
  AddGadgetItem(0,-1,"fff266666666")  
   
  Repeat  
  Event = WaitWindowEvent()  
  Until Event = #PB_Event_CloseWindow  
   
EndProcedure  

main()










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.