Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

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

Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Gadget aus Threads zu ändern geht bei Windows meistens ohne Probleme. Bei MacOS und Linux funktioniert diese überhaupt nicht...
Kann man aber mit PostEvent lösen.

Update v1.14
- Hinzugefügt: Clipboard funktionen
- Hinzugefügt: Requester
- Überprüfung von AllocateStructure und CreateSemaphore

Update v1.16
- Hinzugefügt: Weiter Requester. Input, Color und FontRequester
- Hinzugefügt: Zweites Modul 'ThreadGUI' mit Macros zum umschalten zu ThreadToGUI Gadget Befehle

Update v1.17
- Modul ThreadGUI von Hauptmodul getrennt

Update v1.19
- Added DoDisplayPopupMenu

Update v1.20
- Added DoCloseWindow

ThreadToGUI.pb

Code: Alles auswählen

;-TOP

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

; ***************************************************************************************
Zuletzt geändert von mk-soft am 13.08.2022 20:13, insgesamt 15-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Beispiel

Code: Alles auswählen

;-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
  
  UseModule ThreadToGUI
  
  DoDisableGadget(2, #True)
  For count = 0 To 4
    For col = 0 To 3
      DoStatusBarProgress(0, 1, count * 20 + col * 5)
      Select col
        Case 0 : DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,0,0))
        Case 1 : DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,255,0))
        Case 2 : DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(0,255,0))
        Case 3 : DoSetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,255,255))
      EndSelect
      Delay(1000)
    Next
  Next
  DoStatusBarProgress(0, 1, 100)
  DoDisableGadget(2, #False)
  
  UnuseModule ThreadToGUI
  
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()
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Example SendEvent

Code: Alles auswählen

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

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Update v1.11
- Hinzugefügt: Clipboard funktionen
Zuletzt geändert von mk-soft am 04.07.2017 19:13, insgesamt 1-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
GlassJoe
Beiträge: 108
Registriert: 11.06.2017 20:25
Computerausstattung: 2 x AMD Phenom II x4 945,2x Dell Latitude X300, Dell Latitude D410, Hp Compaq NC4400

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von GlassJoe »

Heilige Scheiße :shock:

Mann das nenne ich mal ein Stück Arbeit :shock: :shock:

Alter Schwede, du bist echt heftig drauf :allright:

Ich werde mir auf jeden Fall mal anschauen was es mit dem Code auf sich hat, da steckt ne Menge Zeit & Mühe dahinter.
https://www.geek.com/tech/a-commodore-6 ... s-1672510/
٩(̾●̮̮̃̾•̃̾)۶ __̴ı̴̴̡̡̡ ̡͌l̡̡̡ ̡͌l̡*̡̡ ̴̡ı̴̴̡ ̡̡͡|̲̲̲͡͡͡ ̲▫̲͡ ̲̲̲͡͡π̲̲͡͡ ̲̲͡▫̲̲͡͡ ̲|̡̡̡ ̡ ̴̡ı̴̡̡ ̡͌l̡̡̡̡.___٩(- ̮̮̃-̃)۶
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Update v1.12
- Hinzugefügt: Requester

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

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Update v1.14
- Hinzugefügt: Clipboard funktionen
- Hinzugefügt: Requester
- Überprüfung von AllocateStructure() und CreateSemaphore()

Die Funktionen ohne Rückgabewerte geben bei erfolgreichen eintragen des Event ein Erfolg (1) zurück. Nicht das das Event im Mainscope verarbeitet wurde.
Wollen ja nicht das der Thread blockiert wird...

Beispiel mit Requester

Code: Alles auswählen

;-TOP

; Example ThreadToGUI Requester

IncludeFile "Modul_ThreadToGUI.pb"

Enumeration
  #Window
EndEnumeration

Enumeration
  #List
EndEnumeration

;- Constants
Enumeration #PB_Event_FirstCustomValue
  #My_DoEvent
EndEnumeration

Procedure Test(Null)
  
  Protected result, path.s
  
  ThreadToGUI::DoAddGadgetItem(#List, -1, "Start Thread")
  Delay(500)
  result = ThreadToGUI::DoMessageRequester("MessageRequester", "Question", #PB_MessageRequester_YesNoCancel | #PB_MessageRequester_Info)
  Select result
    Case #PB_MessageRequester_Yes
      ThreadToGUI::DoAddGadgetItem(#List, -1, "Message result yes")
    Case #PB_MessageRequester_No
      ThreadToGUI::DoAddGadgetItem(#List, -1, "Message result no")
    Case #PB_MessageRequester_Cancel
      ThreadToGUI::DoAddGadgetItem(#List, -1, "Message result cancel")
  EndSelect
  path = ThreadToGUI::DoOpenFileRequester("OpenFileRequester", "/", "", 0)
  ThreadToGUI::DoAddGadgetItem(#List, -1, "OpenFile: " + path)
  path = ThreadToGUI::DoSaveFileRequester("SaveFileRequester", "Test.txt", "", 0)
  ThreadToGUI::DoAddGadgetItem(#List, -1, "SaveFile: " + path)
  path = ThreadToGUI::DoPathRequester("PathRequester", "/")
  ThreadToGUI::DoAddGadgetItem(#List, -1, "Path: " + path)
  ThreadToGUI::DoAddGadgetItem(#List, -1, "Exit Thread")
  
EndProcedure

If OpenWindow(#Window, 0, 0, 600, 400, "Example Requester", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  ListViewGadget(#List, 0, 0, 600, 400)
  
  UseModule ThreadToGUI
  
  BindEventGUI(#My_DoEvent)
  hThread = CreateThread(@Test(), #Null)
  
  Repeat
    
    Select WaitWindowEvent()
        
      Case #PB_Event_CloseWindow
        exit = 1
        
    EndSelect
    
  Until exit
  If IsThread(hThread)
    Debug "Thread läuft"
    KillThread(hThread)
  EndIf
  
EndIf
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Beispiel SendEvent mit Dialog Fenster

Code: Alles auswählen

;-TOP

; Example ThreadToGUI SendEvent with open Dialog

IncludeFile "Modul_ThreadToGUI.pb"

UseModule ThreadToGUI

Enumeration
  #Window
  #Dialog
EndEnumeration

Enumeration
  #Dialog_Ok
  #Dialog_Cancel
  #Dialog_List
EndEnumeration

;- Test

;- Constants
Enumeration #PB_Event_FirstCustomValue
  #My_Event_OpenDialog
EndEnumeration

Structure udtDialogData
  Array TextList.s(0)
EndStructure

Procedure Test(Null)
  
  Protected result, index, daten.udtDialogData
  
  Debug "Init Thread"
  
  Dim daten\TextList(9)
  For index = 0 To ArraySize(daten\TextList())
    daten\TextList(index) = "Eintrag " + Str(index)
  Next
  
  Repeat
    Delay(1000)
    result = SendEvent(#My_Event_OpenDialog, 0, 0, 0, @daten)
    If result >= 0
      Debug "Result: " + daten\TextList(result)
    Else
      Debug "Abbruch!"
      Break
    EndIf
  ForEver
  
  Debug "Exit Thread"
  
EndProcedure

Procedure OpenDialog(*Daten.udtDialogData)
  Protected index
  If OpenWindow(#Dialog, #PB_Ignore, #PB_Ignore, 400, 300, "Example Threaded Dialog")
    ListViewGadget(#Dialog_List, 5, 5, 380, 240)
    ButtonGadget(#Dialog_Ok, 5, 260, 120, 25, "Ok")
    ButtonGadget(#Dialog_Cancel, 270, 260, 120, 25, "Abbrechen")
    For index = 0 To ArraySize(*Daten\TextList())
      AddGadgetItem(#Dialog_List, index, *Daten\TextList(index))
    Next
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure Main()
  Protected MyEventOpenDialog, result
  
  If OpenWindow(#Window, 0, 0, 400, 200, "Example SendEvent", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
    
    UseModule ThreadToGUI
    
    hThread = CreateThread(@Test(), #Null)
    
    Repeat
      
      Select WaitWindowEvent()
          
        Case #PB_Event_CloseWindow
          If EventWindow() = #Window
            exit = 1
          EndIf
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Dialog_Ok
              result = GetGadgetState(#Dialog_List)
              CloseWindow(#Dialog)
              DispatchEvent(MyEventOpenDialog, result)
            Case #Dialog_Cancel
              CloseWindow(#Dialog)
              result = -1
              DispatchEvent(MyEventOpenDialog, result)
          EndSelect
          
        Case #My_Event_OpenDialog
          MyEventOpenDialog = EventData()
          OpenDialog(SendEventData(MyEventOpenDialog))
          
      EndSelect
      
    Until exit
    If IsThread(hThread)
      Debug "Thread läuft"
      KillThread(hThread)
    EndIf
    
  EndIf
EndProcedure : Main()
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Update v1.16
- Hinzugefügt: Weiter Requester. Input, Color und FontRequester
- Hinzugefügt: Zweites Modul 'ThreadedGUI' mit Macros zum umschalten zu ThreadToGUI Gadget Befehle

Update v1.17
- Modul ThreadGUI von Hauptmodul getrennt

ThreadedGUI

Code: Alles auswählen

;-TOP

; Comment: Thread To GUI Help Macro
; Author : mk-soft
; Version: v1.17
; Created: 16.07.2016
; Updated: 14.03.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 Module Macros

DeclareModule ThreadedGUI
  
  ; Macros switch to ThreadToGUI
  
  ; Window
  Macro DisableWindow(Window, State)
    ThreadToGUI::DoDisableWindow(Window, State)
  EndMacro
  Macro HideWindow(Window, State, Flags)
    ThreadToGUI::DoHideWindow(Window, State, Flags)
  EndMacro
  Macro SetActiveWindow(Window)
    ThreadToGUI::DoSetActiveWindow(Window)
  EndMacro
  Macro SetWindowColor(Window, Color)
    ThreadToGUI::DoSetWindowColor(Window, Color)
  EndMacro
  Macro SetWindowData(Window, Value)
    ThreadToGUI::DoSetWindowData(Window, Value)
  EndMacro
  Macro SetWindowState(Window, State)
    ThreadToGUI::DoSetWindowState(Window, State)
  EndMacro
  Macro SetWindowTitle(Window, Text)
    ThreadToGUI::DoSetWindowTitle(Window, Text)
  EndMacro
  ; Menus
  Macro DisableMenuItem(Menu, MenuItem, State)
    ThreadToGUI::DoDisableMenuItem(Menu, MenuItem, State)
  EndMacro
  Macro SetMenuItemState(Menu, MenuItem, State)
    ThreadToGUI::DoSetMenuItemState(Menu, MenuItem, State)
  EndMacro
  Macro SetMenuItemText(Menu, MenuItem, Text)
    ThreadToGUI::DoSetMenuItemText(Menu, MenuItem, Text)
  EndMacro
  Macro SetMenuTitleText(Menu, Index, Text)
    ThreadToGUI::DoSetMenuTitleText(Menu, Index, Text)
  EndMacro
  ; Gadgets
  Macro AddGadgetColumn(Gadget, Postion, Text, Width)
    ThreadToGUI::DoAddGadgetColumn(Gadget, Postion, Text, Width)
  EndMacro
  Macro AddGadgetItem(Gadget, Position, Text, ImageID = 0, Flags = #PB_Ignore)
    ThreadToGUI::DoAddGadgetItem(Gadget, Position, Text, ImageID, Flags)
  EndMacro
  Macro ClearGadgetItems(Gadget)
    ThreadToGUI::DoClearGadgetItems(Gadget)
  EndMacro
  Macro ClearGadgetColumns(Gadget) ; Owner Gadget Function
    ThreadToGUI::DoClearGadgetColumns(Gadget) ; Owner Gadget Function
  EndMacro
  Macro DisableGadget(Gadget, State)
    ThreadToGUI::DoDisableGadget(Gadget, State)
  EndMacro
  Macro HideGadget(Gadget, State)
    ThreadToGUI::DoHideGadget(Gadget, State)
  EndMacro
  Macro SetActiveGadget(Gadget)
    ThreadToGUI::DoSetActiveGadget(Gadget)
  EndMacro
  Macro SetGadgetAttribute(Gadget, Attribute, Value)
    ThreadToGUI::DoSetGadgetAttribute(Gadget, Attribute, Value)
  EndMacro
  Macro SetGadgetColor(Gadget, ColorType, Color)
    ThreadToGUI::DoSetGadgetColor(Gadget, ColorType, Color)
  EndMacro
  Macro SetGadgetData(Gadget, Value)
    ThreadToGUI::DoSetGadgetData(Gadget, Value)
  EndMacro
  Macro SetGadgetFont(Gadget, FontID)
    ThreadToGUI::DoSetGadgetFont(Gadget, FontID)
  EndMacro
  Macro SetGadgetItemAttribute(Gadget, Item, Attribute, Value, Column = 0)
    ThreadToGUI::DoSetGadgetItemAttribute(Gadget, Item, Attribute, Value, Column)
  EndMacro
  Macro SetGadgetItemColor(Gadget, Item, ColorType, Color, Column = 0)
    ThreadToGUI::DoSetGadgetItemColor(Gadget, Item, ColorType, Color, Column)
  EndMacro
  Macro SetGadgetItemData(Gadget, Item, Value)
    ThreadToGUI::DoSetGadgetItemData(Gadget, Item, Value)
  EndMacro
  Macro SetGadgetItemImage(Gadget, Item, ImageID)
    ThreadToGUI::DoSetGadgetItemImage(Gadget, Item, ImageID)
  EndMacro
  Macro SetGadgetItemState(Gadget, Postion, State)
    ThreadToGUI::DoSetGadgetItemState(Gadget, Postion, State)
  EndMacro
  Macro SetGadgetItemText(Gadget, Postion, Text, Column = 0)
    ThreadToGUI::DoSetGadgetItemText(Gadget, Postion, Text, Column)
  EndMacro
  Macro SetGadgetState(Gadget, State)
    ThreadToGUI::DoSetGadgetState(Gadget, State)
  EndMacro
  Macro SetGadgetText(Gadget, Text)
    ThreadToGUI::DoSetGadgetText(Gadget, Text)
  EndMacro
  Macro ResizeGadget(Gadget, x, y, Width, Height)
    ThreadToGUI::DoResizeGadget(Gadget, x, y, Width, Height)
  EndMacro
  Macro RemoveGadgetColumn(Gadget, Column)
    ThreadToGUI::DoRemoveGadgetColumn(Gadget, Column)
  EndMacro
  Macro RemoveGadgetItem(Gadget, Position)
    ThreadToGUI::DoRemoveGadgetItem(Gadget, Position)
  EndMacro
  Macro GadgetToolTip(Gadget, Text)
    ThreadToGUI::DoGadgetToolTip(Gadget, Text)
  EndMacro
  ; Statusbar
  Macro StatusBarImage(StatusBar, Field, ImageID, Appearance = 0)
    ThreadToGUI::DoStatusBarImage(StatusBar, Field, ImageID, Appearance)
  EndMacro
  Macro StatusBarProgress(StatusBar, Field, Value, Appearance = 0, Min = #PB_Ignore, Max = #PB_Ignore)
    ThreadToGUI::DoStatusBarProgress(StatusBar, Field, Value, Appearance, Min, Max)
  EndMacro
  Macro StatusBarText(StatusBar, Field, Text, Appearance = 0)
    ThreadToGUI::DoStatusBarText(StatusBar, Field, Text, Appearance)
  EndMacro
  ; Toolbar
  Macro DisableToolBarButton(ToolBar, ButtonID, State)
    ThreadToGUI::DoDisableToolBarButton(ToolBar, ButtonID, State)
  EndMacro
  Macro SetToolBarButtonState(ToolBar, ButtonID, State)
    ThreadToGUI::DoSetToolBarButtonState(ToolBar, ButtonID, State)
  EndMacro
  ; Systray
  Macro ChangeSysTrayIcon(SysTrayIcon, ImageID)
    ThreadToGUI::DoChangeSysTrayIcon(SysTrayIcon, ImageID)
  EndMacro
  Macro SysTrayIconToolTip(SysTrayIcon, Text)
    ThreadToGUI::DoSysTrayIconToolTip(SysTrayIcon, Text)
  EndMacro
  ; Clipboard
  Macro GetClipboardImage(Image, Depth=24)
    ThreadToGUI::DoGetClipboardImage(Image, Depth)
  EndMacro
  Macro GetClipboardText()
    ThreadToGUI::DoGetClipboardText()
  EndMacro
  Macro SetClipboardImage(Image)
    ThreadToGUI::DoSetClipboardImage(Image)
  EndMacro
  Macro SetClipboardText(Texte)
    ThreadToGUI::DoSetClipboardText(Texte)
  EndMacro
  Macro ClearClipboard()
    ThreadToGUI::DoClearClipboard()
  EndMacro
  ; Requester
  Macro MessageRequester(Titel, Text, Flags=0)
    ThreadToGUI::DoMessageRequester(Titel, Text, Flags)
  EndMacro
  Macro OpenFileRequester(Titel, DefaultFile, Pattern, PatterPosition, Flags=0)
    ThreadToGUI::DoOpenFileRequester(Titel, DefaultFile, Pattern, PatterPosition, Flags)
  EndMacro
  Macro NextSelectedFileName()
    ThreadToGUI::DoNextSelectedFileName()
  EndMacro
  Macro SelectedFilePattern()
    ThreadToGUI::DoSelectedFilePattern()
  EndMacro
  Macro SaveFileRequester(Titel, DefaultFile, Pattern, PatterPosition)
    ThreadToGUI::DoSaveFileRequester(Titel, DefaultFile, Pattern, PatterPosition)
  EndMacro
  Macro PathRequester(Titel, InitialPath)
    ThreadToGUI::DoPathRequester(Titel, InitialPath)
  EndMacro
  Macro InputRequester(Titel, Message, DefaultString, Flags=0)
    ThreadToGUI::DoInputRequester(Titel, Message, DefaultString, Flags)
  EndMacro
  Macro ColorRequester(Color = $FFFFFF)
    ThreadToGUI::DoColorRequester(Color)
  EndMacro
  Macro FontRequester(FontName, FontSize, Flags, Color = 0, Style = 0)
    ThreadToGUI::DoFontRequester(FontName, FontSize, Flags, Color, Style)
  EndMacro
  Macro SelectedFontName()
    ThreadToGUI::DoSelectedFontName()
  EndMacro
  Macro SelectedFontSize()
    ThreadToGUI::DoSelectedFontSize()
  EndMacro
  Macro SelectedFontColor()
    ThreadToGUI::DoSelectedFontColor()
  EndMacro
  Macro SelectedFontStyle()
    ThreadToGUI::DoSelectedFontStyle()
  EndMacro
EndDeclareModule

Module ThreadedGUI
  ; Do nothing
EndModule

;- End Module Macros
Beispiel

Code: Alles auswählen

...
Procedure thFlash(id)
  Protected count, col
  
  UseModule ThreadedGUI ; Enable macros to switch all gadget commands to ThreadToGUI
  
  DisableGadget(2, #True)
  For count = 0 To 4
    For col = 0 To 3
      StatusBarProgress(0, 1, count * 20 + col * 5)
      Select col
        Case 0 : SetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,0,0))
        Case 1 : SetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,255,0))
        Case 2 : SetGadgetColor(3, #PB_Gadget_BackColor, RGB(0,255,0))
        Case 3 : SetGadgetColor(3, #PB_Gadget_BackColor, RGB(255,255,255))
      EndSelect
      Delay(1000)
    Next
  Next
  StatusBarProgress(0, 1, 100)
  DisableGadget(2, #False)
  
  UnuseModule ThreadedGUI ; Don´t forget to disable the macros
  
EndProcedure
...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten

Beitrag von mk-soft »

Update v1.19
- Added DoDisplayPopupMenu
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten