Runtime Event Manager

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Runtime Event Manager

Beitrag von mk-soft »

Hi,
hatte mal wieder Lust mit Purebasic an etwas neues zu basteln. :wink:

Rausgekommen ist ein EventManager mit der Verwendung der Runtime-Library.
Der Trick ist das die PB-Funktionen zur Erstellung von Windows, Gadgets und Menüs über Macros umgeleitet werden.
Somit kann mit den Standardbefehlen noch weitere Verarbeitungen und Zuweisungen durchführen.

Der EventManger funktioniert nur mit Konstanten für Window, Gadgets und Menus (Enumeration).
Aus diesen wird der Name der Event-Procedure generiert und mit der Runtime-Funktion GetRuntimeInteger(...) dem Menu oder dem Gadget zugewiesen.

Die Prozeduren für die Events müssen folgenden Aufbau haben:
Runtime Procedure EventMenu_[Konstante]()
Debug "Menu Event"
EndProcedure

Runtime Procedure EventGadget_[Konstante]()
Select EventType()
Case #PB_EventType_LeftClick
Debug "Gadget Event "
EndSelect
EndProcedure

Runtime Procedure EventCloseWindow_[Konstante]()
Debug "Event Close Window"
EndProcedure

Runtime Procedure EventSizeWindow_[Konstante]()
Debug "Event Size Window"
EndProcedure

Runtime Procedure Event[xxx]Window_[Konstante]()
Debug "Event xxx Window"
EndProcedure

