[Module] EventHandler for VB6 style coding (draft!)

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

[Module] EventHandler for VB6 style coding (draft!)

Post by Kukulkan »

Hi,

due to some discussions about VB6 compatibility here in the Forum, I thought about a way to fulfill the VB6 developers dream of functions (procedures) for several gadget and window events. So I created a quick draft for such functionality.

It is neither a finished module nor is it free from errors and bugs. But I was interested in the idea and maybe someone takes it as a start for a better version?

Here are the rules:
* Needs a dialog created with the PB Dialog library (XML dialog).
* Gadgets have to be named. Unnamed gadgets are ignored.

EventHandler.pbi

Code: Select all

; VB6-Style EventHandler Module
; Works with PB 5.46 or newer, cross platform
EnableExplicit

DeclareModule EventHandler
  
  Structure eh_gadget
    name.s
    id.i
  EndStructure
  
  Structure eh_session
    dialogId.i
    xmlId.i
    formName.s
    List gadgets.eh_gadget()
  EndStructure
  
  Declare.i Init(formName.s, dialogId.i, xmlId.i)
  Declare.i Loop(sessionId.i, event.i)
  
EndDeclareModule

Module EventHandler
  Global NewList eh_sessions.eh_session()
  
  Procedure.s _GetEventName(event.i)
    If event.i = -1: ProcedureReturn "": EndIf
    Protected evName.s = ""
    Select event.i
      Case #PB_Event_MaximizeWindow :evName.s = "MaximizeWindow"
      Case #PB_Event_WindowDrop :evName.s = "WindowDrop"
      Case #PB_Event_Menu :evName.s = "Menu"
      Case #PB_Event_RightClick :evName.s = "RightClick"
      Case #PB_Event_LeftClick :evName.s = "LeftClick"
      Case #PB_Event_MoveWindow :evName.s = "MoveWindow"
      Case #PB_Event_MinimizeWindow :evName.s = "MinimizeWindow"
      Case #PB_Event_GadgetDrop :evName.s = "GadgetDrop"
      Case #PB_Event_Gadget :evName.s = "Gadget"
      Case #PB_Event_SizeWindow :evName.s = "SizeWindow"
      Case #PB_Event_Timer :evName.s = "Timer"
      Case #PB_Event_CloseWindow :evName.s = "CloseWindow"
      Case #PB_Event_ActivateWindow :evName.s = "ActivateWindow"
      Case #PB_Event_DeactivateWindow :evName.s = "DeactivateWindow"
      Case #PB_Event_SysTray :evName.s = "SysTray"
      Case #PB_Event_FirstCustomValue :evName.s = "FirstCustomValue"
      Case #PB_Event_LeftDoubleClick :evName.s = "LeftDoubleClick"
      Case #PB_Event_Repaint :evName.s = "Repaint"
      Case #PB_Event_None :evName.s = "None"
      Case #PB_Event_RestoreWindow :evName.s = "RestoreWindow"
      Default
        evName.s = "unknown event " + Str(event.i)
  EndSelect
  ProcedureReturn evName.s
  EndProcedure
  
  Procedure.s _GetEventTypeName(eventType.i)
    If eventType.i = -1: ProcedureReturn "": EndIf
    Protected evName.s = ""
    Select eventType.i
      Case #PB_EventType_KeyDown :evName.s = "KeyDown"
      Case #PB_EventType_MouseWheel :evName.s = "MouseWheel"
      Case #PB_EventType_PopupWindow :evName.s = "PopupWindow"
      Case #PB_EventType_FirstCustomValue :evName.s = "FirstCustomValue"
      Case #PB_EventType_LeftButtonDown :evName.s = "LeftButtonDown"
      Case #PB_EventType_DragStart :evName.s = "DragStart"
      Case #PB_EventType_StatusChange :evName.s = "StatusChange"
      Case #PB_EventType_Input :evName.s = "Input"
      Case #PB_EventType_MiddleButtonDown :evName.s = "MiddleButtonDown"
      Case #PB_EventType_RightButtonDown :evName.s = "RightButtonDown"
      Case #PB_EventType_LeftClick :evName.s = "LeftClick"
      Case #PB_EventType_LeftDoubleClick :evName.s = "LeftDoubleClick"
      Case #PB_EventType_LeftButtonUp :evName.s = "LeftButtonUp"
      Case #PB_EventType_TitleChange :evName.s = "TitleChange"
      Case #PB_EventType_MouseMove :evName.s = "MouseMove"
      Case #PB_EventType_PopupMenu :evName.s = "PopupMenu"
      Case #PB_EventType_LostFocus :evName.s = "LostFocus"
      Case #PB_EventType_SizeItem :evName.s = "SizeItem"
      Case #PB_EventType_Up :evName.s = "Up"
      Case #PB_EventType_Down :evName.s = "Down"
      Case #PB_EventType_DownloadProgress :evName.s = "DownloadProgress"
      Case #PB_EventType_RightDoubleClick :evName.s = "RightDoubleClick"
      Case #PB_EventType_RightClick :evName.s = "RightClick"
      Case #PB_EventType_Focus :evName.s = "Focus"
      Case #PB_EventType_DownloadStart :evName.s = "DownloadStart"
      Case #PB_EventType_MouseLeave :evName.s = "MouseLeave"
      Case #PB_EventType_MouseEnter :evName.s = "MouseEnter"
      Case #PB_EventType_CloseItem :evName.s = "CloseItem"
      Case #PB_EventType_ReturnKey :evName.s = "ReturnKey"
      Case #PB_EventType_KeyUp :evName.s = "KeyUp"
      Case #PB_EventType_Change :evName.s = "Change"
      Case #PB_EventType_RightButtonUp :evName.s = "RightButtonUp"
      Case #PB_EventType_DownloadEnd :evName.s = "DownloadEnd"
    EndSelect
    ProcedureReturn evName.s
  EndProcedure
  
  Procedure _ParseXMLJob(*CurrentNode, List gadgets.eh_gadget())
    If XMLNodeType(*CurrentNode) = #PB_XML_Normal
      If ExamineXMLAttributes(*CurrentNode)
        While NextXMLAttribute(*CurrentNode)
          If XMLAttributeName(*CurrentNode) = "name"
            AddElement(gadgets())
            gadgets()\name = XMLAttributeValue(*CurrentNode)
          EndIf
        Wend
      EndIf
      
      *ChildNode = ChildXMLNode(*CurrentNode)
      While *ChildNode <> 0
        _ParseXMLJob(*ChildNode, gadgets())      
        *ChildNode = NextXMLNode(*ChildNode)
      Wend        
    EndIf
  EndProcedure
  
  Procedure.i _ParseXMLGadgets(xmlId.i, dialogId.i, List gadgets.eh_gadget())
    ClearList(gadgets())
    Protected *MainNode = MainXMLNode(xmlId.i)
    If *MainNode
      _ParseXMLJob(*MainNode, gadgets())
    EndIf
    ; get all the assigned ID's
    ForEach gadgets()
      gadgets()\id = DialogGadget(dialogId.i, gadgets()\name)
    Next
  EndProcedure
  
  ; Init event handler session
  Procedure.i Init(formName.s, dialogId.i, xmlId.i)
    Protected sessionId.i = AddElement(eh_sessions())
    With eh_sessions()
      \dialogId   = dialogId.i
      \xmlId      = xmlId.i
      \formName   = formName.s
      _ParseXMLGadgets(xmlId.i, dialogId.i, \gadgets())
    EndWith
    ProcedureReturn sessionId.i
  EndProcedure
  
  Procedure.i _GetGadgetIdByName(List gadgets.eh_gadget(), gadName.s)
    ForEach gadgets()
      If gadgets()\name = gadName.s
        ProcedureReturn gadgets()\id
      EndIf
    Next
    ProcedureReturn -1
  EndProcedure
  
  Procedure.s _GetGadgetNameById(List gadgets.eh_gadget(), gadId.i)
    ForEach gadgets()
      If gadgets()\id = gadId.i
        ProcedureReturn gadgets()\name
      EndIf
    Next
    ProcedureReturn ""
  EndProcedure
  
  Procedure.s _Gadget(sessionId.i)
    Protected eventType.i = EventType()
    Protected evName.s = _GetEventTypeName(eventType.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    Protected formName.s = eh_sessions()\formName
    Protected gadName.s = _GetGadgetNameById(eh_sessions()\gadgets(), EventGadget())
   
    If formName.s <> "" And gadName.s <> "" And evName.s <> ""
      ProcedureReturn formName.s + "_" + gadName.s + "_" + evName.s  
    EndIf
  EndProcedure
  
  Procedure.s _Menu(sessionId.i)
    Debug "Menu"
  EndProcedure
  
  Procedure.s _Timer(sessionId.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    ProcedureReturn eh_sessions()\formName + "_Timer"
  EndProcedure
  
  Procedure.s _SysTray(sessionId.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    ProcedureReturn eh_sessions()\formName + "_SysTray"
  EndProcedure
  
  Procedure.s _GadgetDrop(sessionId.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    Protected gadName.s = _GetGadgetNameById(eh_sessions()\gadgets(), EventGadget())
    ProcedureReturn eh_sessions()\formName + "_" + gadName.s + "_GadgetDrop"
  EndProcedure
  
  Procedure.s _Window(sessionId.i, event.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    ProcedureReturn eh_sessions()\formName + "_" + _GetEventName(event.i)
  EndProcedure
  
  Procedure.i Loop(sessionId.i, event.i)
    Protected *callback = 0
    Protected function.s = ""
    Select event.i
      Case #PB_Event_Gadget
          function .s = _Gadget(sessionId.i)
        Case #PB_Event_Menu: 
          function .s = _Menu(sessionId.i)
        Case #PB_Event_CloseWindow, #PB_Event_ActivateWindow, #PB_Event_DeactivateWindow,
             #PB_Event_FirstCustomValue, #PB_Event_LeftClick, #PB_Event_LeftDoubleClick,
             #PB_Event_MaximizeWindow, #PB_Event_MinimizeWindow, #PB_Event_MoveWindow,
             #PB_Event_RestoreWindow, #PB_Event_RightClick,
             #PB_Event_SizeWindow, #PB_Event_WindowDrop, #PB_Event_Repaint
          function .s = _Window(sessionId.i, event.i)
        Case #PB_Event_Timer
          function .s = _Timer(sessionId.i)
        Case #PB_Event_GadgetDrop
          function .s = _GadgetDrop(sessionId.i)
        Case #PB_Event_SysTray
          function .s = _SysTray(sessionId.i)
    EndSelect
    If function.s <> ""
      *callback = GetRuntimeInteger(function.s + "()")
      If *callback <> 0
        CallFunctionFast(*callback, EventWindow(), EventGadget())
      Else
        ; Debug function.s + " not found!"
      EndIf
    EndIf
  EndProcedure
  
EndModule
Usage-Example:

Code: Select all

EnableExplicit

XIncludeFile "EventHandler.pbi"

;{ event procedures. Must be defined using the Runtime keyword!
; The functions get two parameters:
; WindowId = The ID of the window that caused the event to trigger
; GadgetId = The ID if the gadget that caused the event to trigger
; They may be set but they do not have to be! I suggest to verify them
; using IsGadget() and IsWindow() in case you can't be sure that it is
; given.
; --------------------------------------------------------------------
Runtime Procedure frmMain_btnOK_LeftClick(win.i, gadget.i)
  Debug "btnOK was clicked!"
EndProcedure

Runtime Procedure frmMain_btnCancel_LeftClick(win.i, gadget.i)
  Debug "btnCancel was clicked!"
EndProcedure

Runtime Procedure frmMain_SizeWindow(win.i, gadget.i)
  Debug "Window was resized"
EndProcedure

Runtime Procedure frmMain_strContent_Change(win.i, gadget.i)
  If IsGadget(gadget.i)
    Debug "Someone changed strContent: '" + GetGadgetText(gadget.i) + "'"
  EndIf
EndProcedure

Runtime Procedure frmMain_CloseWindow(win.i, gadget.i)
  Debug "Window was closed"
  End
EndProcedure
;} --------------------------------------------------------------------

Procedure main()
  Protected Event.i
  Protected a.s = ""
  a + "<window id='#PB_Any' name='frmMain' text='test' minwidth='400' minheight='auto' flags='#PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget'>" +
       "  <vbox expand='item:2' align='left'>"+
       "    <string name='strContent' height='50' flags='' />"+
       "    <vbox>"+
       "      <button name='btnOK' text='OK' />"+
       "      <button name='btnCancel' text='Cancel' />"+
       "    </vbox>"+
       "  </vbox>"+
       "</window>"

  CompilerIf #PB_Compiler_Unicode
    Protected xml.i = CatchXML(#PB_Any, @a, StringByteLength(a), #PB_XML_StreamStart, #PB_Unicode)
  CompilerElse
    Protected xml.i = CatchXML(#PB_Any, @a, StringByteLength(a), #PB_XML_StreamStart, #PB_Ascii)
  CompilerEndIf

  Protected d.i = CreateDialog(#PB_Any)
  
  Protected w.i = OpenXMLDialog(d.i, xml.i, "")
  
  ; init EventHandler
  Protected ehSession.i = EventHandler::Init("frmMain", d.i, xml.i)
  
  ; The program main loop
  Repeat
    Event.i = WaitWindowEvent()
    EventHandler::Loop(ehSession.i, Event.i); use EventHandler
    ; do some other stuff here
  Until Event.i = #PB_Event_CloseWindow 
EndProcedure

main()
To see the effects, resize window, click buttons and enter some text.

Would be happy about any feedback or if someone enhances the module. I doubt I will find the time to continue this. So, if it is helpful for someone, please keep us updated :-)
Last edited by Kukulkan on Wed Jan 24, 2018 12:24 pm, edited 2 times in total.
mestnyi
Addict
Addict
Posts: 995
Joined: Mon Nov 25, 2013 6:41 am

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by mestnyi »

I just slightly automated it :) to me interesting and forgive the windows you can (not xml)?

Code: Select all

; VB6-Style EventHandler Module
; Works with PB 5.46 or newer, cross platform
EnableExplicit

DeclareModule EventHandler
  
  Structure eh_gadget
    Name.s
    ID.i
  EndStructure
  
  Structure eh_session
    dialogId.i
    xmlId.i
    formName.s
    List gadgets.eh_gadget()
  EndStructure
  
  Declare.i Init(formName.s, dialogId.i, xmlId.i)
  Declare.i Loop(sessionId.i, Event.i)
  
EndDeclareModule

Module EventHandler
  Global NewList eh_sessions.eh_session()
  
  Procedure.s _GetEventName(Event.i)
    If Event.i = -1: ProcedureReturn "": EndIf
    Protected evName.s = ""
    Select Event.i
      Case #PB_Event_MaximizeWindow :evName.s = "MaximizeWindow"
      Case #PB_Event_WindowDrop :evName.s = "WindowDrop"
      Case #PB_Event_Menu :evName.s = "Menu"
      Case #PB_Event_RightClick :evName.s = "RightClick"
      Case #PB_Event_LeftClick :evName.s = "LeftClick"
      Case #PB_Event_MoveWindow :evName.s = "MoveWindow"
      Case #PB_Event_MinimizeWindow :evName.s = "MinimizeWindow"
      Case #PB_Event_GadgetDrop :evName.s = "GadgetDrop"
      Case #PB_Event_Gadget :evName.s = "Gadget"
      Case #PB_Event_SizeWindow :evName.s = "SizeWindow"
      Case #PB_Event_Timer :evName.s = "Timer"
      Case #PB_Event_CloseWindow :evName.s = "CloseWindow"
      Case #PB_Event_ActivateWindow :evName.s = "ActivateWindow"
      Case #PB_Event_DeactivateWindow :evName.s = "DeactivateWindow"
      Case #PB_Event_SysTray :evName.s = "SysTray"
      Case #PB_Event_FirstCustomValue :evName.s = "FirstCustomValue"
      Case #PB_Event_LeftDoubleClick :evName.s = "LeftDoubleClick"
      Case #PB_Event_Repaint :evName.s = "Repaint"
      Case #PB_Event_None :evName.s = "None"
      Case #PB_Event_RestoreWindow :evName.s = "RestoreWindow"
      Default
        evName.s = "unknown event " + Str(Event.i)
  EndSelect
  ProcedureReturn evName.s
  EndProcedure
  
  Procedure.s _GetEventTypeName(eventType.i)
    If eventType.i = -1: ProcedureReturn "": EndIf
    Protected evName.s = ""
    Select eventType.i
      Case #PB_EventType_KeyDown :evName.s = "KeyDown"
      Case #PB_EventType_MouseWheel :evName.s = "MouseWheel"
      Case #PB_EventType_PopupWindow :evName.s = "PopupWindow"
      Case #PB_EventType_FirstCustomValue :evName.s = "FirstCustomValue"
      Case #PB_EventType_LeftButtonDown :evName.s = "LeftButtonDown"
      Case #PB_EventType_DragStart :evName.s = "DragStart"
      Case #PB_EventType_StatusChange :evName.s = "StatusChange"
      Case #PB_EventType_Input :evName.s = "Input"
      Case #PB_EventType_MiddleButtonDown :evName.s = "MiddleButtonDown"
      Case #PB_EventType_RightButtonDown :evName.s = "RightButtonDown"
      Case #PB_EventType_LeftClick :evName.s = "LeftClick"
      Case #PB_EventType_LeftDoubleClick :evName.s = "LeftDoubleClick"
      Case #PB_EventType_LeftButtonUp :evName.s = "LeftButtonUp"
      Case #PB_EventType_TitleChange :evName.s = "TitleChange"
      Case #PB_EventType_MouseMove :evName.s = "MouseMove"
      Case #PB_EventType_PopupMenu :evName.s = "PopupMenu"
      Case #PB_EventType_LostFocus :evName.s = "LostFocus"
      Case #PB_EventType_SizeItem :evName.s = "SizeItem"
      Case #PB_EventType_Up :evName.s = "Up"
      Case #PB_EventType_Down :evName.s = "Down"
      Case #PB_EventType_DownloadProgress :evName.s = "DownloadProgress"
      Case #PB_EventType_RightDoubleClick :evName.s = "RightDoubleClick"
      Case #PB_EventType_RightClick :evName.s = "RightClick"
      Case #PB_EventType_Focus :evName.s = "Focus"
      Case #PB_EventType_DownloadStart :evName.s = "DownloadStart"
      Case #PB_EventType_MouseLeave :evName.s = "MouseLeave"
      Case #PB_EventType_MouseEnter :evName.s = "MouseEnter"
      Case #PB_EventType_CloseItem :evName.s = "CloseItem"
      Case #PB_EventType_ReturnKey :evName.s = "ReturnKey"
      Case #PB_EventType_KeyUp :evName.s = "KeyUp"
      Case #PB_EventType_Change :evName.s = "Change"
      Case #PB_EventType_RightButtonUp :evName.s = "RightButtonUp"
      Case #PB_EventType_DownloadEnd :evName.s = "DownloadEnd"
    EndSelect
    ProcedureReturn evName.s
  EndProcedure
  
  Procedure _ParseXMLJob(*CurrentNode, List gadgets.eh_gadget())
    If XMLNodeType(*CurrentNode) = #PB_XML_Normal
      If ExamineXMLAttributes(*CurrentNode)
        While NextXMLAttribute(*CurrentNode)
          If XMLAttributeName(*CurrentNode) = "name"
            AddElement(gadgets())
            gadgets()\name = XMLAttributeValue(*CurrentNode)
          EndIf
        Wend
      EndIf
      
      *ChildNode = ChildXMLNode(*CurrentNode)
      While *ChildNode <> 0
        _ParseXMLJob(*ChildNode, gadgets())      
        *ChildNode = NextXMLNode(*ChildNode)
      Wend        
    EndIf
  EndProcedure
  
  Procedure.i _ParseXMLGadgets(xmlId.i, dialogId.i, List gadgets.eh_gadget())
    ClearList(gadgets())
    Protected *MainNode = MainXMLNode(xmlId.i)
    If *MainNode
      _ParseXMLJob(*MainNode, gadgets())
    EndIf
    ; get all the assigned ID's
    ForEach gadgets()
      gadgets()\id = DialogGadget(dialogId.i, gadgets()\name)
    Next
  EndProcedure
  
  
  
  Global sessionId.i
  
  Procedure Events()
    Loop(sessionId.i, Event())
  EndProcedure
  
  
  ; Init event handler session
  Procedure.i Init(formName.s, dialogId.i, xmlId.i)
    sessionId.i = AddElement(eh_sessions())
    With eh_sessions()
      \dialogId   = dialogId.i
      \xmlId      = xmlId.i
      \formName   = formName.s
      _ParseXMLGadgets(xmlId.i, dialogId.i, \gadgets())
    EndWith
    
    BindEvent(#PB_Event_Gadget, @Events())
    BindEvent(#PB_Event_SizeWindow, @Events())
    BindEvent(#PB_Event_CloseWindow, @Events())
    
    ProcedureReturn sessionId.i
  EndProcedure
  
  Procedure.i _GetGadgetIdByName(List gadgets.eh_gadget(), gadName.s)
    ForEach gadgets()
      If gadgets()\name = gadName.s
        ProcedureReturn gadgets()\id
      EndIf
    Next
    ProcedureReturn -1
  EndProcedure
  
  Procedure.s _GetGadgetNameById(List gadgets.eh_gadget(), gadId.i)
    ForEach gadgets()
      If gadgets()\id = gadId.i
        ProcedureReturn gadgets()\name
      EndIf
    Next
    ProcedureReturn ""
  EndProcedure
  
  Procedure.s _Gadget(sessionId.i)
    Protected eventType.i = EventType()
    Protected evName.s = _GetEventTypeName(eventType.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    Protected formName.s = eh_sessions()\formName
    Protected gadName.s = _GetGadgetNameById(eh_sessions()\gadgets(), EventGadget())
   
    If formName.s <> "" And gadName.s <> "" And evName.s <> ""
      ProcedureReturn formName.s + "_" + gadName.s + "_" + evName.s  
    EndIf
  EndProcedure
  
  Procedure.s _Menu(sessionId.i)
    Debug "Menu"
  EndProcedure
  
  Procedure.s _Timer(sessionId.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    ProcedureReturn eh_sessions()\formName + "_Timer"
  EndProcedure
  
  Procedure.s _SysTray(sessionId.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    ProcedureReturn eh_sessions()\formName + "_SysTray"
  EndProcedure
  
  Procedure.s _GadgetDrop(sessionId.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    Protected gadName.s = _GetGadgetNameById(eh_sessions()\gadgets(), EventGadget())
    ProcedureReturn eh_sessions()\formName + "_" + gadName.s + "_GadgetDrop"
  EndProcedure
  
  Procedure.s _Window(sessionId.i, Event.i)
    ChangeCurrentElement(eh_sessions(), sessionId.i)
    ProcedureReturn eh_sessions()\formName + "_" + _GetEventName(Event.i)
  EndProcedure
  
  Procedure.i Loop(sessionId.i, Event.i)
    Protected *callback = 0
    Protected function.s = ""
    Select Event.i
      Case #PB_Event_Gadget
          function .s = _Gadget(sessionId.i)
        Case #PB_Event_Menu: 
          function .s = _Menu(sessionId.i)
        Case #PB_Event_CloseWindow, #PB_Event_ActivateWindow, #PB_Event_DeactivateWindow,
             #PB_Event_FirstCustomValue, #PB_Event_LeftClick, #PB_Event_LeftDoubleClick,
             #PB_Event_MaximizeWindow, #PB_Event_MinimizeWindow, #PB_Event_MoveWindow,
             #PB_Event_RestoreWindow, #PB_Event_RightClick,
             #PB_Event_SizeWindow, #PB_Event_WindowDrop, #PB_Event_Repaint
          function .s = _Window(sessionId.i, Event.i)
        Case #PB_Event_Timer
          function .s = _Timer(sessionId.i)
        Case #PB_Event_GadgetDrop
          function .s = _GadgetDrop(sessionId.i)
        Case #PB_Event_SysTray
          function .s = _SysTray(sessionId.i)
    EndSelect
    If function.s <> ""
      *callback = GetRuntimeInteger(function.s + "()")
      If *callback <> 0
        CallFunctionFast(*callback, EventWindow(), EventGadget())
      Else
        ; Debug function.s + " not found!"
      EndIf
    EndIf
  EndProcedure
  
EndModule


; Usage-Example:
; Code:
EnableExplicit

; XIncludeFile "EventHandler.pbi"

;{ event procedures. Must be defined using the Runtime keyword!
; The functions get two parameters:
; WindowId = The ID of the window that caused the event to trigger
; GadgetId = The ID if the gadget that caused the event to trigger
; They may be set but they do not have to be! I suggest to verify them
; using IsGadget() and IsWindow() in case you can't be sure that it is
; given.
; --------------------------------------------------------------------
Runtime Procedure frmMain_btnOK_LeftClick()
  Debug "btnOK was clicked!"
EndProcedure

Runtime Procedure frmMain_btnCancel_LeftClick()
  Debug "btnCancel was clicked!"
EndProcedure

Runtime Procedure frmMain_SizeWindow()
  Debug "Window was resized"
EndProcedure

Runtime Procedure frmMain_strContent_Change(win.i, Gadget.i)
  If IsGadget(Gadget.i)
    Debug "Someone changed strContent: '" + GetGadgetText(Gadget.i) + "'"
  EndIf
EndProcedure

Runtime Procedure frmMain_CloseWindow()
  Debug "Window was closed"
  End
EndProcedure
;} --------------------------------------------------------------------

Procedure main()
  Protected Event.i
  Protected a.s = ""
  a + "<window id='#PB_Any' name='frmMain' text='test' minwidth='400' minheight='auto' flags='#PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget'>" +
       "  <vbox expand='item:2' align='left'>"+
       "    <string name='strContent' height='50' flags='' />"+
       "    <vbox>"+
       "      <button name='btnOK' text='OK' />"+
       "      <button name='btnCancel' text='Cancel' />"+
       "    </vbox>"+
       "  </vbox>"+
       "</window>"
  
  Protected xml.i = CatchXML(#PB_Any, @a, StringByteLength(a, #PB_Unicode), #PB_XML_StreamStart, #PB_Unicode)

  Protected d.i = CreateDialog(#PB_Any)
  
  Protected w.i = OpenXMLDialog(d.i, xml.i, "")
  
  ; init EventHandler
  Protected ehSession.i = EventHandler::Init("frmMain", d.i, xml.i)
  
  ; The program main loop
  Repeat
    Event.i = WaitWindowEvent()
    ; EventHandler::Loop(ehSession.i, Event.i); use EventHandler
    ; do some other stuff here
  Until Event.i = #PB_Event_CloseWindow 
EndProcedure

main()
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Kwai chang caine »

Thanks for sharing KUKULCAN 8)

But i have an error at the line "EndProcedure" (W7 X86) (v5.61 X86) :|

Code: Select all

Runtime Procedure frmMain_SizeWindow()
  Debug "Window was resized"
EndProcedure
And in the code of MESTNYI at the line "EndProcedure" too, when i click on the "OK" or "Cancel" button :|

Code: Select all

Runtime Procedure frmMain_btnOK_LeftClick()
  Debug "btnOK was clicked!"
EndProcedure
ImageThe happiness is a road...
Not a destination
User avatar
Shardik
Addict
Addict
Posts: 1989
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Shardik »

Kwai chang caine wrote:But i have an error at the line "EndProcedure" (W7 X86) (v5.61 X86) :|
I can confirm Kwai chang caine' s errors on Windows XP SP3 and Windows 8.1 x64 when using PB 5.46 x86 in Unicode mode or PB 5.61 x86. In order to run the code successfully you currently have to use a PB 64-bit compiler (tested successfully with 5.46 x64 and PB 5.61 x64). Unfortunately the current code doesn't run with PB's 32 bit compilers. And it doesn't run with PB 5.46 x64 in ASCII mode.
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Kukulkan »

Strange,

I just updated the usage example in my first post to work with both ASCII and UNICODE compilation (CatchXML() was the reason for the problem). This should be no problem now.

I tried on Linux with PB 5.46 LTS in 64 Bit and it works both Unicode and ASCII. In Windows it crashes for any 32 Bit version. I think it is a bug. I will do a report.
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Kukulkan »

No, it wasn't a bug. I missed the correct number of parameters in the Runtime callbacks in the test code. I just fixed the first post. Now it works on both Unicode and ASCII and 32 and 64 bit. Also tested on Windows and Linux.

Sorry for the issues.
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Kukulkan »

I just checked the changes posted by mestnyi but I don't like them. He is making some global sessionId.i variable which blasts away the benefits of the idea of the session at all. With my module, you can create multiple sessions using EventHandler::Init() and use them in parallel (for multiple windows). By his changes, it no longer works like this. But hey, everybody can use it the way he likes to.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Kwai chang caine »

Thanks a lot KUKULCAN for have fix the problem, that's works great now 8)

Like several here, i'm an old user of this good VB6, before PB, and it's always a pleasure to see someone of him in PB code 8)
A little bit like the splendid COMATE of SROD, it's always nice to see the code or behavior, hidden behind the mysterious VB events or other :shock:
Translate in PB, it's the best way to see, MICROSOFT never do simply the things, it's always a real factory, all what MICROSOFT invents :|

Again thanks for sharing this great code 8)
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by mk-soft »

I have found another way to bind gadget event over runtime names. :wink:
But only gadget without '#PB_Any'

For this I use then name of gadget constant with prefix 'DoEvent' for runtime procedures.

Sorry, not for xml :(

Code: Select all

;-TOP

; Event Manager
; by mk-soft
; Version v0.02
; Create 30.01.2018

; ***************************************************************************************

EnableExplicit

DeclareModule EventManager
  
  Declare CreateGadget(type, name.s, gadget, x, y, dx, dy, text.s, param1, param2, param3, flags)
  Declare DoGadgetEvents()
    
EndDeclareModule

Module EventManager
  
  Global Dim GadgetEvents.s(10)
  
  Procedure CreateGadget(type, name.s, gadget, x, y, dx, dy, text.s, param1, param2, param3, flags)
    Protected result
    
    Select type
      Case #PB_GadgetType_Button : result = ButtonGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_ButtonImage : result = ButtonImageGadget(gadget, x, y, dx, dy, param1, flags)
      Case #PB_GadgetType_Calendar : result = CalendarGadget(gadget, x, y, dx, dy, param1, flags)
      Case #PB_GadgetType_Canvas : result = CanvasGadget(gadget, x, y, dx, dy, flags)
      Case #PB_GadgetType_CheckBox : result = CheckBoxGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_ComboBox : result = ComboBoxGadget(gadget, x, y, dx, dy, flags)
      Case #PB_GadgetType_Container : result = ContainerGadget(gadget, x, y, dx, dy, flags)
      Case #PB_GadgetType_Date : result = DateGadget(gadget, x, y, dx, dy, text, param1, flags)
      Case #PB_GadgetType_Editor : result = EditorGadget(gadget, x, y, dx, dy, flags)
      Case #PB_GadgetType_ExplorerCombo : result = ExplorerComboGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_ExplorerList : result = ExplorerListGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_ExplorerTree : result = ExplorerTreeGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_Frame : result = FrameGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_HyperLink : result = HyperLinkGadget(gadget, x, y, dx, dy, text, param1, flags)
      Case #PB_GadgetType_Image : result = ImageGadget(gadget, x, y, dx, dy, param1, flags)
      Case #PB_GadgetType_IPAddress : result = IPAddressGadget(gadget, x, y, dx, dy)
      Case #PB_GadgetType_ListIcon : result = ListIconGadget(gadget, x, y, dx, dy, text, param1, flags)
      Case #PB_GadgetType_ListView : result = ListViewGadget(gadget, x, y, dx, dy, flags)
        CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        Case #PB_GadgetType_MDI : result = MDIGadget(gadget, x, y, dx, dy, param1, param2, flags)
        CompilerEndIf
      Case #PB_GadgetType_Option : result = OptionGadget(gadget, x, y, dx, dy, text)
      Case #PB_GadgetType_Panel : result = PanelGadget(gadget, x, y, dx, dy)
      Case #PB_GadgetType_ProgressBar : result = ProgressBarGadget(gadget, x, y, dx, dy, param1, param2, flags)
      Case #PB_GadgetType_Scintilla : result = ScintillaGadget(gadget, x, y, dx, dy, param1)
      Case #PB_GadgetType_ScrollArea : result = ScrollAreaGadget(gadget, x, y, dx, dy, param1, param2, param3, flags)
      Case #PB_GadgetType_ScrollBar : result = ScrollBarGadget(gadget, x, y, dx, dy, param1, param2, param3, flags)
      Case #PB_GadgetType_Shortcut : result = ShortcutGadget(gadget, x, y, dx, dy, param1)
      Case #PB_GadgetType_Spin : result = SpinGadget(gadget, x, y, dx, dy, param1, param2, flags)
      Case #PB_GadgetType_Splitter : result = SplitterGadget(gadget, x, y, dx, dy, param1, param2, flags)
      Case #PB_GadgetType_String : result = StringGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_Text : result = TextGadget(gadget, x, y, dx, dy, text, flags)
      Case #PB_GadgetType_TrackBar : result = TrackBarGadget(gadget, x, y, dx, dy, param1, param2, flags)
      Case #PB_GadgetType_Tree : result = TreeGadget(gadget, x, y, dx, dy, flags)
      Case #PB_GadgetType_Web : result = WebGadget(gadget, x, y, dx, dy, text)
    EndSelect
    
    If result = 0
      ProcedureReturn 0
    EndIf
    
    If gadget <> #PB_Any
      If gadget > ArraySize(GadgetEvents())
        ReDim GadgetEvents(gadget + 20)
      EndIf
      GadgetEvents(gadget) = ReplaceString(name, "#", "DoEvent") + "()"
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  Prototype ProtoDoEvent()
  
  Procedure DoGadgetEvents()
    Protected gadget, *DoEvent.ProtoDoEvent
    gadget = EventGadget()
    If gadget >= 0 And gadget <= ArraySize(GadgetEvents())
      If Bool(GadgetEvents(gadget))
        *DoEvent = GetRuntimeInteger(GadgetEvents(gadget))
        If *DoEvent
          *DoEvent()
        EndIf
      EndIf
    EndIf
  EndProcedure
  
EndModule

; ---------------------------------------------------------------------------------------

DeclareModule EventMacros
  
  ; Macros
  Macro dq
    "
  EndMacro
  
  Macro ButtonGadget(Gadget, x, y, dx, dy, text, Flags = 0)
    CreateGadget(#PB_GadgetType_Button, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags)
  EndMacro
  
  Macro ButtonImageGadget(Gadget, x, y, dx, dy, ImageID, Flags = 0)
    CreateGadget(#PB_GadgetType_ButtonImage, dq#Gadget#dq, Gadget, x, y, dx, dy, "", ImageID, 0, 0, Flags)
  EndMacro
  
  Macro CalendarGadget(gadget, x, y, dx, dy, Date, Flags = 0)
    CreateGadget(#PB_GadgetType_Calendar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Date, 0, 0, Flags)
  EndMacro
  
  Macro CanvasGadget(gadget, x, y, dx, dy, Flags = 0)
    CreateGadget(#PB_GadgetType_Canvas, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro CheckBoxGadget(gadget, x, y, dx, dy, text, Flags = 0)
    CreateGadget(#PB_GadgetType_CheckBox, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags)
  EndMacro
  
  Macro ComboBoxGadget(gadget, x, y, dx, dy, Flags = 0)
    CreateGadget(#PB_GadgetType_ComboBox, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro ContainerGadget(gadget, x, y, dx, dy, Flags = 0)
    CreateGadget(#PB_GadgetType_Container, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro DateGadget(gadget, x, y, dx, dy, Mask, Date, Flags = 0)
    CreateGadget(#PB_GadgetType_Date, dq#Gadget#dq, Gadget, x, y, dx, dy, Mask, Date, 0, 0, Flags)
  EndMacro
  
  Macro EditorGadget(gadget, x, y, dx, dy, Flags = 0)
    CreateGadget(#PB_GadgetType_Editor, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro ExplorerComboGadget(gadget, x, y, dx, dy, Directory, Flags = 0)
    CreateGadget(#PB_GadgetType_ExplorerCombo, dq#Gadget#dq, Gadget, x, y, dx, dy, Directory, 0, 0, 0, Flags)
  EndMacro
  
  Macro ExplorerListGadget(gadget, x, y, dx, dy, Directory, Flags = 0)
    CreateGadget(#PB_GadgetType_ExplorerList, dq#Gadget#dq, Gadget, x, y, dx, dy, Directory, 0, 0, 0, Flags)
  EndMacro
  
  Macro ExplorerTreeGadget(gadget, x, y, dx, dy, Directory, Flags = 0)
    CreateGadget(#PB_GadgetType_ExplorerTree, dq#Gadget#dq, Gadget, x, y, dx, dy, Directory, 0, 0, 0, Flags)
  EndMacro
  
  Macro FrameGadget(gadget, x, y, dx, dy, text, Flags = 0)
    CreateGadget(#PB_GadgetType_Frame, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags)
  EndMacro
  
  Macro HyperLinkGadget(gadget, x, y, dx, dy, text, Color, Flags = 0)
    CreateGadget(#PB_GadgetType_HyperLink, dq#Gadget#dq, Gadget, x, y, dx, dy, text, Color, 0, 0, Flags)
  EndMacro
  
  Macro ImageGadget(gadget, x, y, dx, dy, ImageID, Flags = 0)
    CreateGadget(#PB_GadgetType_Image, dq#Gadget#dq, Gadget, x, y, dx, dy, "", ImageID, 0, 0, Flags)
  EndMacro
  
  Macro IPAddressGadget(gadget, x, y, dx, dy)
    CreateGadget(#PB_GadgetType_IPAddress, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro ListIconGadget(gadget, x, y, dx, dy, Titel, TitelWidth, Flags = 0)
    CreateGadget(#PB_GadgetType_ListIcon, dq#Gadget#dq, Gadget, x, y, dx, dy, Titel, TitelWidth, 0, 0, Flags)
  EndMacro
  
  Macro ListViewGadget(gadget, x, y, dx, dy, Flags = 0)
    CreateGadget(#PB_GadgetType_ListView, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Macro MDIGadget(gadget, x, y, dx, dy, SubMenu, FirstMenuItem, Flags = 0)
      CreateGadget(#PB_GadgetType_MDI, dq#Gadget#dq, Gadget, x, y, dx, dy, "", SubMenu, FirstMenuItem, 0, Flags)
    EndMacro
  CompilerEndIf
  
  Macro OptionGadget(gadget, x, y, dx, dy, text)
    CreateGadget(#PB_GadgetType_Option, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags)
  EndMacro
  
  Macro PanelGadget(gadget, x, y, dx, dy)
    CreateGadget(#PB_GadgetType_Panel, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro ProgressBarGadget(gadget, x, y, dx, dy, Minimum, Maximum, Flags = 0)
    CreateGadget(#PB_GadgetType_ProgressBar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Minimum, Maximum, 0, Flags)
  EndMacro
  
  Macro ScintillaGadget(gadget, x, y, dx, dy, Callback)
    CreateGadget(#PB_GadgetType_Scintilla, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Callback, 0, 0, Flags)
  EndMacro
  
  Macro ScrollAreaGadget(gadget, x, y, dx, dy, param1, param2, param3, Flags = 0)
    CreateGadget(#PB_GadgetType_ScrollArea, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, param3, Flags)
  EndMacro
  
  Macro ScrollBarGadget(gadget, x, y, dx, dy, param1, param2, param3, Flags = 0)
    CreateGadget(#PB_GadgetType_ScrollBar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, parma2, param3, Flags)
  EndMacro
  
  Macro ShortcutGadget(gadget, x, y, dx, dy, Shortcut)
    CreateGadget(#PB_GadgetType_Shortcut, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Shortcut, 0, 0, Flags)
  EndMacro
  
  Macro SpinGadget(gadget, x, y, dx, dy, param1, param2, Flags = 0)
    CreateGadget(#PB_GadgetType_Spin, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, 0, Flags)
  EndMacro
  
  Macro SplitterGadget(gadget, x, y, dx, dy, param1, param2, Flags = 0)
    CreateGadget(#PB_GadgetType_Splitter, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, 0, Flags)
  EndMacro
  
  Macro StringGadget(gadget, x, y, dx, dy, text, Flags = 0)
    CreateGadget(#PB_GadgetType_String, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags)
  EndMacro
  
  Macro TextGadget(gadget, x, y, dx, dy, text, Flags = 0)
    CreateGadget(#PB_GadgetType_Text, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags)
  EndMacro
  
  Macro TrackBarGadget(gadget, x, y, dx, dy, param1, param2, Flags = 0)
    CreateGadget(#PB_GadgetType_TrackBar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, 0, Flags)
  EndMacro
  
  Macro TreeGadget(gadget, x, y, dx, dy, Flags = 0)
    CreateGadget(#PB_GadgetType_Tree, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags)
  EndMacro
  
  Macro WebGadget(gadget, x, y, dx, dy, url)
    CreateGadget(#PB_GadgetType_Web, dq#Gadget#dq, Gadget, x, y, dx, dy, url, 0, 0, 0, 0)
  EndMacro
  
EndDeclareModule

Module EventMacros
  
EndModule

; ***************************************************************************************

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration FormWindow
    #Main
  EndEnumeration
  
  Enumeration FormGadget
    #Editor
    #ButtonB0
    #ButtonB1
    #ButtonB2
    #Frame
  EndEnumeration
  
  UseModule EventManager
  UseModule EventMacros
  
  Procedure OpenMain(x = 0, y = 0, width = 550, height = 400)
    OpenWindow(#Main, x, y, width, height, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
    EditorGadget(#Editor, 10, 10, 530, 310)
    ButtonGadget(#ButtonB0, 20, 340, 160, 40, "B0")
    ButtonGadget(#ButtonB1, 190, 340, 170, 40, "B1")
    ButtonGadget(#ButtonB2, 370, 340, 160, 40, "B2")
    FrameGadget(#Frame, 10, 330, 530, 60, "")
  EndProcedure
  
  OpenMain()
  
  BindEvent(#PB_Event_Gadget, @DoGadgetEvents())
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
  
  End
  
  ; DoEvents Procedures
  Runtime Procedure DoeventEditor()
    Select EventType()
      Case #PB_EventType_Focus
        Debug "Editor Event Fosus"
      Case #PB_EventType_LostFocus
        Debug "Editor Event LostFosus"
      Case #PB_EventType_Change
        Debug "Editor Event Change"
    EndSelect
  EndProcedure
  
  Runtime Procedure DoEventButtonB0()
    Select EventType()
      Case #PB_EventType_LeftClick
        Debug "Event Button B0"
    EndSelect
  EndProcedure
  
  Runtime Procedure DoEventButtonB1()
    Select EventType()
      Case #PB_EventType_LeftClick
        Debug "Event Button B1"
    EndSelect
  EndProcedure
  
  Runtime Procedure DoEventButtonB2()
    Select EventType()
      Case #PB_EventType_LeftClick
        Debug "Event Button B2"
    EndSelect
  EndProcedure
  
CompilerEndIf
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
VB6_to_PBx
Enthusiast
Enthusiast
Posts: 617
Joined: Mon May 09, 2011 9:36 am

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by VB6_to_PBx »

would it be possible to add these Events to all Gadgets

MouseEnter
MouseLeave

???
 
PureBasic .... making tiny electrons do what you want !

"With every mistake we must surely be learning" - George Harrison
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by mk-soft »

Not perfect for Purebasic Owner draw Gadget

Link : http://www.purebasic.fr/english/viewtop ... 12&t=64151

I can reduce this module
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kukulkan
Addict
Addict
Posts: 1352
Joined: Mon Jun 06, 2005 2:35 pm
Location: germany
Contact:

Re: [Module] EventHandler for VB6 style coding (draft!)

Post by Kukulkan »

mk-soft wrote:Not perfect for Purebasic Owner draw Gadget
My code (first post) works fine even with owner drawn gadgets (using CanvasGadget or ImageGadget etc). It also works with multiple windows (forms) at the same time given that every window is using it's own XML and it's own session from my module.
VB6_to_PBx wrote:would it be possible to add these Events to all Gadgets MouseEnter MouseLeave
My code (first post) fires these events for all gadgets of PB that support that event.
Post Reply