Module ThreadToGUI-Update windows,gadgets,... from threads

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Module ThreadToGUI-Update windows,gadgets,... from threads

Post by mk-soft »

To update gadget over threads going in Windows usually without problems. In MacOS and Linux, this does not at all ...
But can one solve with PostEvent.

Update v1.14
- Added Clipboard functions. On Linux crashed clipboard functions over threads
- Added Requester
- Added check AllocateStructure() and CreateSemaphore()

Update v1.15
- Added more Requester
- Update OpenFileRequester
- Optimize code

Update v1.16
- Added second module 'ThreadedGUI' with macro to activate threaded gadget commands

Upadte v1.17
- Split ThreadedGUI.

Update v1.19
- Added DoDisplayPopupMenu

Update v1.20
- Added DoCloseWindow

ThreadToGUI.pb

Code: Select all

;-TOP

; Comment: Thread To GUI
; Author : mk-soft
; Version: v1.20
; Created: 16.07.2016
; Updated: 02.10.2020
; Link En: http://www.purebasic.fr/english/viewtopic.php?f=12&t=66180
; Link De: http://www.purebasic.fr/german/viewtopic.php?f=8&t=29728

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

;- Begin Declare Module

CompilerIf #PB_Compiler_Thread = 0
  CompilerError "Use Compileroption Threadsafe!"
CompilerEndIf