Natürlich ohne die Raute (#) der Konstante

Das kann man auch noch mit eigene Daten erweitern . z.B. Verschiedene sprachen pflegen.

Update v0.04
- Mac Menüs hinzugefügt

Update v0.05
- Code optimiert
- Runtime Prefix Namen geändert
- Debugging hinzufügt. DebugLevel 2

Update v0.07
- Window Events hinzugefügt

Update v0.08
- Code optimiert

Update v0.09
- Geändert: Intern von Arrays auf Maps umgestellt
- Code optimiert

Update v0.10
- CloseWindow und FreeGadget umgeleitet um Speicher aufzuräumen

RuntimeEventManager.pb

Code: Alles auswählen

;-TOP

; Runtime Event Manager
; Author : mk-soft
; Version: v0.11
; Create : 30.01.2018
; Update : 31.07.2018
; OS     : All

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

EnableExplicit

DebugLevel 2 ; Debugging with GUI-Event
DebugLevel 3 ; Debugging with GUI-Event and Destroy-Event

DeclareModule EventManager
  
  Declare CreateWindow(Name.s, Window, x, y, InnerWidth, InnerHeight, Title.s, Flags, ParentID)
  Declare CreateMenuItem(Name.s, MenuItem, Text.s, ImageID)
  Declare CreateGadget(Type, Name.s, Gadget, x, y, dx, dy, Text.s, Param1, Param2, Param3, Flags)
  
  Declare DestroyWindow(Window)
  Declare DestroyGadget(Gadget)
  
  Declare DoOpenGadgetList(Gadget , Item = -1)
  Declare DoCloseGadgetList()
  
  Declare ParentWindow(Gadget)
  Declare ParentGadget(Gadget)
  
EndDeclareModule

Module EventManager
  
  EnableExplicit
  
  Prototype ProtoDoEvent()
  
  #EventClearGadgetList = $7FFFEEEE
  
  Structure udtWindowList
    Name.s
    Window.i
    DoEventCloseWindow.ProtoDoEvent
    DoEventSizeWindow.ProtoDoEvent
    DoEventActivateWindow.ProtoDoEvent
    DoEventDeactivateWindow.ProtoDoEvent
    DoEventMoveWindow.ProtoDoEvent
    DoEventMaximizeWindow.ProtoDoEvent
    DoEventMinimizeWindow.ProtoDoEvent
    DoEventRestoreWindow.ProtoDoEvent
    DoEventRepaintWindow.ProtoDoEvent
    ; Data for extended functions, e. g. languages
    ; *Data
  EndStructure
  
  Structure udtGadgetList
    Name.s
    Gadget.i
    DoEvent.ProtoDoEvent
    ; Data for extended functions, e. g. languages
    ; *Data
    ParentWindow.i
    ParentGadget.i
  EndStructure
  
  Structure udtMenuList
    Name.s
    MenuItem.i
    DoEvent.ProtoDoEvent
    ; Data for extended functions, e. g. languages
    ; *Data
  EndStructure
  
  Global NewMap WindowList.udtWindowList()
  Global NewMap GadgetList.udtGadgetList()
  Global NewMap MenuList.udtMenuList()
  
  ; Parent Object Variable
  Global ParentWindow = -1
  Global ParentGadget = -1
  Global NewList ParentGadgetStack()
  
  ; -----------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_Debugger
    Procedure.s EventTypeName(EventType)
      Protected name.s
      Select EventType
          ; Standard
        Case #PB_EventType_LeftClick        : name = "#PB_EventType_LeftClick"
        Case #PB_EventType_RightClick       : name = "#PB_EventType_RightClick"
        Case #PB_EventType_LeftDoubleClick  : name = "#PB_EventType_LeftDoubleClick"
        Case #PB_EventType_RightDoubleClick : name = "#PB_EventType_RightDoubleClick"
        Case #PB_EventType_Focus            : name = "#PB_EventType_Focus"
        Case #PB_EventType_LostFocus        : name = "#PB_EventType_LostFocus"
        Case #PB_EventType_Change           : name = "#PB_EventType_Change"
        Case #PB_EventType_DragStart        : name = "#PB_EventType_DragStart"
          ; Canvas
        Case #PB_EventType_MouseEnter       : name = "#PB_EventType_MouseEnter"
        Case #PB_EventType_MouseLeave       : name = "#PB_EventType_MouseLeave"
        Case #PB_EventType_MouseMove        : name = "#PB_EventType_MouseMove"
        Case #PB_EventType_MouseWheel       : name = "#PB_EventType_MouseWheel"
        Case #PB_EventType_LeftButtonDown   : name = "#PB_EventType_LeftButtonDown"
        Case #PB_EventType_LeftButtonUp     : name = "#PB_EventType_LeftButtonUp"
        Case #PB_EventType_RightButtonDown  : name = "#PB_EventType_RightButtonDown"
        Case #PB_EventType_RightButtonUp    : name = "#PB_EventType_RightButtonUp"
        Case #PB_EventType_MiddleButtonDown : name = "#PB_EventType_MiddleButtonDown"
        Case #PB_EventType_MiddleButtonUp   : name = "#PB_EventType_MiddleButtonUp"
        Case #PB_EventType_KeyDown          : name = "#PB_EventType_KeyDown"
        Case #PB_EventType_KeyUp            : name = "#PB_EventType_KeyUp"
        Case #PB_EventType_Input            : name = "#PB_EventType_Input"
        Case #PB_EventType_Resize           : name = "#PB_EventType_Resize"
        Default                             : name = "#PB_EventType_Unkown " + EventType
      EndSelect
      ProcedureReturn name
    EndProcedure
    
    Procedure.s EventName(Event)
      Protected name.s
      Select Event
        Case #PB_Event_Menu             : name = "#PB_Event_Menu"
        Case #PB_Event_Gadget           : name = "#PB_Event_Gadget"
        Case #PB_Event_SysTray          : name = "#PB_Event_SysTray"
        Case #PB_Event_Timer            : name = "#PB_Event_Timer"
        Case #PB_Event_CloseWindow      : name = "#PB_Event_CloseWindow"
        Case #PB_Event_Repaint          : name = "#PB_Event_Repaint"
        Case #PB_Event_SizeWindow       : name = "#PB_Event_SizeWindow"
        Case #PB_Event_MoveWindow       : name = "#PB_Event_MoveWindow"
        Case #PB_Event_MinimizeWindow   : name = "#PB_Event_MinimizeWindow"
        Case #PB_Event_MaximizeWindow   : name = "#PB_Event_MaximizeWindow"
        Case #PB_Event_RestoreWindow    : name = "#PB_Event_RestoreWindow"
        Case #PB_Event_ActivateWindow   : name = "#PB_Event_ActivateWindow"
        Case #PB_Event_DeactivateWindow : name = "#PB_Event_DeactivateWindow"
        Case #PB_Event_WindowDrop       : name = "#PB_Event_WindowDrop"
        Case #PB_Event_GadgetDrop       : name = "#PB_Event_GadgetDrop"
        Case #PB_Event_RightClick       : name = "#PB_Event_RightClick"
        Case #PB_Event_LeftClick        : name = "#PB_Event_LeftClick"
        Case #PB_Event_LeftDoubleClick  : name = "#PB_Event_LeftDoubleClick"
        Default                         : name = "#PB_Event_Unkown " + Event
      EndSelect
      ProcedureReturn name
    EndProcedure
    
  CompilerEndIf
  
  ; -----------------------------------------------------------------------------------
  
  Procedure CreateWindow(Name.s, Window, x, y, InnerWidth, InnerHeight, Title.s, Flags, ParentID)
    Protected result, const.s, rt.s
    result = OpenWindow(Window, x, y, InnerWidth, InnerHeight, Title.s, Flags, ParentID)
    If result = 0
      ProcedureReturn 0
    EndIf
    
    If Window <> #PB_Any
      AddMapElement(WindowList(), Hex(Window))
      const = Mid(name, 2)
      WindowList()\Name = const
      WindowList()\Window = Window
      rt = "EventCloseWindow_" + const + "()" : WindowList()\DoEventCloseWindow = GetRuntimeInteger(rt)
      rt = "EventSizeWindow_" + const + "()" : WindowList()\DoEventSizeWindow = GetRuntimeInteger(rt)
      rt = "EventActivateWindow_" + const + "()" : WindowList()\DoEventActivateWindow = GetRuntimeInteger(rt)
      rt = "EventDeactivateWindow_" + const + "()" : WindowList()\DoEventDeactivateWindow = GetRuntimeInteger(rt)
      rt = "EventMoveWindow_" + const + "()" : WindowList()\DoEventMoveWindow = GetRuntimeInteger(rt)
      rt = "EventMaximizeWindow_" + const + "()" : WindowList()\DoEventMaximizeWindow = GetRuntimeInteger(rt)
      rt = "EventMinimizeWindow_" + const + "()" : WindowList()\DoEventMinimizeWindow = GetRuntimeInteger(rt)
      rt = "EventRestoreWindow_" + const + "()" : WindowList()\DoEventRestoreWindow = GetRuntimeInteger(rt)
      rt = "EventRepaintWindow_" + const + "()" : WindowList()\DoEventRepaintWindow = GetRuntimeInteger(rt)
      ;
      ParentWindow = Window
      ;
    Else
      AddMapElement(WindowList(), Hex(result))
      WindowList()\Window = result
      ;
      ParentWindow = result
      ;
    EndIf
    
    ; Here more data
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure CreateGadget(GadgetType, Name.s, Gadget, x, y, dx, dy, Text.s, Param1, Param2, Param3, Flags)
    Protected result, const.s, rt.s
    Protected parent
    Select GadgetType
      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
      AddMapElement(GadgetList(), Hex(Gadget))
      const = Mid(Name, 2)
      GadgetList()\Name = const
      GadgetList()\Gadget = Gadget
      rt = "EventGadget_" + const + "()" : GadgetList()\DoEvent = GetRuntimeInteger(rt)
    Else
      AddMapElement(GadgetList(), Hex(result))
    EndIf
    
    ; Here more data
    GadgetList()\ParentWindow = ParentWindow
    Select GadgetType
      Case #PB_GadgetType_Container, #PB_GadgetType_Panel, #PB_GadgetType_ScrollArea
        GadgetList()\ParentGadget = ParentGadget
        If Gadget <> #PB_Any
          ParentGadget = Gadget
          AddElement(ParentGadgetStack())
          ParentGadgetStack() = Gadget
        Else
          ParentGadget = result
          AddElement(ParentGadgetStack())
          ParentGadgetStack() = result
        EndIf
      Default
        GadgetList()\ParentGadget = ParentGadget
    EndSelect
      
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure CreateMenuItem(Name.s, MenuItem, Text.s, ImageID)
    Protected const.s, rt.s
    MenuItem(MenuItem, Text, ImageID)
    AddMapElement(MenuList(), Hex(MenuItem))
    If MenuItem >= 0
      const = Mid(Name, 2)
      MenuList()\Name = const
      MenuList()\MenuItem = MenuItem
      rt = "EventMenu_" + const + "()" : MenuList()\DoEvent = GetRuntimeInteger(rt)
    Else
      ; Mac Menu´s
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        Select MenuItem
          Case #PB_Menu_About
            MenuList()\Name = "MacAbout"
            MenuList()\DoEvent = GetRuntimeInteger("EventMenu_MacAbout()")
          Case #PB_Menu_Preferences
            MenuList()\Name = "MacPreferences"
            MenuList()\DoEvent = GetRuntimeInteger("EventMenu_MacPreferences()")
          Case #PB_Menu_Quit
            MenuList()\Name = "MacQuit"
            MenuList()\DoEvent = GetRuntimeInteger("EventMenu_MacQuit()")
        EndSelect
      CompilerEndIf
    EndIf
    ; Here more data
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure ClearGadgetList()
    ForEach GadgetList()
      If Not IsGadget(GadgetList()\Gadget)
        CompilerIf #PB_Compiler_Debugger
          Debug "GUI : Destroy Gadget " + GadgetList()\Name, 3
        CompilerEndIf
        DeleteMapElement(GadgetList())
      EndIf
    Next
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DestroyWindow(Window)
    Protected WindowID = WindowID(Window)
    CloseWindow(Window)
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      PostEvent(#EventClearGadgetList)
    CompilerElse
      ClearGadgetList()
    CompilerEndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DestroyGadget(Gadget)
    FreeGadget(Gadget)
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      PostEvent(#EventClearGadgetList)
    CompilerElse
      ClearGadgetList()
    CompilerEndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoOpenGadgetList(Gadget , Item = -1)
    If Item = -1
      OpenGadgetList(Gadget)
    Else
      OpenGadgetList(Gadget, Item)
    EndIf
    ParentGadget = Gadget
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoCloseGadgetList()
    CloseGadgetList()
    If ListSize(ParentGadgetStack())
      ParentGadget = ParentGadgetStack()
      DeleteElement(ParentGadgetStack())
    Else
      ParentGadget = -1
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure ParentWindow(Gadget)
    ForEach GadgetList()
      If GadgetList()\Gadget = Gadget
        ProcedureReturn GadgetList()\ParentWindow
      EndIf
    Next
    ProcedureReturn -1
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure ParentGadget(Gadget)
    ForEach GadgetList()
      If GadgetList()\Gadget = Gadget
        ProcedureReturn GadgetList()\ParentGadget
      EndIf
    Next
    ProcedureReturn -1
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoWindowEvents()
    Protected window, rt.s
    window = EventWindow()
    If FindMapElement(WindowList(), Hex(window))
      CompilerIf #PB_Compiler_Debugger
        If Bool(WindowList()\Name)
          Debug "GUI : EventWindow(" + WindowList()\Name + ") - Event(" + EventName(Event()) + ")", 2
        Else
          Debug "GUI : EventWindow(" + Window + ") - Event(" + EventName(Event()) + ")", 2
        EndIf
      CompilerEndIf
      Select Event()
        Case #PB_Event_CloseWindow
          If WindowList()\DoEventCloseWindow
            WindowList()\DoEventCloseWindow()
          EndIf
        Case #PB_Event_SizeWindow
          If WindowList()\DoEventSizeWindow
            WindowList()\DoEventSizeWindow()
          EndIf
        Case #PB_Event_ActivateWindow
          If WindowList()\DoEventActivateWindow
            WindowList()\DoEventActivateWindow()
          EndIf
        Case #PB_Event_DeactivateWindow
          If WindowList()\DoEventDeactivateWindow
            WindowList()\DoEventDeactivateWindow()
          EndIf
        Case #PB_Event_MoveWindow
          If WindowList()\DoEventMoveWindow
            WindowList()\DoEventMoveWindow()
          EndIf
        Case #PB_Event_MaximizeWindow
          If WindowList()\DoEventMaximizeWindow
            WindowList()\DoEventMaximizeWindow()
          EndIf
        Case #PB_Event_MinimizeWindow
          If WindowList()\DoEventMinimizeWindow
            WindowList()\DoEventMinimizeWindow()
          EndIf
        Case #PB_Event_RestoreWindow
          If WindowList()\DoEventRestoreWindow
            WindowList()\DoEventRestoreWindow()
          EndIf
        Case #PB_Event_Repaint
          If WindowList()\DoEventRepaintWindow
            WindowList()\DoEventRepaintWindow()
          EndIf
      EndSelect
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoGadgetEvents()
    Protected gadget
    gadget = EventGadget()
    If FindMapElement(GadgetList(), Hex(gadget))
      CompilerIf #PB_Compiler_Debugger
        If Bool(GadgetList()\Name)
          Debug "GUI : EventGadget(" + GadgetList()\Name + ") - EventType(" + EventTypeName(EventType()) + ")", 2
        Else
          Debug "GUI : EventGadget(" + gadget + ") - EventType(" + EventTypeName(EventType()) + ")", 2
        EndIf
      CompilerEndIf
      If GadgetList()\DoEvent
        GadgetList()\DoEvent()
      EndIf
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoMenuEvents()
    Protected menu
    menu = EventMenu()
    If FindMapElement(MenuList(), Hex(menu))
      CompilerIf #PB_Compiler_Debugger
        If Bool(MenuList()\Name)
          Debug "GUI : EventMenu(" + MenuList()\Name + ")", 2
        Else
          Debug "GUI : EventMenu(" + menu + ")", 2
        EndIf
      CompilerEndIf
      If MenuList()\DoEvent
        MenuList()\DoEvent()
      EndIf
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure InitEventManager()
    ; Events windows
    BindEvent(#PB_Event_CloseWindow, @DoWindowEvents())
    BindEvent(#PB_Event_SizeWindow, @DoWindowEvents())
    
    BindEvent(#PB_Event_ActivateWindow, @DoWindowEvents())
    BindEvent(#PB_Event_DeactivateWindow, @DoWindowEvents())
    
    BindEvent(#PB_Event_MoveWindow, @DoWindowEvents())
    BindEvent(#PB_Event_MinimizeWindow, @DoWindowEvents())
    BindEvent(#PB_Event_MaximizeWindow, @DoWindowEvents())
    BindEvent(#PB_Event_RestoreWindow, @DoWindowEvents())
    
    BindEvent(#PB_Event_Repaint, @DoWindowEvents())
    
    ; Events gadgets
    BindEvent(#PB_Event_Gadget, @DoGadgetEvents())
    
    ; Events Menus
    BindEvent(#PB_Event_Menu, @DoMenuEvents())
    
    ; Events Macfix
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      BindEvent(#EventClearGadgetList, @ClearGadgetList())
    CompilerEndIf
    
  EndProcedure : InitEventManager()
  
EndModule

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

DeclareModule EventManagerMacros
  
  ; Macros
  Macro dq
    "
  EndMacro
  
  ; Window´s
  Macro OpenWindow(Window, x, y, InnerWidth, InnerHeight, Title, Flags = 0, ParentID = 0)
    CreateWindow(dq#Window#dq, Window, x, y, InnerWidth, InnerHeight, Title, Flags, ParentID)
  EndMacro
  
  ; Menu´s
  Macro MenuItem(MenuItem, Text, ImageID=0)
    CreateMenuItem(dq#MenuItem#dq, MenuItem, Text, ImageID)
  EndMacro
  
  ; Gadget´s
  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
  
  ; Managment
  Macro CloseWindow(Window)
    DestroyWindow(Window)
  EndMacro
  
  Macro FreeGadget(Gadget)
    DestroyGadget(Gadget)
  EndMacro
  
  Macro OpenGadgetList(Gadget , Item = -1)
    DoOpenGadgetList(Gadget , Item = -1)
  EndMacro
  
  Macro CloseGadgetList()
    DoCloseGadgetList()
  EndMacro
  
EndDeclareModule

Module EventManagerMacros
  ; Do Nothing
EndModule

Macro UseEventManager()
  UseModule EventManager
  UseModule EventManagerMacros
EndMacro

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

;-Test

CompilerIf #PB_Compiler_IsMainFile
  
  UseEventManager()
  
  Enumeration Window
    #Main
  EndEnumeration
  
  Enumeration Gadget
    #Editor
    #Container
    #ButtonB0
    #ButtonB1
    #ButtonB2
  EndEnumeration
  
  Enumeration MenuItem
    #New
    #Load
    #Save
    #Exit
  EndEnumeration
  
  
  Global ExitApplication
  
  Procedure OpenMain(x = 10, y = 10, width = 550, height = 400)
    OpenWindow(#Main, x, y, width + MenuHeight(), height + MenuHeight(), "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
    If CreateMenu(0, WindowID(0))
      ; Mac Menu´s
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        MenuItem(#PB_Menu_About, "")
        MenuItem(#PB_Menu_Preferences, "")
        MenuItem(#PB_Menu_Quit, "")
      CompilerEndIf
      MenuTitle("&File")
      MenuItem(#New, "&New")
      MenuItem(#Load, "&Load")
      MenuItem(#Save, "&Save")
      MenuBar()
      MenuItem(#Exit, "&Exit")
    EndIf
    
    EditorGadget(#Editor, 10, 10, 530, 310)
    ContainerGadget(#Container, 10, 330, 530, 60)
    ButtonGadget(#ButtonB0, 10, 5, 160, 40, "Button 0")
    ButtonGadget(#ButtonB1, 180, 5, 170, 40, "Button 1")
    ButtonGadget(#ButtonB2, 360, 5, 160, 40, "Button 2")
    CloseGadgetList()
    
  EndProcedure
  
  OpenMain()
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        ; Nothing
    EndSelect
  Until ExitApplication
  
  End
  
  ; DoWindowEvents
  
  Runtime Procedure EventCloseWindow_Main()
    Debug "Runtime: Main CloseWindow"
    CloseWindow(#Main)
    ExitApplication = #True
  EndProcedure
  
  Runtime Procedure EventSizeWindow_Main()
    Debug "Runtime: Main SizeWindow"
  EndProcedure
  
  Runtime Procedure EventActivateWindow_Main()
    Debug "Runtime: Main ActivateWindow"
  EndProcedure
  
  Runtime Procedure EventDeactivateWindow_Main()
    Debug "Runtime: Main DeactivateWindow"
  EndProcedure
  
  Runtime Procedure EventMinimizeWindow_Main()
    Debug "Runtime: Main MinimizeWindow"
  EndProcedure
  
  Runtime Procedure EventMaximizeWindow_Main()
    Debug "Runtime: Main MaximizeWindow"
  EndProcedure
  
  Runtime Procedure EventRestoreWindow_Main()
    Debug "Runtime: Main RestoreWindow"
  EndProcedure
  
  ; DoMenuEvents
  Runtime Procedure EventMenu_New()
    Debug "Runtime: Menu New"
  EndProcedure
  
  Runtime Procedure EventMenu_Save()
    Debug "Runtime: Menu Save"
  EndProcedure
  
  Runtime Procedure EventMenu_Load()
    Debug "Runtime: Menu Load"
  EndProcedure
  
  Runtime Procedure EventMenu_Exit()
    Debug "Runtime: Menu Exit"
    CloseWindow(#Main)
    ExitApplication = 1
  EndProcedure
  
  ; Mac Menu´s
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    Runtime Procedure EventMenu_MacAbout()
      MessageRequester("Info", "Runtime Event Manager my mk-soft", #PB_MessageRequester_Info)
    EndProcedure
    
    Runtime Procedure EventMenu_MacPreferences()
      Debug "Runtime: Mac Menu Preferences"
    EndProcedure
    
    Runtime Procedure EventMenu_MacQuit()
      Debug "Runtime: Mac Menu Quit"
      CloseWindow(#Main)
      ExitApplication = 1
    EndProcedure
  CompilerEndIf
  
  ; DoGadgetEvents
  Runtime Procedure EventGadget_Editor()
    Select EventType()
      Case #PB_EventType_Focus
        Debug "Runtime: Editor Event Fosus - ParentGadget = " + ParentGadget(EventGadget())
      Case #PB_EventType_LostFocus
        Debug "Runtime: Editor Event LostFosus"
      Case #PB_EventType_Change
        Debug "Runtime: Editor Event Change"
    EndSelect
  EndProcedure
  
  Runtime Procedure EventGadget_ButtonB0()
    Select EventType()
      Case #PB_EventType_LeftClick
        Debug "Runtime: Event Button B0 - ParentGadget = " + ParentGadget(EventGadget())
    EndSelect
  EndProcedure
  
  Runtime Procedure EventGadget_ButtonB1()
    Select EventType()
      Case #PB_EventType_LeftClick
        Debug "Runtime: Event Button B1 - ParentGadget = " + ParentGadget(EventGadget())
    EndSelect
  EndProcedure
  
  Runtime Procedure EventGadget_ButtonB2()
    Select EventType()
      Case #PB_EventType_LeftClick
        Debug "Runtime: Event Button B2 - ParentGadget = " + ParentGadget(EventGadget())
        FreeGadget(#Container)
    EndSelect
  EndProcedure
  
CompilerEndIf
Zuletzt geändert von mk-soft am 31.07.2018 11:21, insgesamt 10-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Runtime Event Manager

Beitrag von mk-soft »

Platzhalter
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Runtime Event Manager

Beitrag von mk-soft »

Update v0.05
- Code optimiert
- Runtime Prefix Namen geändert
- Debugging hinzufügt. DebugLevel 2

:wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Runtime Event Manager

Beitrag von mk-soft »

Update v0.07
- Window Events hinzugefügt :wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
HeX0R
Beiträge: 2954
Registriert: 10.09.2004 09:59
Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win10 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2
Kontaktdaten:

Re: Runtime Event Manager

Beitrag von HeX0R »

Wow, das ist ja mal richtig clever :allright:

So ähnlich habe ich das bei einem Plugin-System aber mit minScript gelöst, da können auch Prozeduren mit entsprechenden Namen im Script erstellt werden, die dann bei Events angesprungen werden.

Aber sowas PB beizubringen ist schon cool!
Ich glaube ich habe den möglichen Nutzen der Runtime-lib etwas unterschätzt.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Runtime Event Manager

Beitrag von mk-soft »

Update v0.09
- Geändert: Intern von Arrays auf Maps umgestellt
- Code optimiert

Update v0.10
- CloseWindow und FreeGadget umgeleitet um Speicher aufzuräumen

Das mit der Runtime-Lib finde ich jetzt auch sehr praktisch.
Habe mal den Code überarbeitet und ist vorbereitet das man noch mit eigene Verarbeitungen beim anlegen von Window, Menus und Gadget erweitern kann.
Auch für Windows und Gadgets mit '#PB_Any' für die erweiterten Daten.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten