It is currently Thu Nov 21, 2019 6:38 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 21 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Module ThreadToGUI-Update windows,gadgets,... from threads
PostPosted: Fri Jul 15, 2016 7:48 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
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

ThreadToGUI.pb
Code:
;-TOP

; Comment: Thread To GUI
; Author : mk-soft
; Version: v1.19
; Created: 16.07.2016
; Updated: 21.05.2018
; 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   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
    #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 #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 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:

_________________
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


Last edited by mk-soft on Mon May 21, 2018 12:02 pm, edited 19 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Update gadgets from threads
PostPosted: Sat Jul 16, 2016 3:51 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
Example 1

Update v1.19
Code:
;-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:
;-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

_________________
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


Last edited by mk-soft on Tue Aug 14, 2018 9:02 am, edited 6 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Sat Jul 16, 2016 10:49 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Sat Aug 27, 2016 8:20 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon May 29, 2006 11:29 am
Posts: 325
Location: BARCELONA - SPAIN
:D Thanks a lot!

_________________
QuimV


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Sun Aug 28, 2016 11:28 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Mon Aug 29, 2016 9:13 am 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4528
Location: Lyon - France
Works very well on windows and v5.40 x86 :D
Thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Sun Oct 23, 2016 12:45 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Tue Nov 01, 2016 1:27 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 14, 2011 6:07 pm
Posts: 341
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Tue Nov 01, 2016 8:03 am 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4425
Location: Germany
@Said

look here:
viewtopic.php?f=12&p=495735#p495735

Bernd


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Tue Nov 01, 2016 10:20 pm 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 14, 2011 6:07 pm
Posts: 341
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Thu Nov 03, 2016 10:26 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
@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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Mon Nov 07, 2016 9:50 am 
Offline
Enthusiast
Enthusiast

Joined: Tue May 26, 2009 2:11 pm
Posts: 618
Hello Michael!

There are two #SetGadgetItemState in PostEventCB()
(Case #BeginOfGadgets To #EndOfGadgets)
but #SetGadgetState is missing.
This prevents e.g. updating a ProgressbarGadget.

_________________
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Wed Nov 09, 2016 8:54 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Wed Nov 09, 2016 6:01 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2046
Location: Germany
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ThreadToGUI-Update windows,gadgets,... from threa
PostPosted: Fri Feb 17, 2017 1:47 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Jul 23, 2008 10:45 pm
Posts: 137
Nice, Thanks mk-soft :D


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 21 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 8 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye