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

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 22.05.2011, 22:15 Titel: |
|
|
Und wie soll ich den Text dann weg kriegen? "Print" arbeitet unter minib3d nicht. |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
Verfasst am: 22.05.2011, 22:20 Titel: |
|
|
mod hat in seinem Beispiel den Text nochmal in der Hintergrundfarbe darüber geschrieben; eine andere Möglichkeit ist das Übermalen mit dem Hintergrund. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 22.05.2011, 22:23 Titel: |
|
|
In etwa so?
Code: | if status = 2 and timer > zeit + 5 then ' loeschen
Color RGB(0,0,0)
Draw String(xt,yt),text
Color RGB(255,255,255)
status = 0
end if |
Denn da passiert leider gar nichts.  |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
Verfasst am: 22.05.2011, 22:31 Titel: |
|
|
Wenn der Text noch aktuell ist (also nicht schon durch einen neuen ersetzt), dann sollte es funktionieren; sonst nimm halt LINE mit BF. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 22.05.2011, 22:38 Titel: |
|
|
Hm, soweit ich das sehe, kommt es bei mir nie zum Status 2, denn egal was ich unter "If status=2 and timer > zeit + 5" eintrage, es passiert nicht, es sei denn ich lasse das "and timer > zeit + 5" weg. Dann passiert es ... |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
Verfasst am: 22.05.2011, 22:59 Titel: |
|
|
Wenn er den Text ausgibt, dann wird auch status=2; geht nicht anders, weil beide Aktionen unter derselben Bedingung direkt hintereinander ausgeführt werden. <zitat>es sei denn ich lasse das "and timer > zeit + 5" weg</zitat> deutet auch darauf hin, dass es nicht am status, sondern eher an zeit liegt.
Oder meinst du, dass die zweite Meldung nicht die erste löscht, wenn diese noch aktiv ist? Das ist in der Tat so; warum, überlasse ich dir jetzt aber mal selbst als Aufgabe.  _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 22.05.2011, 23:54 Titel: |
|
|
Zitat: | Und wie soll ich den Text dann weg kriegen? "Print" arbeitet unter minib3d nicht. |
soweit ich weiss arbeitet cls.
Code: | Type MessageType
Message As ZString Ptr
ShowTime As Double
Next As MessageType Ptr
End Type
Dim Shared __Messages__ As MessageType Ptr
Declare Sub Message ( ByVal text as String, ByVal Tim As Double = 1 )
Declare Sub ShowMessages ()
Declare Sub UpdateMessages ()
Dim taste As Integer, meldung As String = ""
Print "Druecken Sie eine Taste. ESC beendet das Programm."
Do
taste = Asc(InKey)
If taste = 27 Then Exit Do
If taste > 0 Then
Dim Rn As Integer = Rnd*5+1
Message("ASCII-Code " & taste & " ShowTime "&Rn, Rn)
EndIf
UpdateMessages ()
Sleep 1
Loop
Sub Message ( ByVal text as String, ByVal Tim As Double = 1 )
Dim NewMessage As MessageType Ptr
NewMessage = Allocate(SizeOf(MessageType))
NewMessage->Next = __Messages__
__Messages__ = NewMessage
NewMessage->ShowTime = Timer+Tim
NewMessage->Message = Allocate(Len(text)+1)
*NewMessage->Message = text
ShowMessages ()
End Sub
Sub ShowMessages ()
Cls
Print "Druecken Sie eine Taste. ESC beendet das Programm."
Dim Me As MessageType Ptr
Me = __Messages__
Do Until Me = 0
Print *Me->Message
Me = Me->Next
Loop
End Sub
Sub UpdateMessages ()
Dim Me As MessageType Ptr
Dim L As MessageType Ptr
Dim D As MessageType Ptr
Dim Del As Integer
Me = __Messages__
Do Until Me = 0
If Me->ShowTime < Timer Then
If Me = __Messages__ Then
__Messages__ = Me->Next
EndIf
Del = -1
D = Me
Me = Me->Next
If L Then L->Next = D->Next
DeAllocate(D->Message)
DeAllocate(D)
Continue Do
EndIf
L = Me
Me = Me->Next
Loop
If Del Then ShowMessages ()
End Sub
|
nemored's code ein bischen erweitert. jetzt kann man so viele messages machen wie mann will. alle konnen ihre zeit haben. wenn eine neue message gekommen ist oder eine alte geloescht wurde werden alle messages neu geschrieben. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 23.05.2011, 10:04 Titel: |
|
|
Nemored, ich habe deinen Code so geändert.
Code: | Sub Message(text As String,tim As Integer =300)
Dim As Integer textl=Len(text)
Dim As Integer yt=768/2-64
Dim As Integer xt=1024/2-(textl*4)
Dim As Integer cl=0
static zeit as double = 0
Static status as integer = 0
static anzeige as string*17
if zeit = 0 then
zeit = timer
status = 1
end if
if anzeige <> text then
anzeige = text
status = 1
end if
if status = 1 then ' neu schreiben
Color RGB(255,255,cl)
Draw String(xt,yt),text
Color RGB(255,255,255)
status = 2
end if
if status = 2 and timer > zeit + 5 then ' loeschen
Color RGB(0,0,0)
Draw String(xt,yt),text
Color RGB(255,255,255)
status = 0
zeit=0
end if
Draw String(10,10),"Status: "+Str(status)+" | Timer: "+Str(timer)+" | Zeit: "+Str(zeit+5)
End Sub |
Nach 5 Sekunden verschwindet mein Text, allerdings taucht er beim nächsten Aufruf von "Message" auch nicht wieder auf. Seltsamerweise startet es auch mit dem Status 2. Ich weiß nicht wieso dein Code funktioniert, aber in wenig veränderter Weise bei mir nicht.
@XOR:
Dein Code funktioniert zwar, drückt in meinem Programm aber die FPS stark runter.
EDIT:
nemored, ich habe jetzt bei meinem Programm und deinem Code die selbe Funktion:
Code: | sub Message(text as string)
static zeit as double = 0, status as integer = 0, anzeige as string*17
Dim As Integer textl=Len(text)
Dim As Integer yt=768/2-64
Dim As Integer xt=1024/2-(textl*4)
Dim As Integer cl=0
if zeit = 0 or anzeige <> text then
zeit = timer
anzeige = text
status = 1
end if
if status = 1 then ' neu schreiben
color rgb(255,255,0)
Draw String(xt,yt),text
color rgb(255,255,255)
status = 2
end if
if status = 2 and timer > zeit + 5 then ' loeschen
color RGB(0,0,0)
Draw String(xt,yt),text
color rgb(255,255,255)
status = 0
end if
Draw String(10,10),"Status: "+Str(status)+" | Timer: "+Str(timer)+" | Zeit: "+Str(zeit+5)
end sub |
Das Merkwürdige ist, dass in meinem Programm die Variable "zeit" sich kontinuierlich erhöht, während sie sich in deinem Programm nur erhöht, wenn ich eine Taste drücke... |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
Verfasst am: 23.05.2011, 13:30 Titel: |
|
|
Bei mir wird zeit nur angepasst, wenn eine neue Meldung ausgegeben werden soll, das ist korrekt. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 23.05.2011, 20:49 Titel: |
|
|
Vielleicht geht es so besser:
Code: | Type MessageType
Message As ZString Ptr
ShowTime As Double
Next As MessageType Ptr
End Type
Dim Shared __Messages__ As MessageType Ptr
Declare Sub Message ( ByVal text as String, ByVal Tim As Double = 1 )
Declare Sub ShowMessages ()
Declare Sub UpdateMessages ()
Dim taste As Integer, meldung As String = ""
Screen 18,32
Print "Druecken Sie eine Taste. ESC beendet das Programm."
Do
taste = Asc(InKey)
If taste = 27 Then Exit Do
If taste > 0 Then
Dim Rn As Integer = Rnd*5+1
Message("ASCII-Code " & taste & " ShowTime "&Rn, Rn)
EndIf
UpdateMessages ()
Sleep 1
Loop
Sub Message ( ByVal text as String, ByVal Tim As Double = 1 )
Color RGB(0,0,0)
ShowMessages ()
Color RGB(255,255,255)
Dim NewMessage As MessageType Ptr
NewMessage = Allocate(SizeOf(MessageType))
NewMessage->Next = __Messages__
__Messages__ = NewMessage
NewMessage->ShowTime = Timer+Tim
NewMessage->Message = Allocate(Len(text)+1)
*NewMessage->Message = text
ShowMessages ()
End Sub
Sub ShowMessages ()
Dim As Integer XSP = 10, YSP = 20
Dim Me As MessageType Ptr
Me = __Messages__
Do Until Me = 0
Draw String(XSP,YSP), *Me->Message
YSP += 20
Me = Me->Next
Loop
End Sub
Sub UpdateMessages ()
Dim Me As MessageType Ptr
Dim L As MessageType Ptr
Dim D As MessageType Ptr
Dim Del As Integer
Me = __Messages__
Do Until Me = 0
If Me->ShowTime < Timer Then
If Del = 0 Then
Color RGB(0,0,0)
ShowMessages ()
Color RGB(255,255,255)
EndIf
If Me = __Messages__ Then
__Messages__ = Me->Next
EndIf
Del = -1
D = Me
Me = Me->Next
If L Then L->Next = D->Next
DeAllocate(D->Message)
DeAllocate(D)
Continue Do
EndIf
L = Me
Me = Me->Next
Loop
Color RGB(255,255,255)
If Del Then ShowMessages ()
End Sub
|
|
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 23.05.2011, 21:01 Titel: |
|
|
Ich wüsste nicht, inwiefern es funktionieren kann, wenn sich die Variable YSP kontinuierlich um 20 erhöht und so der Text 20 mal auf dem Bildschirm steht.
Auch wenn die Variable sich nicht erhöht, bleibt der Text stehen. |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 23.05.2011, 21:05 Titel: |
|
|
Zitat: | Ich wüsste nicht, inwiefern es funktionieren kann, wenn sich die Variable YSP kontinuierlich um 20 erhöht und so der Text 20 mal auf dem Bildschirm steht. |
YSP ist die Y Position. Diese erhoet sich mit jeder zeile, da man auch mehr als eine message haben kann. Wenn eine neue message kommt oder eine zu alt wird, werden alle messages schwarz ueberschrieben und danach neu geschrieben. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 23.05.2011, 21:09 Titel: |
|
|
Aber auch nur, wenn eine Message erscheint, sobald eine Bedingung einen bestimmten Wert hat und dieser sich danach sofort wieder ändert. Ist dies nicht der Fall, erscheint die Nachricht 20 mal auf dem Bildschirm, da YSP nicht aufhört, sich zu erhöhen. |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 23.05.2011, 21:21 Titel: |
|
|
Code: | Sub ShowMessages ()
Dim As Integer XSP = 10, YSP = 20
Dim Me As MessageType Ptr
Me = __Messages__
Do Until Me = 0
Draw String(XSP,YSP), *Me->Message
YSP += 20
Me = Me->Next
Loop
End Sub |
hier meinst du YSP. YSP ist am anfang immer 20.
Danach werden alle messeges durchgegangen di in einer liste stehen und angezeigt. Draw String(XSP,YSP), *Me->Message. dann kommt die nachste linie YSP += 20 und die nachste message Me = Me->Next am ende wenn Me = 0 ist wird der sub beendet. beim nachsten aufruf ist YSP wieder 20. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 23.05.2011, 21:22 Titel: |
|
|
...
YSP hört aber nicht auf sich zu erhöhen, schau selbst:
Code: | Do
taste = Asc(InKey)
If taste = 27 Then Exit Do
Dim Rn As Integer = Rnd*5+1
Message("ASCII-Code " & taste & " ShowTime "&Rn, Rn)
UpdateMessages ()
Sleep 1
Loop |
|
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 23.05.2011, 21:51 Titel: |
|
|
Zitat: | ...
YSP hört aber nicht auf sich zu erhöhen, schau selbst:
Code: | Do
taste = Asc(InKey)
If taste = 27 Then Exit Do
Dim Rn As Integer = Rnd*5+1
Message("ASCII-Code " & taste & " ShowTime "&Rn, Rn)
UpdateMessages ()
Sleep 1
Loop |
|
Du gibst jeden frame eine message die zwischen 1 und 6 sec. angezeigt wird. bei einer framezahl von 1000 FPS wahren das ca. 4000? messages. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 23.05.2011, 21:57 Titel: |
|
|
FPS sind bei mir ca. 100.
Aber das ist auch egal, Tatsache ist, dass es nicht funktioniert wie es soll.  |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 23.05.2011, 22:03 Titel: |
|
|
Warum brauchst du denn das mit den 5 sec wenn du ja jeden Frame eine neue message schreibst?
Code: | Type MessageType
Message As ZString Ptr
ShowTime As Double
Next As MessageType Ptr
End Type
Dim Shared __Messages__ As MessageType Ptr
Declare Sub Message ( ByVal text as String, ByVal Tim As Double = 1 )
Declare Sub ShowMessages ()
Declare Sub UpdateMessages ()
Dim taste As Integer, meldung As String = ""
Screen 18,32
Print "Druecken Sie eine Taste. ESC beendet das Programm."
Do
taste = Asc(InKey)
If taste = 27 Then Exit Do
If taste > 0 Then
Dim Rn As Integer = Rnd*5+1
Message("ASCII-Code " & taste & " ShowTime "&Rn, Rn)
EndIf
UpdateMessages ()
Sleep 1
Loop
Sub Message ( ByVal text as String, ByVal Tim As Double = 1 )
Color RGB(0,0,0)
ShowMessages ()
Color RGB(255,255,255)
Dim NewMessage As MessageType Ptr
NewMessage = Allocate(SizeOf(MessageType))
NewMessage->Next = __Messages__
__Messages__ = NewMessage
NewMessage->ShowTime = Timer+Tim
NewMessage->Message = Allocate(Len(text)+1)
*NewMessage->Message = text
ShowMessages ()
UpdateMessages ()
End Sub
Sub ShowMessages ()
Dim As Integer XSP = 10, YSP = 20
Dim Me As MessageType Ptr
Me = __Messages__
Do Until Me = 0
Draw String(XSP,YSP), *Me->Message
YSP += 20
Me = Me->Next
Loop
End Sub
Sub UpdateMessages ()
Dim Me As MessageType Ptr
Dim L As MessageType Ptr
Dim D As MessageType Ptr
Dim Del As Integer
Dim count As Integer
Me = __Messages__
Do Until Me = 0
count += 1
If Me->ShowTime < Timer Or Count > 10 Then
If Del = 0 Then
Color RGB(0,0,0)
ShowMessages ()
Color RGB(255,255,255)
EndIf
If Me = __Messages__ Then
__Messages__ = Me->Next
EndIf
Del = -1
D = Me
Me = Me->Next
If L Then L->Next = D->Next
DeAllocate(D->Message)
DeAllocate(D)
Continue Do
EndIf
L = Me
Me = Me->Next
Loop
Color RGB(255,255,255)
If Del Then ShowMessages ()
End Sub
|
nochmel was jetzt gehen aber nur noch 10 messages. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 23.05.2011, 22:08 Titel: |
|
|
Zitat: | Warum brauchst du denn das mit den 5 sec wenn du ja jeden Frame eine neue message schreibst? |
Was? Nein, wie kommst du jetzt dadrauf?
Ich möchte nur, dass ein Text 5 Sekunden an einer festen Position angezeigt wird, und zwar möchte ich dafür in der Hauptschleife nur einmal die Funtkion "Message" anwenden und nichts anderes. Ich verstehe nicht, wie da dein Code funktionieren soll? |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 23.05.2011, 22:18 Titel: |
|
|
Zitat: | Ich verstehe nicht, wie da dein Code funktionieren soll? |
Message (Text,Zeit) fuegt eine Message hinzu
ShowMessages () Zeigt alle message, soll man nicht aufrufen.
UpdateMessages () Schaut ob messages abgelaufen sin und loescht sie.
Mast du als in der function xy das ereignis z schreibst du Message(z,5)
und in der hauptschleife dann irgedwo UpdateMessages () und diese message wird 5 sec angezeigt. |
|
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.
|
|