fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
ThreadDestructorProblem mit FB1.04_32bit

Uploader:	Muttonhead
Datum/Zeit:	18.12.2015 17:19:57
'System Includes

#include once "fbgfx.bi"

#include once "vbcompat.bi"



namespace sGUI

  type _SystemEvents  as SystemEvents

  type _InkeyEvent    as InkeyEvent



  'Konstanten für die Beschreibung des Maustastenstatus

  const as integer HIT=2      'Taste grad frisch gedrückt

  const as integer HOLD=3     'Taste gehalten

  const as integer RELEASE=1  'Taste grad losgelassen

  const as integer RELEASED=0 'Taste ist losgelassen



  'SystemEvent

  dim as _SystemEvents ptr SysEvents



  '"umwickelte" SystemEventFunktionen

  declare function GetSystemEvent as integer

  declare function GetInkey as string

  declare function GetMouseX as integer

  declare function GetMouseY as integer

  declare function GetMouseMoved as integer

  declare function GetLMB as integer

  declare function GetMMB as integer

  declare function GetRMB as integer

  declare function GetWheel as integer

  declare function GetCloseButton as integer



'sGUI Includes

type SystemEvents

  SystemEventOccurred as integer

  'Keyboard

  Key as string

  'Maus

  MouseMoved as integer

  MouseX as integer

  MouseY as integer

  LMB as integer

  MMB as integer

  RMB as integer

  Wheel as integer

  'Screen

  CloseButton as integer



  'Thread und Mutex

  Mutex as any ptr

  ThreadEndSignal as integer

  TheThread as any ptr



  declare constructor

  declare destructor

  declare static sub WrappedThreadCall(obj as any ptr)

  declare sub CollectEvents

  declare sub SetThreadEndSignal

  declare function GetSystemEvent as integer

  declare function GetInkey as string

  declare function GetMouseX as integer

  declare function GetMouseY as integer

  declare function GetMouseMoved as integer

  declare function GetLMB as integer

  declare function GetMMB as integer

  declare function GetRMB as integer

  declare function GetWheel as integer

  declare function GetCloseButton as integer

end type



constructor SystemEvents

  Mutex=mutexcreate()

  ThreadEndSignal=0

  TheThread=ThreadCreate(@WrappedThreadCall,@this)

end constructor





destructor SystemEvents

    SetThreadEndSignal

    'sleep 100'<--------------------mit gehts besser, aber nicht gut, gelegentlich Absturz beim Beenden

    ThreadWait(TheThread)'<--------hängt hier ohne Sleep xxx

    beep'<-------------------------Testpiepser um zu sehen wie weit es geht!!!!

    mutexdestroy(Mutex)

end destructor





sub SystemEvents.WrappedThreadCall(obj as any ptr)

  cast(SystemEvents ptr,obj)->CollectEvents

end sub





sub SystemEvents.CollectEvents

  dim as integer exitloop=0

  'Keyboard

  dim as string CurrentInkey

  dim as integer Currentasccode,Currentextended

  'Maus

  dim as integer CurrentMouseMoved,CurrentMouseX,CurrentMouseY,Currentlmb,Currentmmb,Currentrmb,CurrentWheel

  'Screen

  dim as integer CurrentCloseButton



  'alte Vergleichswerte, in der Regel vom vorherigen Loopdurchlauf

  'Keyboard

  dim as string OldInkey

  dim as integer Oldasccode,Oldextended,OldMouseX,OldMouseY,Oldlmb,Oldmmb,Oldrmb,OldWheel



  'Berechnungshilfen

  dim as integer Wheelvalue,OldWheelvalue,button,eventoccurred



  'dim as InkeyEvent ptr ievent

  do

    sleep 1

    eventoccurred=0

    button=0

    CurrentCloseButton=0

    CurrentInkey=""

    Currentasccode=-1

    Currentextended=0

    CurrentMouseMoved=0



 'alte Werte vom vorhergehenden Loopdurchgang zu Vergleichszwecken sichern

    OldMouseX=CurrentMouseX

    OldMouseY=CurrentMouseY

    Oldlmb=Currentlmb

    Oldmmb=Currentmmb

    Oldrmb=Currentrmb

    OldWheelvalue=Wheelvalue



    'Maus und Tastaturereignisse sammeln

    getmouse(CurrentMouseX,CurrentMouseY,Wheelvalue,button)

    CurrentInkey=Inkey

    do : loop while len(inkey)'zusätzlich aufgelaufenes Zeugs aus Tastaturpuffer löschen



    'Maustastenzustand festlegen

    if CurrentMouseX<0 or CurrentMouseY<0 then            'wenn die Maus ausserhalb des Screens ist

      'falls eine Maustaste gedrückt aus den Screen geschoben wird, wird sie über

      'RELEASE in den RELEASED Zustand versetzt

      '"kostet" also 2 Loops als Ereignis im Eventloop

      Currentlmb=iif(Currentlmb>RELEASE,RELEASE,RELEASED)

      Currentmmb=iif(Currentmmb>RELEASE,RELEASE,RELEASED)

      Currentrmb=iif(Currentrmb>RELEASE,RELEASE,RELEASED)

      Wheelvalue=OldWheelvalue

    else                                    'wenn Maus im Screen und Screen hat den Fokus



      'LMB 4 Schaltzustände simulieren

      if button and 1 then

        Currentlmb=iif(Currentlmb<HIT,HIT,HOld)

      else

        Currentlmb=iif(Currentlmb>RELEASE,RELEASE,RELEASED)

      end if

      'MMB 4 Schaltzustände simulieren

      if button and 4 then

        Currentmmb=iif(Currentmmb<HIT,HIT,HOld)

      else

        Currentmmb=iif(Currentmmb>RELEASE,RELEASE,RELEASED)

      end if

      'RMB 4 Schaltzustände simulieren

      if button and 2 then

        Currentrmb=iif(Currentrmb<HIT,HIT,HOld)

      else

        Currentrmb=iif(Currentrmb>RELEASE,RELEASE,RELEASED)

      end if



    end if



    'Ereignisse setzen---->wenn Ereignis dann eventoccurred=1

    'Event Mausposition + Mausbewegung

    if CurrentMouseX<>OldMouseX or CurrentMouseY<>OldMouseY then

      MouseMoved=1

      eventoccurred=1

    end if

    'Event LMB

    if Currentlmb<>Oldlmb then eventoccurred=1

    'Event MMB

    if Currentmmb<>Oldmmb then eventoccurred=1

    'Event RMB

    if Currentrmb<>Oldrmb then eventoccurred=1



    'Ereignis Rad

      OldWheel=CurrentWheel

      CurrentWheel=sgn(OldWheelvalue - Wheelvalue)

      if (OldWheel<>CurrentWheel) and (CurrentWheel<>0) then eventoccurred=1



    'Ereignis Tastatur

    if CurrentInkey<>"" then

      if len(CurrentInkey)=2 then

        Currentextended=asc(left(CurrentInkey,1))

        Currentasccode=asc(right(CurrentInkey,1))

      end if

      eventoccurred=1

    end if



    'Event CloseButton

    if (Currentextended<>0) and (Currentasccode=107) then

      CurrentCloseButton=1

      eventoccurred=1

    end if



    MutexLock(Mutex)

      if eventoccurred then

        SystemEventOccurred=1

        'Tastatur

        if CurrentInkey<>"" then Key=CurrentInKey

        'Maus

        MouseMoved  =CurrentMouseMoved

        MouseX      =CurrentMouseX

        MouseY      =CurrentMouseY

        LMB         =Currentlmb

        MMB         =Currentmmb

        RMB         =Currentrmb

        Wheel       =CurrentWheel

        'Screen

        if CurrentCloseButton then CloseButton=CurrentCloseButton

      else

        SystemEventOccurred=0

      end if

      exitloop=ThreadEndSignal

    MutexUnLock(Mutex)

  loop until exitloop

