 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
 Verfasst am: 30.07.2007, 11:57 Titel: [geloest] mehrere Ein-/Ausgabe Threads in der Konsole |
 |
|
Hatte vor ein paar Tagen versucht mehrere Threads fuer verschiedene Aufgaben in der Konsole zu erstellen...
Mit Threads arbeiten ist ansich nicht das Problem, das problem vielmehr war
das mehrere Thread die mit Locate,Color und Print arbeiteten schnell mal
etwas durcheinander bringen koennen das ein gesetztes Locate in dem Einen Thread das Print in einem anderen Thread vollkommen falsch setzt ect..
deswegen hab ich mir dafuer eine kleinigkeit ueberlegt...
| Code: |
'-ThreadWork:---------------------------------------------------------------------------'
Declare Function holder_ThreadWork (byref holder as integer=0, byref mode as integer=0) as integer
Declare Function get_ThreadWork as Integer
Declare Sub set_ThreadWork (byref SetThreadWork as integer)
'---------------------------------------------------------------------------------------'
ThreadWork:
'---------------------------------------------------------------------------------------'
'****************************************************************
Function get_ThreadWork as Integer
'****************************************************************
return holder_ThreadWork ()
'****************************************************************
End Function 'get_ThreadWork
'****************************************************************
'****************************************************************
Function holder_ThreadWork (byref holder as integer=0, _
byref mode as integer=0) as integer
'****************************************************************
Static ThreadWorkHolder as Integer
Select Case mode
Case 0 'Read (get)
Return ThreadWorkHolder
Case 1 'Save (set)
ThreadWorkHolder=holder
End Select
Return 0
'****************************************************************
End Function 'holder_ThreadWork
'****************************************************************
'****************************************************************
Sub set_ThreadWork (byref SetThreadWork as integer)
'****************************************************************
holder_ThreadWork (SetThreadWork,1)
'****************************************************************
End Sub 'set_ThreadWork
'****************************************************************
'****************************************************************
Sub free_ThreadWork
'****************************************************************
do
sleep(10)
loop until get_ThreadWork=0
'****************************************************************
End Sub
'****************************************************************
'---------------------------------------------------------------------------------------'
Sub Thread1 (byval null as integer)
dim count as integer
do
free_ThreadWork
set_ThreadWork (1)
for l as integer=1 to 10
color int(rnd*16)
locate l,1:?"Thread1: " &l
next l
set_ThreadWork (0)
count+=1
loop while count<100
color 15
?"Thread1 ready."
End Sub
Sub Thread2 (byval null as integer)
dim count as integer
do
free_ThreadWork
set_ThreadWork (1)
for l as integer=1 to 10
color int(rnd*16)
locate 11+l,2:?"Thread2: " &l
next l
set_ThreadWork (0)
count+=1
sleep (10)
loop while count<100
color 15
?"Thread2 ready."
End Sub
Dim Thread1p as any ptr
Dim Thread2p as any ptr
Thread1p=ThreadCreate (@Thread1,0)
Thread2p=ThreadCreate (@Thread2,0)
do
sleep (10)
loop until multikey(&h01)
|
_________________
Zuletzt bearbeitet von Eternal_pain am 04.08.2007, 19:35, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
Michael Frey
Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 30.07.2007, 13:33 Titel: |
|
|
muss zugeben das ich die noch net kannte, aber dabei geht es ja um
Variablen wie koennen die das problem von locate und print in der konsole beheben?
bei meinem Problem wosurch ich das hier gemacht habe ging es darum das ich bis dahin zwei Threads hatte, eine fuer die ausgabe und eine fuer die eingabe...
jedoch muss die eingabe ja auch anzeigen was eingegeben wurde...
so habe ich also mit locate, color und print gearbeitet... schien mir logisch 
allerdings kam es dazu das so mancher Text mit der falschen farbe irgendwo gesetzt wurde wo er nicht hinsollte weil der andere thread die locate oder color anweisung durch ein neues locate bzw color wieder aufgehobe hat...
und das wollte ich damit verhindern... das eine print ausgabe wartet bis ein anderer thread mit der ausgabe fertig ist...
_________________
|
|
| Nach oben |
|
|
Michael Frey
Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 30.07.2007, 17:10 Titel: |
|
|
danke fuer den Tip, haette mir einiges erspart wenn ichs schon frueher gewusst haette
| Code: |
'-ThreadWork:---------------------------------------------------------------------------'
Declare Function ThreadWork_holder (byval handle as any ptr=0, byval mode as integer=0) as any ptr
Declare Sub ThreadWork_init
Declare Sub ThreadWork_Lock
Declare Sub ThreadWork_UnLock
Declare Sub ThreadWork_close
'---------------------------------------------------------------------------------------'
ThreadWork:
'---------------------------------------------------------------------------------------'
'****************************************************************
Sub ThreadWork_init
Dim ThreadWorkWait as any ptr
ThreadWorkWait=MUTEXCREATE
if not ThreadWork_holder then ThreadWork_holder (ThreadWorkWait,1)
End Sub
'****************************************************************
'****************************************************************
Function ThreadWork_holder (byval handle as any ptr=0, _
byval mode as integer=0) as any ptr
Static ThreadWorkWait as any ptr
select case mode
case 0
return ThreadWorkWait
case 1
ThreadWorkWait=handle
return 0
End Select
End Function
'****************************************************************
'****************************************************************
Sub ThreadWork_Lock
MUTEXLOCK ThreadWork_holder
End Sub
'****************************************************************
'****************************************************************
Sub ThreadWork_UnLock
MUTEXUNLOCK ThreadWork_holder
End Sub
'****************************************************************
'****************************************************************
Sub ThreadWork_close
MUTEXDESTROY ThreadWork_holder
ThreadWork_holder (0,1)
End Sub
'****************************************************************
'---------------------------------------------------------------------------------------'
Randomize Timer
const inputmaxlen=450
SUB InputThread (byref NULL as Integer)
dim key as string
dim cursor as integer=1
dim inputstring as string
ThreadWork_lock
color 0,15:locate 1,1,0:?space(80);
locate 1,1,0:color 0,7:?chr(32)
ThreadWork_unlock
do
key=inkey
If Len(key) Then
Select Case Key
'----------------------------'
Case chr(8) 'BackSpace
If Len(inputstring) And (Cursor > 1) Then
inputstring = Left(inputstring, Cursor - 2) + Right(inputstring, Len(inputstring) - Cursor + 1)
If Cursor>1 Then Cursor -= 1
End If
'----------------------------'
Case chr(255,83) 'Del
If (Cursor <= Len(inputstring)) Then
inputstring = Left(inputstring, Cursor - 1) + Right(inputstring, Len(inputstring) - Cursor)
End If
'----------------------------'
Case chr(13) 'Enter
Exit Do
'----------------------------'
Case chr(27) 'ESC
inputstring=""
'----------------------------'
Case Chr(255, 75) 'Left
If Cursor > 1 Then Cursor -= 1
'----------------------------'
Case Chr(255, 77) 'Right
If Cursor And (Cursor <= Len(inputstring)) Then Cursor += 1
'----------------------------'
Case Chr(255, 71) 'Pos1
If Cursor Then Cursor = 1
'----------------------------'
Case Chr(255, 79) 'End
If Cursor Then Cursor = Len(inputstring)+1
Case Else
If ( Len(inputstring) < inputmaxlen ) Then
inputstring = Left(inputstring, Cursor - 1) + Key + Right(inputstring, Len(inputstring) - (Cursor-1) )
Cursor += 1
End If
End Select
ThreadWork_lock
color 0,15
locate 1,1,0:?space(80);
locate 1,1,0:?inputstring;
Color 0,7
locate 1,Cursor,0:?chr(SCREEN (1, Cursor, 0))
ThreadWork_unlock
End If
sleep (5)
Loop until multikey(&h01)
End Sub
ThreadWork_init
Dim Eingabe as Any Ptr
Eingabe=ThreadCreate(@InputThread,0)
do
sleep (50)
ThreadWork_lock
color 4,0:locate int(rnd*80)+1,int(rnd*29)+2,0:?"A";
ThreadWork_unlock
loop until multikey(&h01)
ThreadWork_close
|
_________________
|
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 30.07.2007, 20:37 Titel: |
|
|
| Eternal_pain hat Folgendes geschrieben: | | Code: | ..
Case chr(8) 'BackSpace
.. |
|
..ich finde ja | Code: | Const BackSpace=!"\8"
..
Case BackSpace
.. |
mindestens genauso erkärend(ich liebe 'sprechende' Variablen)
@MisterD:
..zugegeben, nicht immer, aber immer öfter 
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 30.07.2007, 21:02 Titel: |
|
|
Durchaus sinnvoll aber nicht zwingend erforderlich wie ich finde...
ausserdem versuche ich (vorallem der uebersichtlichkeit wegen) auf zu viele Globale (shared und const) variablen zu verzichten...
sonst blickt man hinterher ohne kommentare (nicht selten auch mit) kaum
noch durch den source...
Const variablen beschraenke ich daher auf ein minimum und shared nutze ich gar nicht mehr...
_________________
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