DeclareModule ThreadToGUI
  
  ;-Public
  
  ;- Init
  Declare BindEventGUI(EventCustomValue = #PB_Event_FirstCustomValue)
  Declare UnBindEventGUI()
  ; Main
  Declare   DoWait()
  ; Windows
  Declare   DoCloseWindow(Window)
  Declare   DoDisableWindow(Window, State)
  Declare   DoHideWindow(Window, State, Flags)
  Declare   DoSetActiveWindow(Window)
  Declare   DoSetWindowColor(Window, Color)
  Declare   DoSetWindowData(Window, Value)
  Declare   DoSetWindowState(Window, State)
  Declare   DoSetWindowTitle(Window, Text.s)
  ; Menus
  Declare   DoDisableMenuItem(Menu, MenuItem, State)
  Declare   DoSetMenuItemState(Menu, MenuItem, State)
  Declare   DoSetMenuItemText(Menu, MenuItem, Text.s)
  Declare   DoSetMenuTitleText(Menu, Index, Text.s)
  Declare   DoDisplayPopupMenu(Menu, WindowID, x = #PB_Ignore, y = #PB_Ignore)
  
  ; Gadgets
  Declare   DoAddGadgetColumn(Gadget, Postion, Text.s, Width)
  Declare   DoAddGadgetItem(Gadget, Position, Text.s, ImageID = 0, Flags = #PB_Ignore)
  Declare   DoClearGadgetItems(Gadget)
  Declare   DoClearGadgetColumns(Gadget) ; Owner Gadget Function
  Declare   DoDisableGadget(Gadget, State)
  Declare   DoHideGadget(Gadget, State)
  Declare   DoSetActiveGadget(Gadget)
  Declare   DoSetGadgetAttribute(Gadget, Attribute, Value)
  Declare   DoSetGadgetColor(Gadget, ColorType, Color)
  Declare   DoSetGadgetData(Gadget, Value)
  Declare   DoSetGadgetFont(Gadget, FontID)
  Declare   DoSetGadgetItemAttribute(Gadget, Item, Attribute, Value, Column = 0)
  Declare   DoSetGadgetItemColor(Gadget, Item, ColorType, Color, Column = 0)
  Declare   DoSetGadgetItemData(Gadget, Item, Value)
  Declare   DoSetGadgetItemImage(Gadget, Item, ImageID)
  Declare   DoSetGadgetItemState(Gadget, Postion, State)
  Declare   DoSetGadgetItemText(Gadget, Postion, Text.s, Column = 0)
  Declare   DoSetGadgetState(Gadget, State)
  Declare   DoSetGadgetText(Gadget, Text.s)
  Declare   DoResizeGadget(Gadget, x, y, Width, Height)
  Declare   DoRemoveGadgetColumn(Gadget, Column)
  Declare   DoRemoveGadgetItem(Gadget, Position)
  Declare   DoGadgetToolTip(Gadget, Text.s)
  ; Statusbar
  Declare   DoStatusBarImage(StatusBar, Field, ImageID, Appearance = 0)
  Declare   DoStatusBarProgress(StatusBar, Field, Value, Appearance = 0, Min = #PB_Ignore, Max = #PB_Ignore)
  Declare   DoStatusBarText(StatusBar, Field, Text.s, Appearance = 0)
  ; Toolbar
  Declare   DoDisableToolBarButton(ToolBar, ButtonID, State)
  Declare   DoSetToolBarButtonState(ToolBar, ButtonID, State)
  ; Systray
  Declare   DoChangeSysTrayIcon(SysTrayIcon, ImageID)
  Declare   DoSysTrayIconToolTip(SysTrayIcon, Text.s)
  ; Clipboard
  Declare   DoGetClipboardImage(Image, Depth=24)
  Declare.s DoGetClipboardText()
  Declare   DoSetClipboardImage(Image)
  Declare   DoSetClipboardText(Texte.s)
  Declare   DoClearClipboard()
  ; Requester
  Declare   DoMessageRequester(Titel.s, Text.s, Flags=0)
  
  Declare.s DoOpenFileRequester(Titel.s, DefaultFile.s, Pattern.s, PatterPosition, Flags=0)
  Declare.s   DoNextSelectedFileName()
  Declare     DoSelectedFilePattern()
          
  Declare.s DoSaveFileRequester(Titel.s, DefaultFile.s, Pattern.s, PatterPosition)
  Declare.s DoPathRequester(Titel.s, InitialPath.s)
  Declare.s DoInputRequester(Titel.s, Message.s, DefaultString.s, Flags=0)
  Declare   DoColorRequester(Color = $FFFFFF)
  
  Declare   DoFontRequester(FontName.s, FontSize, Flags, Color = 0, Style = 0)
  Declare.s   DoSelectedFontName()
  Declare     DoSelectedFontSize()
  Declare     DoSelectedFontColor()
  Declare     DoSelectedFontStyle()
  
  ; SendEvent
  Declare SendEvent(Event, Window = 0, Object = 0, EventType = 0, pData = 0, Semaphore = 0)
  Declare SendEventData(*MyEvent)
  Declare DispatchEvent(*MyEvent, result)
  
EndDeclareModule

;- Begin Module

Module ThreadToGUI
  
  EnableExplicit
  
  ;-- Const
  Enumeration Command ; Main
    #BeginOfMain
    #WaitOnSignal
    #EndOfMain
  EndEnumeration
  
  Enumeration Command ; Windows
    #BeginOfWindows
    #CloseWindow
    #DisableWindow
    #HideWindow
    #SetActiveWindow
    #SetWindowColor
    #SetWindowData
    #SetWindowState
    #SetWindowTitle
    #EndOfWindows
  EndEnumeration
  
  Enumeration Command ; Menus
    #BeginOfMenu
    #DisableMenuItem
    #SetMenuItemState
    #SetMenuItemText
    #SetMenuTitleText
    #DisplayPopupMenu
    #EndOfMenu
  EndEnumeration
  
  Enumeration Command ; Gadgets
    #BeginOfGadgets
    #AddGadgetColumn
    #AddGadgetItem
    #ClearGadgetItems
    #ClearGadgetColumns ; Owner Gadget Function
    #DisableGadget
    #HideGadget
    #SetActiveGadget
    #SetGadgetAttribute
    #SetGadgetColor
    #SetGadgetData
    #SetGadgetFont
    #SetGadgetItemAttribute
    #SetGadgetItemColor
    #SetGadgetItemData
    #SetGadgetItemImage
    #SetGadgetItemState
    #SetGadgetItemText
    #SetGadgetState
    #SetGadgetText
    #ResizeGadget
    #RemoveGadgetColumn
    #RemoveGadgetItem
    #GadgetToolTip
    #EndOfGadgets
  EndEnumeration
  
  Enumeration Command ; Statusbar
    #BeginOfStatusbar
    #StatusBarImage
    #StatusBarProgress
    #StatusBarText
    #EndOfStatusbar
  EndEnumeration
  
  Enumeration Command ; ToolBar
    #BeginOfToolbar
    #DisableToolBarButton
    #SetToolBarButtonState
    #EndOfToolbar
  EndEnumeration
  
  Enumeration Command ; Systray
    #BeginOfSystray
    #ChangeSysTrayIcon
    #SysTrayIconToolTip
    #EndOfSystray
  EndEnumeration
  
  Enumeration Command ; Clipboard
    #BeginOfClipboard
    #GetClipboardImage
    #GetClipboardText
    #SetClipboardImage
    #SetClipboardText
    #ClearClipboard
    #EndOfClipboard
  EndEnumeration
  
  Enumeration Command ; Requester
    #BeginOfRequester
    #MessageRequester
    #OpenFileRequester
    #SaveFileRequester
    #PathRequester
    #InputRequester
    #ColorRequester
    #FontRequester
    #EndOfRequester
  EndEnumeration
  
  ;-- Structure DoCommand
  Structure udtParam
    Command.i
    Signal.i
    Result.i
    Object.i
    Param1.i
    Param2.i
    Param3.i
    Param4.i
    Param5.i
  EndStructure
  
  Structure udtParamText
    Command.i
    Signal.i
    Result.i
    Object.i
    Param1.i
    Param2.i
    Param3.i
    Param4.i
    Param5.i
    Text.s
  EndStructure
  
  Structure udtParamText2
    Command.i
    Signal.i
    Result.i
    Object.i
    Param1.i
    Param2.i
    Param3.i
    Param4.i
    Param5.i
    Text.s
    Text2.s
  EndStructure
  
  Structure udtParamText3
    Command.i
    Signal.i
    Result.i
    Object.i
    Param1.i
    Param2.i
    Param3.i
    Param4.i
    Param5.i
    Text.s
    Text2.s
    Text3.s
  EndStructure
  
  Structure udtParamAll Extends udtParamText3
  EndStructure
  
  ;-- Structure SendEvent
  Structure udtSendEvent
    Signal.i
    Result.i
    *pData
  EndStructure
  
  ;-- Global
  Global DoEvent
  Global LockMessageRequester = CreateMutex()
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Functions
  
  Procedure PostEventCB()
    
    Protected *data.udtParamAll
    
    *data = EventData()
    With *data
      Select \Command
        Case #WaitOnSignal
          ; Do nothing
          
        Case #BeginOfWindows To #EndOfWindows
          If IsWindow(\Object)
            Select \Command
              Case #CloseWindow
                CloseWindow(\Object)
              Case #DisableGadget
                DisableWindow(\Object, \Param1)
              Case #HideGadget
                HideWindow(\Object, \Param1, \Param2)
              Case #SetActiveGadget
                SetActiveWindow(\Object)
              Case #SetWindowColor
                SetWindowColor(\Object, \Param1)
              Case #SetWindowData
                SetWindowData(\Object, \Param1)
              Case #SetWindowState
                SetWindowState(\Object, \Param1)
              Case #SetWindowTitle
                SetWindowTitle(\Object, \Text)
            EndSelect
          EndIf
          
        Case #BeginOfMenu To #EndOfMenu
          If IsMenu(\Object)
            Select \Command
              Case #DisableMenuItem
                DisableMenuItem(\Object, \Param1, \Param2)
              Case #SetMenuItemState
                SetMenuItemState(\Object, \Param1, \Param2)
              Case #SetMenuItemText
                SetMenuItemText(\Object, \Param1, \Text)
              Case #SetMenuTitleText
                SetMenuTitleText(\Object, \Param1, \Text)
              Case #DisplayPopupMenu
                If \Param2 = #PB_Ignore
                  Debug "Popup"
                  DisplayPopupMenu(\Object, \Param1)
                Else
                  DisplayPopupMenu(\Object, \Param1, \Param2, \Param3)
                EndIf  
            EndSelect
          EndIf
          
        Case #BeginOfGadgets To #EndOfGadgets
          If IsGadget(\Object)
            Select \Command
              Case #AddGadgetColumn
                AddGadgetColumn(\Object, \Param1, \Text.s, \Param3)
              Case #AddGadgetItem
                If \Param4 = #PB_Ignore
                  AddGadgetItem(\Object, \Param1, \Text.s, \Param3)
                Else
                  AddGadgetItem(\Object, \Param1, \Text.s, \Param3, \Param4)
                EndIf
              Case #ClearGadgetItems
                ClearGadgetItems(\Object)
              Case #ClearGadgetColumns ; Owner gadget function
                CompilerIf #PB_Compiler_Version <= 551
                  ClearGadgetItems(\Object)
                  While GetGadgetItemText(\Object, -1, 0)
                    RemoveGadgetColumn(\Object, 0)
                  Wend
                CompilerElse
                  RemoveGadgetColumn(\Object, #PB_All)
                CompilerEndIf
              Case #DisableGadget
                DisableGadget(\Object, \Param1)
              Case #HideGadget
                HideGadget(\Object, \Param1)
              Case #SetActiveGadget
                SetActiveGadget(\Object)
              Case #SetGadgetAttribute
                SetGadgetAttribute(\Object, \Param1, \Param2)
              Case #SetGadgetColor
                SetGadgetColor(\Object, \Param1, \Param2)
              Case #SetGadgetData
                SetGadgetData(\Object, \Param1)
              Case #SetGadgetFont
                SetGadgetFont(\Object, \Param1)
              Case #SetGadgetItemAttribute
                SetGadgetItemAttribute(\Object, \Param1, \Param2, \Param3, \Param4)
              Case #SetGadgetItemColor
                SetGadgetItemColor(\Object, \Param1, \Param2, \Param3, \Param4)
              Case #SetGadgetItemData
                SetGadgetItemData(\Object, \Param1, \Param2)
              Case #SetGadgetItemImage
                SetGadgetItemImage(\Object, \Param1, \Param2)
              Case #SetGadgetItemState
                SetGadgetItemState(\Object, \Param1, \Param2)
              Case #SetGadgetItemText
                SetGadgetItemText(\Object, \Param1, \Text.s, \Param3)
              Case #SetGadgetState
                SetGadgetState(\Object, \Param1)
              Case #SetGadgetText
                SetGadgetText(\Object, \Text.s)
              Case #ResizeGadget
                ResizeGadget(\Object, \Param1, \Param2, \Param3, \Param4)
              Case #RemoveGadgetColumn
                RemoveGadgetColumn(\Object, \Param1)
              Case #RemoveGadgetItem
                RemoveGadgetItem(\Object, \Param1)
              Case #GadgetToolTip
                GadgetToolTip(\Object, \Text)
            EndSelect
          EndIf
          
        Case #BeginOfStatusbar To #EndOfStatusbar
          If IsStatusBar(\Object)
            Select \Command
              Case #StatusBarImage
                StatusBarImage(\Object, \Param1, \Param2, \Param3)
              Case #StatusBarProgress
                StatusBarProgress(\Object, \Param1, \Param2, \Param3, \Param4, \Param5)
              Case #StatusBarText
                StatusBarText(\Object, \Param1, \Text, \Param3)
            EndSelect
          EndIf
          
        Case #BeginOfToolbar To #EndOfToolbar
          If IsToolBar(\Object)
            Select \Command
              Case #DisableToolBarButton
                DisableToolBarButton(\Object, \Param1, \Param2)
              Case #SetToolBarButtonState
                SetToolBarButtonState(\Object, \Param1, \Param2)
            EndSelect
          EndIf
          
        Case #BeginOfSystray To #EndOfSystray
          If IsSysTrayIcon(\Object)
            Select \Command
              Case #ChangeSysTrayIcon
                ChangeSysTrayIcon(\Object, \Param1)
              Case #SysTrayIconToolTip
                SysTrayIconToolTip(\Object, \Text)
            EndSelect
          EndIf
          
        Case #BeginOfClipboard To #EndOfClipboard
          Select \Command
            Case #GetClipboardImage
              \Result = GetClipboardImage(\Param1, \Param2)
            Case #GetClipboardText
              \Text = GetClipboardText()
            Case #SetClipboardImage
              SetClipboardImage(\Param1)
            Case #SetClipboardText
              SetClipboardText(\Text)
            Case #ClearClipboard
              ClearClipboard()
          EndSelect
          
        Case #BeginOfRequester To #EndOfRequester
          Select \Command
            Case #MessageRequester
              \Result = MessageRequester(\Text, \Text2, \Param3)
            Case #OpenFileRequester
              \Text = OpenFileRequester(\Text, \Text2, \Text3, \Param4, \Param5)
              If \Text
                \Param4 = SelectedFilePattern()
                If \Param5 = #PB_Requester_MultiSelection
                  Repeat
                    \Text2 = NextSelectedFileName()
                    If \Text2
                      \Text + #TAB$ + \Text2
                    Else
                      Break
                    EndIf
                  ForEver
                EndIf
              EndIf
            Case #SaveFileRequester
              \Text = SaveFileRequester(\Text, \Text2, \Text3, \Param4)
            Case #PathRequester
              \Text = PathRequester(\Text, \Text2)
            Case #InputRequester
              \Text = InputRequester(\Text, \Text2, \Text3, \Param4)
            Case #ColorRequester
              \Result = ColorRequester(\Param1)
            Case #FontRequester
              \Result = FontRequester(\Text, \Param2, \Param3, \Param4,  \Param5)
              If \Result
                \Text = SelectedFontName()
                \Param2 = SelectedFontSize()
                \Param4 = SelectedFontColor()
                \Param5 = SelectedFontStyle()
              EndIf
          EndSelect
          
      EndSelect
      
      If \Signal
        SignalSemaphore(\Signal)
      Else
        FreeStructure(*data)
      EndIf
      
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;- Public
  
  Procedure BindEventGUI(EventCustomValue = #PB_Event_FirstCustomValue)
    If Not DoEvent
      BindEvent(EventCustomValue, @PostEventCB())
      DoEvent = EventCustomValue
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure UnbindEventGUI()
    If DoEvent
      UnbindEvent(DoEvent, @PostEventCB())
      DoEvent = 0
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Speziale main command
  
  Procedure DoWait()
    Protected *data.udtParam, signal, result
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #WaitOnSignal
          \Signal = signal
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(\Signal)
          FreeSemaphore(signal)
          Result = 1
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Windows commands
  
  Procedure DoCloseWindow(Window)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #CloseWindow
        \Object = Window
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoDisableWindow(Window, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #DisableWindow
        \Object = Window
        \Param1 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoHideWindow(Window, State, Flags)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #HideWindow
        \Object = Window
        \Param1 = State
        \Param2 = Flags
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetActiveWindow(Window)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetActiveWindow
        \Object = Window
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetWindowColor(Window, Color)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetWindowColor
        \Object = Window
        \Param1 = Color
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetWindowData(Window, Value)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetWindowData
        \Object = Window
        \Param1 = Value
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetWindowState(Window, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetWindowState
        \Object = Window
        \Param1 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetWindowTitle(Window, Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SetWindowTitle
        \Object = Window
        \Text = Text
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Menu commands
  
  Procedure DoDisableMenuItem(Menu, MenuItem, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #DisableMenuItem
        \Object = Menu
        \Param1 = MenuItem
        \Param2 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetMenuItemState(Menu, MenuItem, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetMenuItemState
        \Object = Menu
        \Param1 = MenuItem
        \Param2 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetMenuItemText(Menu, MenuItem, Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SetMenuItemText
        \Object = Menu
        \Param1 = MenuItem
        \Text = Text
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetMenuTitleText(Menu, Index, Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SetMenuTitleText
        \Object = Menu
        \Param1 = Index
        \Text = Text
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoDisplayPopupMenu(Menu, WindowID, x = #PB_Ignore, y = #PB_Ignore)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #DisplayPopupMenu
        \Object = Menu
        \Param1 = WindowID
        \Param2 = x
        \Param3 = y
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Gadget commands
  
  Procedure DoAddGadgetColumn(Gadget, Position, Text.s, Width)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #AddGadgetColumn
        \Object = Gadget
        \Param1 = Position
        \Text = Text
        \Param3 = Width
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoAddGadgetItem(Gadget, Position, Text.s, ImageID = 0, Flags = #PB_Ignore)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #AddGadgetItem
        \Object = Gadget
        \Param1 = Position
        \Text = Text
        \Param3 = ImageID
        \Param4 = Flags
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoClearGadgetItems(Gadget)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #ClearGadgetItems
        \Object = Gadget
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoClearGadgetColumns(Gadget)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #ClearGadgetColumns
        \Object = Gadget
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoDisableGadget(Gadget, State)
    Protected *data.udtParam
        
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #DisableGadget
        \Object = Gadget
        \Param1 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoHideGadget(Gadget, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #HideGadget
        \Object = Gadget
        \Param1 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetActiveGadget(Gadget)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetActiveGadget
        \Object = Gadget
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetAttribute(Gadget, Attribute, Value)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetAttribute
        \Object = Gadget
        \Param1 = Attribute
        \Param2 = Value
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetColor(Gadget, ColorType, Color)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetColor
        \Object = Gadget
        \Param1 = ColorType
        \Param2 = Color
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetData(Gadget, Value)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetData
        \Object = Gadget
        \Param1 = Value
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetFont(Gadget, FontID)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetFont
        \Object = Gadget
        \Param1 = FontID
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetItemAttribute(Gadget, Item, Attribute, Value, Column = 0)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetItemAttribute
        \Object = Gadget
        \Param1 = Item
        \Param2 = Attribute
        \Param3 = Value
        \Param4 = Column
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetItemColor(Gadget, Item, ColorType, Color, Column = 0)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetItemColor
        \Object = Gadget
        \Param1 = Item
        \Param2 = ColorType
        \Param3 = Color
        \Param4 = Column
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetItemData(Gadget, Item, Value)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetItemData
        \Object = Gadget
        \Param1 = Item
        \Param2 = Value
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetItemImage(Gadget, Item, ImageID)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetItemImage
        \Object = Gadget
        \Param1 = Item
        \Param2 = ImageID
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetItemState(Gadget, Position, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetItemState
        \Object = Gadget
        \Param1 = Position
        \Param2 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetItemText(Gadget, Position, Text.s, Column = 0)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SetGadgetItemText
        \Object = Gadget
        \Param1 = Position
        \Text = Text
        \Param3 = Column
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetState(Gadget, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetGadgetState
        \Object = Gadget
        \Param1 = State
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetGadgetText(Gadget, Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SetGadgetText
        \Object = Gadget
        \Text = text
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoResizeGadget(Gadget, x, y, Width, Height)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #ResizeGadget
        \Object = Gadget
        \Param1 = x
        \Param2 = y
        \Param3 = Width
        \Param4 = Height
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoRemoveGadgetColumn(Gadget, Column)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #RemoveGadgetColumn
        \Object = Gadget
        \Param1 = Column
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoRemoveGadgetItem(Gadget, Position)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #RemoveGadgetItem
        \Object = Gadget
        \Param1 = Position
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoGadgetToolTip(Gadget, Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    
    *data = AllocateStructure(udtParamText)
    With *data
      \Command = #GadgetToolTip
      \Object = Gadget
      \Text = Text
      PostEvent(DoEvent, 0, 0, 0, *data)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Statusbar commands
  
  Procedure DoStatusBarImage(StatusBar, Field, ImageID, Appearance = 0)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    
    *data = AllocateStructure(udtParam)
    With *data
      \Command = #StatusBarImage
      \Object = StatusBar
      \Param1 = Field
      \Param2 = ImageID
      \Param3 = Appearance
      PostEvent(DoEvent, 0, 0, 0, *data)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoStatusBarProgress(StatusBar, Field, Value, Appearance = 0, Min = #PB_Ignore, Max = #PB_Ignore)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    
    *data = AllocateStructure(udtParam)
    With *data
      \Command = #StatusBarProgress
      \Object = StatusBar
      \Param1 = Field
      \Param2 = Value
      \Param3 = Appearance
      \Param4 = Min
      \Param5 = Max
      PostEvent(DoEvent, 0, 0, 0, *data)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoStatusBarText(StatusBar, Field, Text.s, Appearance = 0)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    
    *data = AllocateStructure(udtParamText)
    With *data
      \Command = #StatusBarText
      \Object = StatusBar
      \Param1 = Field
      \Text = Text
      \Param3 = Appearance
      PostEvent(DoEvent, 0, 0, 0, *data)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Toolbar commands
  
  Procedure DoDisableToolBarButton(ToolBar, ButtonID, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    
    *data = AllocateStructure(udtParam)
    With *data
      \Command = #DisableToolBarButton
      \Object = ToolBar
      \Param1 = ButtonID
      \Param2 = State
      PostEvent(DoEvent, 0, 0, 0, *data)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetToolBarButtonState(ToolBar, ButtonID, State)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    
    *data = AllocateStructure(udtParam)
    With *data
      \Command = #SetToolBarButtonState
      \Object = ToolBar
      \Param1 = ButtonID
      \Param2 = State
      PostEvent(DoEvent, 0, 0, 0, *data)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Systray commands
  
  Procedure DoChangeSysTrayIcon(SysTrayIcon, ImageID)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #ChangeSysTrayIcon
        \Object = SysTrayIcon
        \Param1 = ImageID
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSysTrayIconToolTip(SysTrayIcon, Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SysTrayIconToolTip
        \Object = SysTrayIcon
        \Text = Text
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Clipboard command
  
  Procedure DoGetClipboardImage(Image, Depth=24)
    Protected *data.udtParam, signal, result
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        signal = CreateSemaphore()
        \Command = #GetClipboardImage
        \Signal = signal
        \Param1 = Image
        \Param2 = Depth
        PostEvent(DoEvent, 0, 0, 0, *data)
        WaitSemaphore(signal)
        FreeSemaphore(signal)
        result = \Result
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s DoGetClipboardText()
    Protected *data.udtParamText, signal, result.s
    
    If Not DoEvent : ProcedureReturn "" : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        signal = CreateSemaphore()
        \Command = #GetClipboardText
        \Signal = signal
        PostEvent(DoEvent, 0, 0, 0, *data)
        WaitSemaphore(signal)
        FreeSemaphore(signal)
        result = \Text
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetClipboardImage(Image)
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        \Command = #SetClipboardImage
        \Param1 = Image
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoSetClipboardText(Text.s)
    Protected *data.udtParamText
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        \Command = #SetClipboardText
        \Text = Text
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoClearClipboard()
    Protected *data.udtParam
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      If *data
        *data = AllocateStructure(udtParam)
        \Command = #ClearClipboard
        PostEvent(DoEvent, 0, 0, 0, *data)
        ProcedureReturn 1
      Else
        ProcedureReturn 0
      EndIf
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Requester
  
  Procedure DoMessageRequester(Titel.s, Text.s, Flags=0)
    Protected *data.udtParamText2, signal, result
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText2)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #MessageRequester
          \Signal = signal
          \Text = Titel
          \Text2 = Text
          \Param3 = Flags
          LockMutex(LockMessageRequester)
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          UnlockMutex(LockMessageRequester)
          result = \Result
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Threaded NewList SelectedFileName.s()
  Threaded __SelectedFilePattern.i
  
  Procedure.s DoOpenFileRequester(Titel.s, DefaultFile.s, Pattern.s, PatterPosition, Flags=0)
    Protected *data.udtParamText3, signal, result.s, cnt, index, filename.s
    
    If Not DoEvent : ProcedureReturn "" : EndIf
    With *data
      *data = AllocateStructure(udtParamText3)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #OpenFileRequester
          \Signal = signal
          \Text = Titel
          \Text2 = DefaultFile
          \Text3 = Pattern
          \Param4 = PatterPosition
          \Param5 = Flags
          ClearList(SelectedFileName())
          __SelectedFilePattern = 0
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          If Flags & #PB_Requester_MultiSelection
            cnt = CountString(\Text, #TAB$) + 1
            For index = 1 To cnt
              AddElement(SelectedFileName())
              SelectedFileName() = StringField(\Text, index, #TAB$)
            Next
            FirstElement(SelectedFileName())
            result = SelectedFileName()
          Else
            result = \Text
          EndIf
          __SelectedFilePattern = \Param4
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  
  Procedure.s DoNextSelectedFileName()
    Protected result.s
    If NextElement(SelectedFileName())
      result = SelectedFileName()
    Else
      ClearList(SelectedFileName())
      result = ""
    EndIf
    ProcedureReturn result
  EndProcedure
  
  Procedure DoSelectedFilePattern()
    ProcedureReturn __SelectedFilePattern
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s DoSaveFileRequester(Titel.s, DefaultFile.s, Pattern.s, PatterPosition)
    Protected *data.udtParamText3, signal, result.s
    
    If Not DoEvent : ProcedureReturn "" : EndIf
    With *data
      *data = AllocateStructure(udtParamText3)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #SaveFileRequester
          \Signal = signal
          \Text = Titel
          \Text2 = DefaultFile
          \Text3 = Pattern
          \Param4 = PatterPosition
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          result = \Text
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s DoPathRequester(Titel.s, InitialPath.s)
    Protected *data.udtParamText2, signal, result.s
    
    If Not DoEvent : ProcedureReturn "" : EndIf
    With *data
      *data = AllocateStructure(udtParamText2)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #PathRequester
          \Signal = signal
          \Text = Titel
          \Text2 = InitialPath
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          result = \Text
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s DoInputRequester(Titel.s, Message.s, DefaultString.s, Flags=0)
    Protected *data.udtParamText3, signal, result.s
    
    If Not DoEvent : ProcedureReturn "" : EndIf
    With *data
      *data = AllocateStructure(udtParamText3)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #InputRequester
          \Signal = signal
          \Text = Titel
          \Text2 = Message
          \Text3 = DefaultString
          \Param4 = Flags
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          result = \Text
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DoColorRequester(Color = $FFFFFF)
    Protected *data.udtParam, signal, result
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParam)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #ColorRequester
          \Signal = signal
          \Param1 = Color
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          result = \Result
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Structure udtSelectedFont
    Name.s
    Size.i
    Color.i
    Style.i
  EndStructure
  
  Threaded SelectedFont.udtSelectedFont
  
  Procedure DoFontRequester(FontName.s, FontSize, Flags, Color = 0, Style = 0)
    Protected *data.udtParamText, signal, result
    
    If Not DoEvent : ProcedureReturn 0 : EndIf
    With *data
      *data = AllocateStructure(udtParamText)
      If *data
        signal = CreateSemaphore()
        If signal
          \Command = #FontRequester
          \Signal = signal
          \Text = FontName
          \Param2 = FontSize
          \Param3 = Flags
          \Param4 = Color
          \Param5 = Style
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          result = \Result
          If result
            SelectedFont\Name = \Text
            SelectedFont\Size = \Param2
            SelectedFont\Color = \Param4
            SelectedFont\Style = \Param5
          EndIf
        EndIf
        FreeStructure(*data)
      EndIf
      ProcedureReturn result
    EndWith
  EndProcedure
  
  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  
  Procedure.s DoSelectedFontName()
    ProcedureReturn SelectedFont\Name
  EndProcedure
  
  Procedure DoSelectedFontSize()
    ProcedureReturn SelectedFont\Size
  EndProcedure
  
  Procedure DoSelectedFontColor()
    ProcedureReturn SelectedFont\Color
  EndProcedure
  
  Procedure DoSelectedFontStyle()
    ProcedureReturn SelectedFont\Style
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ; *************************************************************************************
  
  ;-- SendEvent commands
  
  Procedure SendEvent(Event, Window = 0, Object = 0, EventType = 0, pData = 0, Semaphore = 0)
    Protected MyEvent.udtSendEvent, result
    
    With MyEvent
      If Semaphore
        \Signal = Semaphore
      Else
        \Signal = CreateSemaphore()
      EndIf
      \pData = pData
      PostEvent(Event, Window, Object, EventType, @MyEvent)
      WaitSemaphore(\Signal)
      result = \Result
      If Semaphore = 0
        FreeSemaphore(\Signal)
      EndIf
    EndWith
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SendEventData(*MyEvent.udtSendEvent)
    ProcedureReturn *MyEvent\pData
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DispatchEvent(*MyEvent.udtSendEvent, result)
    *MyEvent\Result = result
    SignalSemaphore(*MyEvent\Signal)
  EndProcedure
  
  ; *************************************************************************************
  
EndModule

;- End Module

; ***************************************************************************************
Please testing... :wink:
Last edited by mk-soft on Fri Oct 02, 2020 3:11 pm, edited 20 times in total.
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Update gadgets from threads

Post by mk-soft »

Example 1

Update v1.19

Code: Select all

;-TOP

; Example ThreadToGUI

IncludeFile "Modul_ThreadToGUI.pb"

Procedure thFillList(id)
  Protected text.s, count
  ThreadToGUI::DoDisableGadget(1, #True)
  ThreadToGUI::DoStatusBarText(0, 0, "Thread 1 running...")
  For count = 1 To 10
    text = FormatDate("%HH:%II:%SS - Number ", Date()) + Str(count)
    ThreadToGUI::DoAddGadgetItem(0, -1, text)
    Delay(1000)
  Next
  ThreadToGUI::DoStatusBarText(0, 0, "Thread 1 finished.")
  ThreadToGUI::DoDisableGadget(1, #False)
EndProcedure

Procedure thFlash(id)
  Protected count, col
  ThreadToGUI::DoDisableGadget(2, #True)
  For count = 0 To 4
    For col = 0 To 3
      ThreadToGUI::DoStatusBarProgress(0, 1, count * 20 + col * 5)
      Select col
        Case 0 : ThreadToGUI::DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,0,0))
        Case 1 : ThreadToGUI::DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,255,0))
        Case 2 : ThreadToGUI::DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(0,255,0))
        Case 3 : ThreadToGUI::DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,255,255))
      EndSelect
      Delay(1000)
    Next
  Next
  ThreadToGUI::DoStatusBarProgress(0, 1, 100)
  ThreadToGUI::DoDisableGadget(2, #False)
EndProcedure

Procedure Main()
  Protected event, thread1, thread2
 
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 800, 560, "Thread To GUI Example", #PB_Window_SystemMenu)
    CreateStatusBar(0, WindowID(0))
    AddStatusBarField(200)
    StatusBarText(0, 0, "Thread 1")
    AddStatusBarField(200)
    AddStatusBarField(#PB_Ignore)
   
    ListViewGadget(0, 0, 0, 800, 500)
    ButtonGadget(1, 10, 510, 120, 24, "Fill List")
    ButtonGadget(2, 140, 510, 120, 24, "Flash")
    StringGadget(3, 710, 510, 80, 24, "State", #PB_String_ReadOnly)
   
    ThreadToGUI::BindEventGUI(#PB_Event_FirstCustomValue)
   
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_CloseWindow
          If IsThread(thread1) : KillThread(thread1) : EndIf
          If IsThread(thread2) : KillThread(thread2) : EndIf
          ThreadToGUI::UnBindEventGUI()
          Break
         
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              If Not IsThread(thread1)
                thread1 = CreateThread(@thFillList(), 0)
              EndIf
             
            Case 2
              If Not IsThread(thread2)
                thread2 = CreateThread(@thFlash(), 0)
              EndIf
             
          EndSelect
         
      EndSelect
     
    ForEver
   
  EndIf
 
EndProcedure : Main()
Example 2 SendEvent

Code: Select all

;-TOP

; Example ThreadToGUI SendEvent

IncludeFile "Modul_ThreadToGUI.pb"

Enumeration
  #Window
EndEnumeration

;- Test

;- Constants
Enumeration #PB_Event_FirstCustomValue
  #My_Event_Question
EndEnumeration

Procedure Test(Null)
  
  Protected result
  
  Debug "Init Thread"
  ;MySemaphore = CreateSemaphore()
  
  Repeat
    Delay(500)
    result = ThreadToGUI::SendEvent(#My_Event_Question, 0, 0, 0, Random(100))
    ;result = SendEvent(#My_Event_Question, 0, 0, 0, Random(100), MySemaphore)
    Select result
      Case #PB_MessageRequester_Yes
        Debug "Result Yes"
      Case #PB_MessageRequester_No
        Debug "Result No"
      Case #PB_MessageRequester_Cancel
        Debug "Result Cancel"
    EndSelect
  Until result = #PB_MessageRequester_Cancel
  
  If MySemaphore
    FreeSemaphore(MySemaphore)
  EndIf
  
  Debug "Exit Thread"
  
EndProcedure

Global MyEvent

If OpenWindow(#Window, 0, 0, 800, 600, "Example SendEvent", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  
  UseModule ThreadToGUI
  
  hThread = CreateThread(@Test(), #Null)
  
  Repeat
    
    Select WaitWindowEvent()
        
      Case #PB_Event_CloseWindow
        exit = 1
        
      Case #PB_Event_Gadget
        
      Case #My_Event_Question
        MyEvent = EventData()
        Value = SendEventData(MyEvent)
        Debug "Incomming Message from thread. Data: " + Str(Value)
        result = MessageRequester("Questions", "Continue ?", #PB_MessageRequester_YesNoCancel)
        DispatchEvent(MyEvent, result)
        
    EndSelect
    
  Until exit
  If IsThread(hThread)
    Debug "Thread läuft"
    KillThread(hThread)
  EndIf
  
EndIf
Last edited by mk-soft on Tue Aug 14, 2018 9:02 am, edited 6 times in total.
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by mk-soft »

Update v1.01
- Added some ...

Please check and testing code :wink:
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
QuimV
Enthusiast
Enthusiast
Posts: 335
Joined: Mon May 29, 2006 11:29 am
Location: BARCELONA - SPAIN

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by QuimV »

:D Thanks a lot!
QuimV
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by mk-soft »

Update v1.04
- Added Toolbar, Systray, etc

Thanks for testing :wink:

P.S.
Update v1.05
- Bugfix
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
User avatar
Kwai chang caine
Addict
Addict
Posts: 4968
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by Kwai chang caine »

Works very well on windows and v5.40 x86 :D
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by mk-soft »

Thanks :wink:

Update v1.06
- Bugfix Unbind Event
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
said
Enthusiast
Enthusiast
Posts: 342
Joined: Thu Apr 14, 2011 6:07 pm

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by said »

Convenient and elegant way to update GUI elements from worker threads using PostEvent()! Seems to work fine, I like it, thanks for sharing :D :D

Up to now i was using different approach (2 ways communications with threads using global variables and mutexes ... ) but i think i will shift to your way, it is much simpler :lol: ... still i need to find a reliable way to stop a thread in the middle from main thread unless we run an event loop inside the threaded procedure :!:

One question though, what is the use of DoWait() ??

Your module needs a custom-event value (in your example you are using #PB_Event_FirstCustomValue) ... i wish we had something like #PB_Event_LastCustomValue, because most projects would be already using #PB_Event_FirstCustomValue in one or other modules

Said
infratec
Always Here
Always Here
Posts: 5521
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by infratec »

said
Enthusiast
Enthusiast
Posts: 342
Joined: Thu Apr 14, 2011 6:07 pm

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by said »

Thanks Bernd, i think ts-soft (Thomas's) enums is the way to go to avoid conflicting event values

Nice to be back to PB and the helpful/friendly forums :D
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by mk-soft »

@Said

DoWait is to wait the thread, so all events in the main event processing were processed.
:wink:

P.S. To wait for data from the main event processing, I still have the function SendEvent
Link http://www.purebasic.fr/german/viewtopi ... =8&t=26219
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
Lord
Enthusiast
Enthusiast
Posts: 746
Joined: Tue May 26, 2009 2:11 pm

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by Lord »

Hello Michael!

There are two #SetGadgetItemState in PostEventCB()
(Case #BeginOfGadgets To #EndOfGadgets)
but #SetGadgetState is missing.
This prevents e.g. updating a ProgressbarGadget.
Image
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by mk-soft »

Update v1.07
- Bugfix SetGadgetState

Was a false constant in the callback routine... :(
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
User avatar
mk-soft
Addict
Addict
Posts: 3191
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by mk-soft »

Update v1.08
-Added SendEvent

With SendEvent, it is possible to send a message from the thread to the GUI and wait for the response from the GUI.
To do this, the GUI must process the message with "DispatchEvent".

See example 2 :wink:
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace
Fredi
Enthusiast
Enthusiast
Posts: 139
Joined: Wed Jul 23, 2008 10:45 pm

Re: Module ThreadToGUI-Update windows,gadgets,... from threa

Post by Fredi »

Nice, Thanks mk-soft :D
Post Reply