 |
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 |
Nullchecker
Anmeldungsdatum: 03.08.2013 Beiträge: 34
|
Verfasst am: 10.08.2013, 13:01 Titel: Laufschrift (Smooth-Scrolling) |
|
|
Kann mir jemand ein Komplettbeispiel posten, wie ich das Wort "Test"
Ruckel- und Flimmerfrei von Rechts nach Links ziehen kann, wobei das grosse "T" sobald es links verschwunden ist, Rechts wieder erscheint.
Arbeite mit Screen 17. |
|
Nach oben |
|
 |
Westbeam

Anmeldungsdatum: 22.12.2009 Beiträge: 760
|
Verfasst am: 10.08.2013, 15:33 Titel: |
|
|
Code: | Draw String(x,y),"T"
Draw String(x+8,y),"e"
Draw String(x+16,y),"s"
Draw Strin(x+24,y),"t"
x-=1
If x=0 Then x=xmax |
Normalerweise posten wir auch keine Komplettbeispiele, da man daraus nicht viel lernt, aber da es gerade so einfach war, habe ich es mal gemacht.
http://www.freebasic-portal.de/projekte/openbook-2d-spieleprogrammierung-59.html
http://www.freebasic-portal.de/tutorials/
Lies mal. |
|
Nach oben |
|
 |
volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1876 Wohnort: D59192
|
Verfasst am: 10.08.2013, 16:20 Titel: |
|
|
Hi,
ich stelle hier mal ein funktionierendes Beispiel ein.
Es nutzt aber schon einige Tricks die nicht so einfach sind.
Abgeleitet ist es von meinem Beitrag zum Programmierwettbewerb#7
http://www.freebasic-portal.de/downloads/programmierwettbewerbe/fbcc-7-laufschrift-291.html
Code: | Screen 17,32
Dim As String text ="T e s t"'Laufschrift
Dim As Any Ptr Image = ImageCreate( Len(text)*8+4, 16, 0)'Image erstellen
Draw String Image,(2,0), text, &Hff5555'Text in das Image schreiben
Dim As Integer i, x, ix, iy
ScreenInfo x
ImageInfo image, ix, iy
For i = x To 0 Step -2 'Image am rechten Rand in den Screen schieben
Put (i,0),image, PSet' bis zum linken Rand
Sleep 30,1
Next
Do 'Endlosschleife bis ESC gedrückt wird
For i = 0 To ix Step 2
Put (0,0),image,(i,0)-(ix, iy), PSet' am linken Rand herausschieben
Put (x-i,0),image, PSet'Image am rechten Rand in den Screen schieben
Sleep 30,1
If InKey = Chr(27) Then Exit Do
Next
For i = x-ix To 0 Step -2' bis zum linken Rand
Put (i,0),image, PSet
Sleep 30,1
If InKey = Chr(27) Then Exit Do
Next
Loop
If image Then ImageDestroy image |
_________________ Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
Nach oben |
|
 |
Nullchecker
Anmeldungsdatum: 03.08.2013 Beiträge: 34
|
Verfasst am: 10.08.2013, 18:34 Titel: Re: Laufschrift (Smooth-Scrolling) |
|
|
Erst mal vielen Dank euch beiden für euere schnelle Antwort.
@ Westbeam : Dein Beispiel sieht ja recht einfach aus, da es so aber nicht
Lauffähig ist, bringt es mir leider nicht viel.
@ volta: Ist genau das, was ich wollte. Allerdings für mich als Anfänger recht harter Tobak, werde mich da mal in Ruhe mit auseinandersetzen. Auf jeden Fall kann ich die Routine in mein Programm einbinden.
Ich gebe Westbeam ja recht, das jeder nicht alles Komplett vorgekaut bekommen sollte. Da ich FB - Anfänger bin, und normalerweise nur
Textbasierte Anwendungen schreiben möchte, war das Scrollprogramm
eigentlich nur als "Schmankerl" in meinem Programm vorgesehen.
Von daher sehe ich die "Komplettlösung" eher als Anreiz, mich vielleicht
später mal mit dieser Thematik intensiv auseinander zusetzen an. |
|
Nach oben |
|
 |
Muttonhead

Anmeldungsdatum: 26.08.2008 Beiträge: 565 Wohnort: Jüterbog
|
Verfasst am: 10.08.2013, 18:47 Titel: |
|
|
...Mist, jetzt hätte ich das grad zum "bättel" oder Programmierwettbewerb ausgerufen...
Code: | screen 17,32
dim as string scrolltext="Scrolltexttest "
dim as integer scrw,scrh,charspace,i,k,xpos,charxpos
screeninfo scrw,scrh
charspace=20
k=len(scrolltext)
redim as integer charxpositions(k-1)
for i=0 to k-1
charxpositions(i)=scrw-1 + i*charspace
next i
do
screenlock
cls
for i=0 to k-1
charxpositions(i) -=1
if (charxpositions(i)<scrw) then
draw string (charxpositions(i),scrh/2),mid(scrolltext,i+1,1)
end if
if charxpositions(i)<=-charspace then charxpositions(i)= scrw-1
next i
screenunlock
sleep 10
loop until inkey<>"" |
edit: funzt aber nur wenn Textlänge nicht "länger" als Screenbreite ist, hab ich grad festgestellt
Mutton |
|
Nach oben |
|
 |
Nullchecker
Anmeldungsdatum: 03.08.2013 Beiträge: 34
|
Verfasst am: 10.08.2013, 19:17 Titel: |
|
|
@Muttonhead
Habe dein Beispiel auch ausprobiert, läuft genauso toll.
Mir raucht der Schädel, weil dein Programm ja völlig anders ist als
das von volta.
Vielen Dank auch an dich für dein Beispiel. |
|
Nach oben |
|
 |
volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1876 Wohnort: D59192
|
Verfasst am: 10.08.2013, 19:37 Titel: |
|
|
Code: | Screen 17, 32
Color &Hffff33, 255
Cls
Print "Programmierwettbewerb #Muttonhead"
Dim As String scrolltext = Trim(Mki(1819042120) +Mki(1700208751) +Mki(538997868))
Dim As Integer scrw, scrh, charspace, i, k, xpos, charxpos
ScreenInfo scrw,scrh
charspace = 8
k = Len(scrolltext)-1
ReDim As Integer charxpositions(k)
For i = 0 To k
charxpositions(i) = scrw-1 + i*charspace
Next i
Do
ScreenLock
Line (0,scrh\2)-(scrw,scrh\2+16),255,bf
For i = 0 To k
charxpositions(i) -=1
If (charxpositions(i)<scrw) Then _
Draw String (charxpositions(i),scrh\2), Chr(scrolltext[i])
If charxpositions(i) <= -charspace Then charxpositions(i) = scrw-1
Next i
ScreenUnLock
Sleep 10
Loop Until Inkey <> "" |  _________________ Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4699 Wohnort: ~/
|
Verfasst am: 10.08.2013, 23:49 Titel: |
|
|
Zitat: | @ Westbeam : Dein Beispiel sieht ja recht einfach aus, da es so aber nicht
Lauffähig ist, bringt es mir leider nicht viel. |
Der Vorteil an Westbeams Programm ist, dass sehr gezielt den Abschnitt ausführt, auf den es ankommt. Es handelt sich jedoch nur um einen einzigen Programmschritt, der mehrmals (optimalerweise in einer Schleife) durchgeführt werden muss. Um es unverändert laufen zu lassen, taugt es gar nicht; als Denkanstoß, wie man für eine Laufschrift vorgehen kann, dafür umso mehr.
(Westbeam, ich frage mich nur, warum du jeden Buchstaben einzeln zeichnest, wenn sie dann doch von einer gemeinsamen x-Position abhängen ... ) _________________ 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: 11.08.2013, 08:50 Titel: |
|
|
Er wollte jeden Buchstaben ja einzeln neu zeichnen, sobald er verschwindet. Ich dachte, dass er es so am einfachsten verstehen würde.  |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4699 Wohnort: ~/
|
Verfasst am: 11.08.2013, 11:48 Titel: |
|
|
Hmm, ich verstehe die Frage nicht so. Wenn die Schrift links verschwindet, soll sie rechts wieder auftauchen; allerdings soll nicht erst der ganze Text verschwinden müssen, bevor der neue Schriftzug auftaucht. Am einfachsten geht das, indem man zweimal die Zeichenkette schreibt (wie in voltas erstem Beispiel). Einzeln schieben geht natürlich auch, muss man halt mehr Positionen speichern. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
Muttonhead

Anmeldungsdatum: 26.08.2008 Beiträge: 565 Wohnort: Jüterbog
|
Verfasst am: 11.08.2013, 12:36 Titel: |
|
|
...da didaktisch hier jetzt nichts mehr zu retten ist
ohne Längenbegrenzung "let it scroll"
Code: | screen 17, 32
color &hffff33, 255
cls
print "programmierwettbewerb #muttonhead... soll ich wirklich so frech sein? ;P"
print "jetzt kann der Scrolltext beliebig lang sein :)"
'dim as string scrolltext = trim(mki(1819042120) +mki(1700208751) +mki(538997868))
dim as string scrolltext = " Kann mir jemand ein Komplettbeispiel posten, wie ich das Wort Test Ruckel- und Flimmerfrei von Rechts nach Links ziehen kann, wobei das grosse T sobald es links verschwunden ist, Rechts wieder erscheint. Arbeite mit Screen 17."
dim as integer scrw, scrh, charspace, i, k, xpos, charxpos, flipchar,preflipchar
screeninfo scrw,scrh
charspace = 20
k = len(scrolltext)-1
redim as integer charxpositions(k)
for i = 0 to k
charxpositions(i) = scrw + i*charspace
next i
preflipchar=k
flipchar=0
do
screenlock
line (0,scrh\2)-(scrw,scrh\2+16),255,bf
for i = 0 to k
charxpositions(i) -=1
if (charxpositions(i)<scrw) then _
draw string (charxpositions(i),scrh\2), chr(scrolltext[i])
next i
screenunlock
if (charxpositions(flipchar) <= -charspace) and (charxpositions(preflipchar)< scrw-1) then
if flipchar=0 then
charxpositions(flipchar)=scrw
else
charxpositions(flipchar)=charxpositions(preflipchar)+charspace
end if
preflipchar=flipchar
flipchar =(flipchar+1) mod (k+1)
end if
sleep 5
loop until inkey <> "" |
edit: Code nochmal korrigiert, sollte jetzt klappen
Mutton |
|
Nach oben |
|
 |
Nullchecker
Anmeldungsdatum: 03.08.2013 Beiträge: 34
|
Verfasst am: 11.08.2013, 16:26 Titel: |
|
|
Leute, nichts übertreiben, ihr seid alle gut drauf und habt mir enorm weiter
geholfen.
Beide Lösungen sind toll, irgendwann werde ich sie auch komplett verstehen.
(Ich komme in den nächsten 15 Jahren darauf zurück )
Also kein Battle etc., ich plädiere für Unentschieden.
Werde gleich ein neues Thema einstellen, da könnt ihr euch ja wieder
erneut "batteln"  |
|
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.
|
|