Aktuelle Zeit: 23.07.2017 16:55

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 9 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 15.07.2016 20:41 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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

ThreadToGUI.pb
Code:
;-TOP

; Comment: Thread To GUI
; Author : mk-soft
; Version: v1.16
; Created: 16.07.2016
; Updated: 10.07.2017
; 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)
  ; 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 ; Menu
    #BeginOfMenu
    #DisableMenuItem
    #SetMenuItemState
    #SetMenuItemText
    #SetMenuTitleText
    #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
 
  ; -----------------------------------------------------------------------------------
 
  ;-- 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)
            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
 
  ; -----------------------------------------------------------------------------------
 
 
  ;-- 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
          PostEvent(DoEvent, 0, 0, 0, *data)
          WaitSemaphore(signal)
          FreeSemaphore(signal)
          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

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

;- 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

_________________
Alles ist möglich, fragt sich nur wie...
Projekte EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Zuletzt geändert von mk-soft am 15.07.2017 11:22, insgesamt 9-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 17.07.2016 10:57 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Beispiel
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
 
  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 EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 20.01.2017 17:32 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Example 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

_________________
Alles ist möglich, fragt sich nur wie...
Projekte EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 27.06.2017 22:33 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Update v1.11
- Hinzugefügt: Clipboard funktionen

_________________
Alles ist möglich, fragt sich nur wie...
Projekte EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Zuletzt geändert von mk-soft am 04.07.2017 19:13, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 27.06.2017 22:46 
Offline
Benutzeravatar

Registriert: 11.06.2017 20:25
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.

_________________
٩(̾●̮̮̃̾•̃̾)۶ __̴ı̴̴̡̡̡ ̡͌l̡̡̡ ̡͌l̡*̡̡ ̴̡ı̴̴̡ ̡̡͡|̲̲̲͡͡͡ ̲▫̲͡ ̲̲̲͡͡π̲̲͡͡ ̲̲͡▫̲̲͡͡ ̲|̡̡̡ ̡ ̴̡ı̴̡̡ ̡͌l̡̡̡̡.___٩(- ̮̮̃-̃)۶


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 27.06.2017 23:31 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Update v1.12
- Hinzugefügt: Requester

Update v1.13
- Bugfix

_________________
Alles ist möglich, fragt sich nur wie...
Projekte EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 28.06.2017 11:46 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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:
;-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 EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 04.07.2017 19:14 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Beispiel SendEvent mit Dialog Fenster
Code:
;-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 EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul ThreadToGUI - Gadget, etc aus Thread bearbeiten
BeitragVerfasst: 15.07.2017 11:21 
Offline
Benutzeravatar

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

Code:
...
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 EventDesigner v1.x / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 9 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye