Using event handlers - (EasyVENT version 3.2)

[rsts]

Worked fine here

cheers

[srod]

The download link for EasyEvent doesn't work.

Make sure you use the link at the very top of the first post.

[GeoTrail]

Yupp, that worked much better

[Marc]

I try to detect a MouseDown event on a ExplorerCombo gadget without succes.

The only event returned by EasyVent is #OnSetCursor.

I'm needing help for my project

Regard

[srod]

You need to target it at the actual combo box rather than the ExplorerCombo etc.

Code: Select all

;*********************************************************************************
XIncludeFile "EasyVENT.pbi"
;*********************************************************************************

DisableExplicit

Declare.l MouseDown(*sender.PB_Sender)

OpenWindow(0, 100, 100, 450, 250, "EasyVENT EditableComboBoxGadget demo.", #PB_Window_SystemMenu |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget| #PB_Window_ScreenCentered)

CreateGadgetList(WindowID(0))
ExplorerComboGadget(1, 10, 40, 380, 200, "C:\")
hWnd = FindWindowEx_(GadgetID(1), #Null, "ComboBox", #Null)

;Set event handlers.
SetEventHandler(hWnd, #OnMouseDown, @MouseDown())

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
End


;*********************************************************************************
;                                 EVENT HANDLERS
;*********************************************************************************

Procedure.l MouseDown(*sender.PB_Sender)
  Protected result
    Debug "Mouse down!"
    PerformDefaultWinProcessing(*sender)
    result = #Event_ReturnDefault
  ProcedureReturn #Event_ReturnFalse
EndProcedure

If you are using an editable combo then I'll have to adjust the code a little.

[mrjiles]

srod, noticed something with #OnItemSelected and Combobox gadgets (PB 4.2). The event is firing when the item is selected AND when the drop down arrow is clicked. Not sure if this is normal or not. May also be related to 4.2 changes.

[nicolaus]

the link to download it dont go. Please can you update the link to the lib so that i can download it?

thanks,
Nico

[srod]

@nicolaus, the link works fine here. Use the link at the VERY TOP of the ifrst post.

srod, noticed something with #OnItemSelected and Combobox gadgets (PB 4.2). The event is firing when the item is selected AND when the drop down arrow is clicked. Not sure if this is normal or not. May also be related to 4.2 changes.

Fixed. See version 3.1.3.

[srod]

12th January 2008. (Purebasic 4.1 onwards). Minor bug fix - version 3.1.3.
A problem with the #OnItemSelected and combo boxes.

Thanks to mrjiles.

Please see the first post for the download.

[schic]

there are some bugs, at least unlogic behavior with
TreeGadgets in the newer versions of Easyvent:

- no MouseUp-event on Scrollbar, MouseDown-event does work
- no MouseUp on selecting
- no #EVENT_LEFTBUTTON sent with MouseOver

these did work as expected in early versions.

no negative Mouse coordinates in all versions of EasyVent

Here is an example:

Code: Select all

XIncludeFile "EasyVENT.pbi" ;EasyVENT-v3.0.2

#Window = 0
#Txt1 = 1
#Txt2 = 2
#Tree = 3

Procedure Tree_MouseDown(*sender.PB_Sender)
  SetGadgetText(#Txt1, "MouseDown")
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnDefault
EndProcedure

Procedure Tree_MouseUp(*sender.PB_Sender)
  SetGadgetText(#Txt1, "MouseUp")
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnDefault
EndProcedure

Procedure.l SelectItem(*sender.PB_Sender)
  SetGadgetText(#Txt1, "SelectItem")
  ProcedureReturn #Event_ReturnTrue
EndProcedure

Procedure.l Tree_MouseOver(*sender.PB_Sender)
  Protected rect_TV.RECT, hItem_oldTop, tmpTxt$, mouseCapture
  
  If *sender\button = #EVENT_LEFTBUTTON
    tmpTxt$ = ", LeftBtnEvnt is sent"
  Else
    tmpTxt$ = ", no LeftBtnEvnt"
  EndIf
  SetGadgetText(#Txt1, "MouseY: " + Str(*sender\MouseY) + tmpTxt$)
  
  GetClientRect_(*sender\hwnd, @rect_TV)
  
  If *sender\MouseY < 4 Or *sender\MouseY > rect_TV\bottom-4
    SetCapture_(*sender\hwnd); to get mouseevents beyond TV in the TV-eventhandlers
    mouseCapture = #True     ; you have to press left mousebotton to get events from outside window
  ElseIf mouseCapture
    ReleaseCapture_()
  EndIf
  If *sender\MouseX > rect_TV\right And mouseCapture ; to enable closing window
    ReleaseCapture_()
  EndIf
  
  ProcedureReturn #PB_ProcessPureBasicEvents  
EndProcedure

Define gdgetTxt$, i.l, Event.l

If OpenWindow(#Window, 0, 0, 200, 395, "EasyVent-Tree", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
  If CreateGadgetList(WindowID(#Window))
    
    TextGadget(#Txt1, 9, 220, 180, 15, "klick on ScrollBar etc.")
    SetGadgetColor(#Txt1, #PB_Gadget_FrontColor, #Blue)
    gdgetTxt$ = "MouseDown-event on Scrollbar, but no MouseUp-event and no MouseUp on selecting." + Chr(#CR) + Chr(#lf) + Chr(#CR) + Chr(#lf)
    gdgetTxt$ + "Press left mousebutton and move mouse out of top of TreeGadget:" + Chr(#CR) + Chr(#lf)
    gdgetTxt$ + "-> no negative MouseY (and MouseX)" + Chr(#CR) + Chr(#lf)
    gdgetTxt$ + "-> no #EVENT_LEFTBUTTON sent in MouseOver"
    TextGadget(#Txt2, 9, 235, 180, 140, gdgetTxt$)
    
    TreeGadget(#Tree, 9, 5, 150, 210)
    
    For i = 1 To 10
      AddGadgetItem(#Tree, -1, "Node " + Str(i))
      AddGadgetItem(#Tree, -1, "Subnode 1", 0, 1)
      AddGadgetItem(#Tree, -1, "Subnode 2", 0, 1)
      AddGadgetItem(#Tree, -1, "Subnode 3", 0, 1)
      SetGadgetItemState(#Tree, (i - 1) * 4, #PB_Tree_Expanded)
    Next i
    
    SetEventHandler(GadgetID(#Tree), #OnMouseOver,    @Tree_MouseOver())
    SetEventHandler(GadgetID(#Tree), #OnMouseDown,    @Tree_MouseDown())
    SetEventHandler(GadgetID(#Tree), #OnMouseUp,      @Tree_MouseUp())
    SetEventHandler(GadgetID(#Tree), #OnItemSelecting,@SelectItem())
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
    
  EndIf
EndIf 

Or did I overlook something?

If the type of PB_Sender\MouseX and \MouseY is set to Word
instead of Long, negative coordinates would be correct.

[srod]

no MouseUp-event on Scrollbar, MouseDown-event does work
- no MouseUp on selecting

This are not EasyVENT issues, but a Purebasic thing now which you can see with the following non-EasyVENT code :

Code: Select all

Global oldProc

Procedure.l callback(hWnd, uMsg, wParam, lParam)
  result = CallWindowProc_(oldProc, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #WM_LBUTTONDOWN
      Debug "Mouse down"
  
    Case #WM_LBUTTONUP
      Debug "Mouse up"
  
  EndSelect  
  ProcedureReturn result
EndProcedure

#Window=0
#tree=0
If OpenWindow(#Window, 0, 0, 200, 395, "EasyVent-Tree", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered) 
  If CreateGadgetList(WindowID(#Window)) 
    
    TreeGadget(#Tree, 9, 5, 150, 210) 
    
    For i = 1 To 10 
      AddGadgetItem(#Tree, -1, "Node " + Str(i)) 
      AddGadgetItem(#Tree, -1, "Subnode 1", 0, 1) 
      AddGadgetItem(#Tree, -1, "Subnode 2", 0, 1) 
      AddGadgetItem(#Tree, -1, "Subnode 3", 0, 1) 
      SetGadgetItemState(#Tree, (i - 1) * 4, #PB_Tree_Expanded) 
    Next i 
    oldProc = SetWindowLong_(GadgetID(#Tree), #GWL_WNDPROC, @callback())
   
    Repeat 
      Event = WaitWindowEvent() 
    Until Event = #PB_Event_CloseWindow 
  EndIf 
EndIf  

This seems to have changed with PB 4.xx. I had to go back to PB 3.72 before the code would work as expected. This means that Purebasic must be swallowing the Windows message at some point and there is thus nothing I can do about it. There are obvious workarounds however.

- no #EVENT_LEFTBUTTON sent with MouseOver

Of course not! Moving the mouse has nothing whatsoever to do with a mouse button!

no negative Mouse coordinates in all versions of EasyVent

Easy enough to cast to words and get your negative coordinates if required. I used 32-bits because most Window's messages upon which EasyVENT relies do not provide the mouse coordinates etc. and the functions subsequently used return 32-bit values.
Note though that EasyVENT's mouse events fire for both client and non-client etc. and so you will need to take care here.

One thing about the code you posted; you should not be using SetCapture_() if the mouse button is not down and so you should not be using the functin in a mouseover event handler etc.

[schic]

you are right i was a little bit too headless, mixed some PB 3.X
code with EasyVent

Excuse.

But tried to make a Tree-multiselection with EasyVent and it
already did work quite good and not to be a deathless back
number I started with EasyVent3.1 halfway...

well I suppose I have to change it.

[schic]

well I have changed it, with the help of many posts here in the forum. Thank you all.
For those who need multiselecting in trees:

Code: Select all

XIncludeFile "E:\coding\PB\EasyVENT - v3\EasyVENT.pbi" ; by Stephen Rodriguez

#TVM_GETITEMSTATE = #TV_FIRST + 39

; TreeView with multiselect using #TVIS_MARKED	= 1 in the stateMask
; 1 is not used in the Mask Variables (TVIS_) - maybe MS will use it 
; for another purpose one day...
#TVIS_MARKED	= 1

Global hdcTV            ; DC holding Treeviewimage with rubber rectangle
Global hdcOrigTV        ; DC holding Treeviewimage without rubber rectangle
Global focusPt.POINT    ; origin when starting mark-action with mouse
Global lplb.LOGBRUSH    ; appearance of rubber rectangle
Global hTVmultiSelect.l ; holding the handle of the TV while mark-action is going on
Global CtrlPressed.l, ShiftPressed.l

Procedure.s TVGetItemName(hTV.l, hItem)
  Protected text.s, pitem.TV_ITEM
  
  ; code by Armoured
  ; http://www.purebasic.fr/english/viewtopic.php?t=20397
  text = Space(255)
  pitem\mask = #TVIF_TEXT
  pitem\hItem = hItem;SendMessage_(hTV, #TVM_GETNEXTITEM, #TVGN_CARET,0)
  pitem\pszText = @text
  pitem\cchTextMax = 255
  
  If (pitem\hItem)
    SendMessage_(hTV, #TVM_GETITEM, 0, @pitem)
    ProcedureReturn PeekS(pitem\pszText)
  EndIf
EndProcedure

Procedure.s GetMarkedItems(hTV)
  Protected TVItem.TV_ITEM, itemState.l, txt$
  
  TVItem\mask = #TVIF_STATE
  TVItem\hItem = SendMessage_(hTV, #TVM_GETNEXTITEM, #TVGN_ROOT, 0)
  Repeat
    itemState = SendMessage_(hTV, #TVM_GETITEMSTATE, TVItem\hItem, #TVIS_MARKED)
    
    TVItem\mask = #TVIF_STATE
    If itemState & #TVIS_MARKED 
      txt$ + TVGetItemName(hTV, TVItem\hItem)+Chr(#CR)+Chr(#lf)
    EndIf
    TVItem\hItem = SendMessage_(hTV, #TVM_GETNEXTITEM, #TVGN_NEXTVISIBLE, TVItem\hItem) 
  Until TVItem\hItem = 0
  
  ProcedureReturn txt$
EndProcedure

Procedure SwitchMarkingOn(hTree, hItem)
  Protected TVItem.TV_ITEM
  TVItem\mask = #TVIF_STATE
  TVItem\hItem = hItem
  TVItem\stateMask = #TVIS_DROPHILITED | #TVIS_MARKED
  TVItem\state = #TVIS_DROPHILITED | #TVIS_MARKED
  SendMessage_(hTree, #TVM_SETITEM, 0, @TVItem)
EndProcedure

Procedure SwitchMarkingOff(hTree, hItem)
  Protected TVItem.TV_ITEM
  TVItem\mask = #TVIF_STATE
  TVItem\hItem = hItem
  TVItem\stateMask = #TVIS_DROPHILITED | #TVIS_SELECTED | #TVIS_MARKED
  TVItem\state = 0
  SendMessage_(hTree, #TVM_SETITEM, 0, @TVItem)
EndProcedure

Procedure TreeItemsUnmarkAll(hGadget)
  Protected TVItem.TV_ITEM
  
  TVItem\hItem = SendMessage_(hGadget, #TVM_GETNEXTITEM, #TVGN_ROOT, 0)
  Repeat
    SwitchMarkingOff(hGadget, TVItem\hItem)
    TVItem\hItem = SendMessage_(hGadget, #TVM_GETNEXTITEM, #TVGN_NEXTVISIBLE, TVItem\hItem) 
  Until TVItem\hItem = 0
  
EndProcedure

Procedure TreeItemsMark(hGadget, toItem)
  Protected TVItem.TV_ITEM
  Protected lastItem.l, hSelItem.l
  
  hSelItem = SendMessage_(hGadget, #TVM_GETNEXTITEM, #TVGN_CARET, #Null)
  
  If hSelItem < toItem
    TVItem\hItem = hSelItem
    lastItem = toItem
  Else
    TVItem\hItem = toItem
    lastItem = hSelItem
  EndIf
  
  TVItem\mask = #TVIF_STATE
  TVItem\stateMask = #TVIS_DROPHILITED | #TVIS_MARKED
  TVItem\state = #TVIS_DROPHILITED | #TVIS_MARKED 
  Repeat
    SendMessage_(hGadget, #TVM_SETITEM, 0, @TVItem)
    TVItem\hItem = SendMessage_(hGadget, #TVM_GETNEXTITEM, #TVGN_NEXTVISIBLE, TVItem\hItem) 
  Until TVItem\hItem>lastItem Or TVItem\hItem=0
  
EndProcedure

Procedure TV_MouseSel_Off()
  Protected rect_TV.RECT
  GetClientRect_(hTVmultiSelect, @rect_TV)
  BitBlt_(hdcTV,0,0,rect_TV\right,rect_TV\bottom,hdcOrigTV,0,0,#SRCCOPY)  ; restore background
  DeleteDC_(hdcOrigTV) ;recover memory
  hTVmultiSelect = #False
EndProcedure

Procedure ToggleTreeItemMark(hTree, hItem)
  Protected TVItem.TV_ITEM, itemState.l
  
  itemState = SendMessage_(hTree, #TVM_GETITEMSTATE, hItem, #TVIS_MARKED)
  If itemState & #TVIS_MARKED
    SwitchMarkingOff(hTree, hItem)
  Else
    SwitchMarkingOn(hTree, hItem)
  EndIf
  
EndProcedure

Procedure Tree_MouseDown(*sender.PB_Sender)
  Static counter.l
  Protected ItemHandle.l, selitem
  Protected TVHitTest.TV_HITTESTINFO
  Protected TVItem.TV_ITEM
  
  TVHitTest\pt\x = *sender\MouseX
  TVHitTest\pt\y = *sender\MouseY
  ItemHandle = SendMessage_(*sender\hwnd, #TVM_HITTEST, 0, @TVHitTest)
  
  If ItemHandle And Not TVHitTest\flags & (#TVHT_ONITEMRIGHT|#TVHT_ONITEMINDENT|#TVHT_ONITEMBUTTON)
    If CtrlPressed
      selitem = SendMessage_(*sender\hwnd, #TVM_GETNEXTITEM, #TVGN_CARET, #Null)
      If selitem = ItemHandle
        ToggleTreeItemMark(*sender\hwnd, selitem)
      EndIf
      If Not counter ; mark previous selected item
        SwitchMarkingOn(*sender\hwnd, selitem)
      EndIf
      counter + 1
    ElseIf ShiftPressed
      TVHitTest\pt\x = *sender\MouseX
      TVHitTest\pt\y = *sender\MouseY
      ItemHandle = SendMessage_(*sender\hwnd, #TVM_HITTEST, 0, @TVHitTest)
      TreeItemsMark(*sender\hwnd, ItemHandle) 
    Else
      counter = 0
    EndIf
  ElseIf Not TVHitTest\flags & (#TVHT_TOLEFT | #TVHT_TORIGHT | #TVHT_ABOVE | #TVHT_BELOW)
    ; if mouse is not on scrollbars
    If Not CtrlPressed
      TreeItemsUnmarkAll(*sender\hwnd)
    EndIf
  EndIf
  
  If *sender\button = #EVENT_LEFTBUTTON And TVHitTest\flags & (#TVHT_ONITEMRIGHT|#TVHT_ONITEMINDENT|#TVHT_ONITEMBUTTON);Not TVHitTest\flags & (#TVHT_TOLEFT | #TVHT_TORIGHT | #TVHT_ABOVE | #TVHT_BELOW)
    hdcOrigTV = CreateCompatibleDC_(hdcTV) 
    focusPt\x      = *sender\MouseX
    focusPt\y      = *sender\MouseY
    hTVmultiSelect = *sender\hwnd
  EndIf 
  
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnDefault
EndProcedure

Procedure Tree_MouseOver(*sender.PB_Sender)
  Static prevMouseX.w, prevMouseY.w, mouseCapture.l
  Protected TVItem.TV_ITEM, tvItemRect.RECT, rect_TV.RECT, topItemRect.RECT
  Protected hItem_oldTop.l, scroll.l, rect_TVH.l, rect_TVW.l, markit.l, Pen.l
  Protected relMouseY.w, relMouseX.w, lowrightX.w, upleftX.w, lowrightY.w, upleftY.w
  
  If hTVmultiSelect
    relMouseY = $FFFF & *sender\MouseY
    relMouseX = $FFFF & *sender\MouseX
    
    GetClientRect_(*sender\hwnd, @rect_TV)
    rect_TVH = rect_TV\bottom-rect_TV\top
    rect_TVW = rect_TV\right-rect_TV\left
    BitBlt_(hdcTV,0,0,rect_TVW,rect_TVH,hdcOrigTV,0,0,#SRCCOPY) ;delete previous rectangle
    
    If relMouseY < 4 Or relMouseY > rect_TV\bottom-4 Or relMouseX < 4 Or relMouseX > rect_TV\right-4
      SetCapture_(*sender\hwnd); to get mouseevents beyond TV in the TV-eventhandlers
      mouseCapture = #True
      If relMouseY < 4 Or relMouseY > rect_TV\bottom-4
        If relMouseY < 4
          scroll = #SB_LINEUP   ; scroll up
        ElseIf relMouseY > rect_TV\bottom-4
          scroll = #SB_LINEDOWN ; scroll down
        EndIf
        hItem_oldTop = SendMessage_(*sender\hwnd, #TVM_GETNEXTITEM, #TVGN_FIRSTVISIBLE, 0); get top item before scrolling
        SendMessage_(*sender\hwnd, #WM_VSCROLL, scroll, 0)
        ; recalculate origin of rubber-rectangle with scrolled TV
        topItemRect\left=hItem_oldTop
        SendMessage_(*sender\hwnd, #TVM_GETITEMRECT, #False, @topItemRect); position of the old topitem, now after scrolling
        focusPt\y + topItemRect\top ; new y-coordinate of origin <- actual top - old top(=0)
      EndIf
    ElseIf mouseCapture
      ReleaseCapture_()
      mouseCapture = #False
    EndIf
    
    If relMouseX<>prevMouseX Or relMouseY <>prevMouseY
      ; calculate up left and low right corner of the rubber rectangle
      If relMouseX > focusPt\x
        lowrightX = relMouseX
        upleftX = focusPt\x
      Else
        lowrightX = focusPt\x
        upleftX = relMouseX
      EndIf
      If relMouseY > focusPt\y
        lowrightY = relMouseY
        upleftY = focusPt\y
      Else
        lowrightY = focusPt\y
        upleftY = relMouseY
      EndIf
      
      ; mark all items within the rubber rectangle
      ; starting at the first visible
      TVItem\hItem = SendMessage_(*sender\hwnd, #TVM_GETNEXTITEM, #TVGN_FIRSTVISIBLE, 0)
      Repeat ; and looping through
        tvItemRect\left=TVItem\hItem
        SendMessage_(*sender\hwnd,#TVM_GETITEMRECT,#True,@tvItemRect)
        markit = #False
        If tvItemRect\bottom > upleftY And tvItemRect\bottom < lowrightY  And tvItemRect\right > lowrightX And tvItemRect\left < upleftX
          markit = #True
        EndIf
        If tvItemRect\top > upleftY And tvItemRect\top < lowrightY        And tvItemRect\right > lowrightX And tvItemRect\left < upleftX
          markit = #True
        EndIf
        If tvItemRect\left > upleftX And tvItemRect\left < lowrightX      And tvItemRect\bottom > upleftY And tvItemRect\top < lowrightY
          markit = #True
        EndIf
        If tvItemRect\right > upleftX And tvItemRect\right < lowrightX    And tvItemRect\bottom > upleftY And tvItemRect\top < lowrightY
          markit = #True
        EndIf
        If markit
          SwitchMarkingOn(*sender\hwnd, TVItem\hItem)
        ElseIf Not CtrlPressed
          SwitchMarkingOff(*sender\hwnd, TVItem\hItem)
        EndIf
        TVItem\hItem = SendMessage_(*sender\hwnd, #TVM_GETNEXTITEM, #TVGN_NEXTVISIBLE, TVItem\hItem) 
      Until TVItem\hItem=0
      
      RedrawWindow_(*sender\hwnd,0,0, #RDW_UPDATENOW)
      
      ; by einander, http://www.purebasic.fr/english/viewtopic.php?t=12674
      ; copy background and then draw a rubber rectangle 
      SelectObject_(hdcOrigTV,CreateImage(0,rect_TVW,rect_TVH))  ; keep background image with marked items and no rubber rectangle
      BitBlt_(hdcOrigTV,0,0,rect_TVW,rect_TVH,hdcTV,0,0,#SRCCOPY)
      
      SelectObject_(hdcTV,GetStockObject_(#NULL_BRUSH )) ; draw rubber rectangle
      Pen=ExtCreatePen_(#PS_COSMETIC| #PS_ALTERNATE,1,@lplb,0,0)
      SelectObject_(hdcTV,Pen)
      Rectangle_(hdcTV,upleftX,upleftY,lowrightX,lowrightY)
      DeleteObject_(Pen)
      
      prevMouseX=relMouseX:prevMouseY=relMouseY
    EndIf
  ElseIf mouseCapture
    ReleaseCapture_()
    mouseCapture = #False
  EndIf
  
  ProcedureReturn #Event_ReturnTrue
EndProcedure

Procedure Tree_MouseUp(*sender.PB_Sender)
  If *sender\button = #EVENT_LEFTBUTTON
    If hTVmultiSelect
      TV_MouseSel_Off()
    EndIf
  EndIf
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnDefault
EndProcedure

Procedure Tree_KeyDown(*sender.PB_Sender)
  If *sender\wParam = #VK_CONTROL
    CtrlPressed = #True
  ElseIf *sender\wParam = #VK_SHIFT
    ShiftPressed = #True
  EndIf
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnTrue
EndProcedure

Procedure Tree_KeyUp(*sender.PB_Sender)
  If *sender\wParam = #VK_CONTROL
    CtrlPressed = #False
  ElseIf *sender\wParam = #VK_SHIFT
    ShiftPressed = #False
  EndIf
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnTrue
EndProcedure

Procedure Tree_Selecting(*sender.PB_Sender)
  If Not CtrlPressed And Not ShiftPressed
    TreeItemsUnmarkAll(*sender\hwnd)
  EndIf
  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnTrue
EndProcedure

Procedure Tree_Selected(*sender.PB_Sender)
  Protected TVHitTest.TV_HITTESTINFO
  Protected ItemHandle.l
  
  If CtrlPressed
    ; get the ItemHandle
    TVHitTest\pt\x = *sender\MouseX
    TVHitTest\pt\y = *sender\MouseY
    ItemHandle = SendMessage_(*sender\hwnd, #TVM_HITTEST, 0, @TVHitTest)
    If ItemHandle
      ToggleTreeItemMark(*sender\hwnd, ItemHandle)
    EndIf
  EndIf

  PerformDefaultWinProcessing(*sender)
  ProcedureReturn #Event_ReturnTrue
EndProcedure



Enumeration
  #Window
  #Tree 
  #Str
  #Button
EndEnumeration

Procedure.l Button_Click(*sender.PB_Sender)
  SetGadgetText(#Str, "")
  SetGadgetText(#Str, GetMarkedItems(GadgetID(#Tree)))
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Define i.l

If OpenWindow(#Window, 0, 0, 330, 265, "TreeView hTVmultiSelect", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
  If CreateGadgetList(WindowID(#Window))
    TreeGadget(#Tree, 9, 12, 150, 210)
    
    For i = 1 To 10
      AddGadgetItem(#Tree, -1, "Node " + Str(i))
      AddGadgetItem(#Tree, -1, "Subnode " + Str(i) +".1", 0, 1)
      AddGadgetItem(#Tree, -1, "Subnode " + Str(i) +".2", 0, 1)
      AddGadgetItem(#Tree, -1, "Subnode " + Str(i) +".3", 0, 1)
      SetGadgetItemState(#Tree, (i - 1) * 4, #PB_Tree_Expanded)
    Next i
    
    EditorGadget(#Str, 170, 12, 150, 210)
    ButtonGadget(#Button, 115, 230, 110, 24, "show marked items") 
    
    SetEventHandler(GadgetID(#Tree), #OnItemSelected,   @Tree_Selected())
    SetEventHandler(GadgetID(#Tree), #OnItemSelecting,  @Tree_Selecting())
    SetEventHandler(GadgetID(#Tree), #OnMouseDown,      @Tree_MouseDown())
    SetEventHandler(GadgetID(#Tree), #OnMouseUp,        @Tree_MouseUp())
    SetEventHandler(GadgetID(#Tree), #OnMouseOver,      @Tree_MouseOver())
    SetEventHandler(GadgetID(#Tree), #OnKeyDown,        @Tree_KeyDown())
    SetEventHandler(GadgetID(#Tree), #OnKeyup,          @Tree_KeyUp())
    
    SetEventHandler(GadgetID(#Button), #OnButtonClick, @Button_Click())
    
    lplb\lbStyle=#BS_SOLID
    lplb\lbColor=RGB(0,100,200)
    
    hdcTV = GetDC_(GadgetID(#Tree))  
    
    Repeat: Until WaitWindowEvent() = #PB_Event_CloseWindow
    
    DeleteDC_(hdcTV)
    
  EndIf
EndIf

hope there are not too many bugs in it, but it seems to work.

[neotoma]

Wow - i now also using EasyVENT - very great job srod !

but - on thing i missing. not a big deal, but would a nice to have.
When getting the Event #OnMenuItemSelect, i would like to get also the 'text' of the Menupoint that was selected.
Background .: i will present some 'replacingtags' via Popup-Menu over a StringGadget. That works like a charm with EasyVENT. but instead remembering the Names and ids it would be easier (espacially for me... ) if i can grab the name and put that into the StringGadget.

Here a Example (modified StrgingGadgetExample), that works, but the
EventProcedure has to know the name for a id (Array).

Mike

Code: Select all

;EasyVENT demonstration program - String gadgets.
;*********************************************************************************
;DEMONSTRATES THE FOLLOWING EVENTS:
;   #OnGotFocus, #OnKeyPress, #OnContextMenuPopup
;This short demo shows how to use EasyVENT to remove the beep from a string gadget when
;hitting the return key and turns all entered characters to uppercase.
;It also shows how to remove the right-click context menu from a string gadget.
;These operations would normally require the programmer to 'subclass' the string gadget.
;*********************************************************************************


;ESSENTIAL INCLUDE.
;*********************************************************************************
XIncludeFile "EasyVENT.pbi"
;*********************************************************************************

Declare.l ActivateString(*sender.PB_Sender)
Declare.l KeyPress(*sender.PB_Sender)
Declare.l ContextMenu(*sender.PB_Sender)

Declare.l OnPopupSelect(*sender.PB_Sender)

Define Event.l, text$

Define pop.l

Enumeration
  #POP_REP_1 = 1
  #POP_REP_2
  #POP_REP_3
  #POP_REP_4
  #POP_REP_5
  #POP_REP_6
  #POP_REP_7
EndEnumeration

Dim entries.s(8)
entries(#POP_REP_1) = "%File%"
entries(#POP_REP_2) = "%Dir%"
entries(#POP_REP_3) = "%OutputFileName%"
entries(#POP_REP_4) = "%Magermilch%"
entries(#POP_REP_5) = "Cut"
entries(#POP_REP_6) = "Copy"
entries(#POP_REP_7) = "Paste"

OpenWindow(0, 100, 100, 350, 250, "EasyVENT StringGadget demo.", #PB_Window_SystemMenu |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget| #PB_Window_ScreenCentered)

  pop.l=  CreatePopupMenu(#PB_Any)
  ;  MenuTitle("Project")     ; Sie können alle Befehle zum Erstellen eines Menüs
  MenuItem(#POP_REP_1, entries(#POP_REP_1))    ; verwenden, ganz wie bei einem normalen Menü...
  MenuItem(#POP_REP_2, entries(#POP_REP_2))
  MenuItem(#POP_REP_3, entries(#POP_REP_3))
  MenuItem(#POP_REP_4, entries(#POP_REP_4))
  MenuItem(#POP_REP_5, entries(#POP_REP_5))
  MenuItem(#POP_REP_6, entries(#POP_REP_6))
  MenuItem(#POP_REP_7, entries(#POP_REP_7))


CreateGadgetList(WindowID(0))
  TextGadget(0, 10, 10, 200, 20, "Click string gadget to clear contents!")
  StringGadget(1, 10, 50, 200, 20, "UPPER case only!")

  text$="Hit return - no beep!"+Chr(10)+Chr(13)+Chr(10)+Chr(13)
  text$+"All characters turned to uppercase!"+Chr(10)+Chr(13)+Chr(10)+Chr(13)
  text$+"No right-click context menu!"
  text$+Chr(10)+Chr(13)+Chr(10)+Chr(13)+"All without subclassing!"
  
  TextGadget(2, 10, 90, 200, 140, text$)

;Set event handlers.
  SetEventHandler(GadgetID(1), #OnGotFocus, @ActivateString())
  SetEventHandler(GadgetID(1), #OnKeyPress, @KeyPress())
  SetEventHandler(GadgetID(1), #OnContextMenuPopup, @ContextMenu())
  
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),1)
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),2)
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),3)
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),4)
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),5)
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),6)
  SetEventHandler(GadgetID(1), #OnMenuItemSelect, @OnPopupSelect(),7)
  
  

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
End


;*********************************************************************************
;                                 EVENT HANDLERS
;*********************************************************************************

;We use the activate procedure to clear the contents of the string gadget.
Procedure.l ActivateString(*sender.PB_Sender)
  If GetGadgetText(1)="UPPER case only!"
    SetGadgetText(1, "")
  EndIf
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

;The following event procedure removes the beep on hitting the return key
;and turns all entered characters to uppercase.
Procedure.l KeyPress(*sender.PB_Sender)
  Protected result
;Remove beep on pressing the return key.
  If *sender\wParam = #VK_RETURN
    result = 0 ;This ensures the character is ignored.
  Else
;Convert to upper case.
    *sender\wParam = Asc(UCase(Chr(*sender\wParam)))
    result = #PB_ProcessPureBasicEvents
  EndIf
  ProcedureReturn result
EndProcedure

;The following event procedure prevents the context menu from appearing either by right-clicking
;or using shift-f10 etc.
Procedure.l ContextMenu(*sender.PB_Sender)
  Shared pop
  DisplayPopupMenu(pop,*sender\hwnd);WindowID(0))
  ProcedureReturn 0
EndProcedure

Procedure.l OnPopupSelect(*sender.PB_Sender)
  Shared entries()
  Debug("*OnPopupSelect(*sender.PB_Sender)")
  Debug("Item nr."+Str(*sender\item))
  Debug("Item Text."+*sender\text$)
  
     SendMessage_(*sender\hwnd,#EM_REPLACESEL,0,entries(*sender\item))
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure

[srod]

Wow - i now also using EasyVENT - very great job trond !

Aye, Trond does a grand job. In this case however,...