end sub





sub SystemEvents.SetThreadEndSignal

  MutexLock(Mutex)

    ThreadEndSignal=1

  MutexUnLock(Mutex)

end sub





function SystemEvents.GetSystemEvent as integer

  MutexLock(Mutex)

    function=SystemEventOccurred

  MutexUnLock(Mutex)

end function





function SystemEvents.GetInkey as string

  'dim as InkeyEvent ptr ievent



  MutexLock(Mutex)

    function=Key

    Key=""

  MutexUnLock(Mutex)

end function





function SystemEvents.GetMouseX as integer

  MutexLock(Mutex)

    function=MouseX

  MutexUnLock(Mutex)

end function





function SystemEvents.GetMouseY as integer

  MutexLock(Mutex)

    function=MouseY

  MutexUnLock(Mutex)

end function





function SystemEvents.GetMouseMoved as integer

  MutexLock(Mutex)

    function=MouseMoved

  MutexUnLock(Mutex)

end function





function SystemEvents.GetLMB as integer

  MutexLock(Mutex)

    function=LMB

  MutexUnLock(Mutex)

end function





function SystemEvents.GetMMB as integer

  MutexLock(Mutex)

    function=MMB

  MutexUnLock(Mutex)

end function





function SystemEvents.GetRMB as integer

  MutexLock(Mutex)

    function=RMB

  MutexUnLock(Mutex)

end function





function SystemEvents.GetWheel as integer

  MutexLock(Mutex)

    function=Wheel

  MutexUnLock(Mutex)

end function





function SystemEvents.GetCloseButton as integer

  MutexLock(Mutex)

    function=CloseButton

  MutexUnLock(Mutex)

end function



'******************************************************************************

'******************************************************************************

'Wrapped SystemEvents**********************************************************

function GetSystemEvent as integer

  function=SysEvents->GetSystemEvent

end function



function GetInkey as string

  function=SysEvents->GetInkey

end function





function GetMouseX as integer

  function=SysEvents->GetMouseX

end function





function GetMouseY as integer

  function=SysEvents->GetMouseY

end function





function GetMouseMoved as integer

  function=SysEvents->GetMouseMoved

end function





function GetLMB as integer

  function=SysEvents->GetLMB

end function





function GetMMB as integer

  function=SysEvents->GetMMB

end function





function GetRMB as integer

  function=SysEvents->GetRMB

end function





function GetWheel as integer

  function=SysEvents->GetWheel

end function





function GetCloseButton as integer

  function=SysEvents->GetCloseButton

end function



end namespace



'******************************************************************************

'******************************************************************************

'allg. Destruktor**************************************************************



sub Maindestructor destructor

  if sGUI.SysEvents then delete sGUI.SysEvents

end sub



'******************************************************************************

'******************************************************************************

'Hauptprogramm*****************************************************************

using sGUI



screen 19,32

SysEvents=new SystemEvents



dim as string key

do

  sleep 1

  print ".";

  key=GetInkey

  if key<>"" then print key;

loop until key=chr(27)