Vollbildschirmtextscroller

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:

Beitrag von Batze »

Das mit dem abwärtsscrollen muss er ja auch selber machen.
Ich galube nicht das PM da von allein drauf gekommen wäre. Den Rest kannst du doch jetzt oder PM?
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Benutzeravatar
PMV
Beiträge: 2765
Registriert: 29.08.2004 13:59
Wohnort: Baden-Württemberg

Beitrag von PMV »

^^lol ... die unterhaltung war klar :mrgreen:

hatte die selbe Idee, habs mir aber verkniffen ... :lol: ganz im gegenteil^^

Code: Alles auswählen

;Konstanten definieren
Enumeration
  #ST_Up ;Text bewegt sich nach oben
  #ST_Down ;Text bewegt sich nach unten
  #ST_Right ;Text bewegt sich nach rechts
  #ST_Left ;Text bewegt sich nach links
EndEnumeration

;Strukturen definieren
Structure Scrolltext
  Nr.l
  X.f
  Y.f
  Text.s
  font.l
  CountString.l
  Size.l
EndStructure
;Linkedliste definieren
NewList Scrolltext.Scrolltext()

;erstellt ein Scrolltext und gibt die Indexnummer der Linkedliste zurück
Procedure CreateScrolltext(file.s, font.s, Size.l, Flag.l, StartX.l, StartY.l) 
  Protected hFile.l 
  ;springt zum letzten Element der Liste und erstellt eine neues Element
  LastElement(Scrolltext())
  AddElement(Scrolltext())
  ;übergibt die einzellnen übergebenen Werte dem neuen Scrolltextelemente
  Scrolltext()\Nr = Nr
  Scrolltext()\X = StartX
  Scrolltext()\Y = StartY
  Scrolltext()\Size = Size
  ;öffnet die übergebene Datei nur mit Lesezugriff
  hFile = ReadFile(#PB_Any, file)
  ;lädt einen Font mit den übergebenen Eigenschaften
  Scrolltext()\font = LoadFont(#PB_Any, font.s , Size, Flag) 
  ;prüfen, ob die Datei und den Font erfolgreich geöffnet/geladen wurden
  If hFile = #False Or Scrolltext()\font = #False
    ;wenn nicht Listenelement wieder löschen und mit einem Rückgabewert von -1 die Prozedur abbrechen
    DeleteElement(Scrolltext())
    ProcedureReturn -1
  EndIf
  ;wenn bis jetzt keine Fehler aufgetrehten sind, wird hier forgefahren
  ;durchläuft die gesammte Datei bis zum Ende und ließt jede Zeile aus
  ;zudem wird nach jeder Zeile ein '|' angehängt, um später die Zeilen auseinander
  ;halten zu können
  While Eof(hFile) = #False
    Scrolltext()\Text + ReadString() +"|"
  Wend
  ;schließen der Datei
  CloseFile(hFile)
  ;Zählt die übergebenen Zeilen
  Scrolltext()\CountString = CountString(Scrolltext()\Text, "|")
  ;Am ende des Scrolltextes steht nun auch ein '|', welches aber 1 Zeichen zu viel ist.
  ;Dieses Zeichen wird hier enfernt.
  Scrolltext()\Text = Left(Scrolltext()\Text, Len(Scrolltext()\Text) - 1)
  ;ist nun ein Text ausgelesen worden, so wird der ListIndex zurückgegeben
  ;ansonnsten -1 als Fehler
  If Scrolltext()\Text <> ""
    ProcedureReturn ListIndex(Scrolltext())
  Else
    ProcedureReturn -1
  EndIf
EndProcedure 

;bewegt den Scrolltext um Speed.f in die übergebenen Richtung (eng. Direction)
Procedure MoveScrolltext(Nr.l, Speed.f, Direction.b)
  ;Wenn die übergebene Scrolltext-Nummer ungülltig ist, wird #False zurückgegeben
  ;und die Prozedur abgebrochen
  If Nr < 0 Or Nr > CountList(Scrolltext())-1
    ProcedureReturn #False
  EndIf
  ;ansonnsten überbenes Element auswählen
  SelectElement(Scrolltext(), Nr)
  ;je nach übergebene Richtung den aktuellen Stand des Scrolltextes ändern
  Select Direction
    Case #ST_Up
      Scrolltext()\Y - Speed
    Case #ST_Down
      Scrolltext()\Y + Speed
    Case #ST_Right
      Scrolltext()\X + Speed
    Case #ST_Left
      Scrolltext()\X - Speed
  EndSelect
  ProcedureReturn #True
EndProcedure

;zeichnet den übergebenen Scrolltext und fährbt ihn mit der übergebenen Farbe ein
Procedure DrawScrolltext(Nr.l, color.l)
  ;Wenn die übergebene Scrolltext-Nummer ungülltig ist, wird #False zurückgegeben
  ;und die Prozedur abgebrochen
  If Nr < 0 Or Nr > CountList(Scrolltext())-1
    ProcedureReturn #False
  EndIf
  ;ansonnsten überbenes Element auswählen
  SelectElement(Scrolltext(), Nr)
  ;ändert den aktuellen Font auf den des Scrolltextes
  DrawingFont(UseFont(Scrolltext()\font)) 
  ;ändert den 'Zeichenmodus' für Text auf transparenten Hintergrund
  DrawingMode(1) 
  ;ändert die aktuelle Farbe auf übergebenen Farbe
  FrontColor(Red(color), Green(color), Blue(color)) 
  ;zeichnet den Scrolltext
  For Num = 1 To Scrolltext()\CountString
    Locate(Scrolltext()\X, Scrolltext()\Y + (Num-1) * Scrolltext()\Size)
    DrawText(StringField(Scrolltext()\Text, Num, "|"))
  Next 
  ProcedureReturn #True
EndProcedure 

;Initialisierungen
If InitSprite() = #False Or InitKeyboard() = #False
  MessageRequester("Error", "Initialisierungen fehlgeschlagen!")
  End
EndIf
;Screen öffnen
If OpenScreen(1024, 768, 32, "Lauftext") = #False
  MessageRequester("Error", "Screen konnte nicht geöffnet werden!")
  End
EndIf
;Scrolltext erstellen
hScrolltext = CreateScrolltext("lauftext.txt", "Courir", 100, #PB_Font_Italic, 0, 768)
If hScrolltext = -1 
  MessageRequester("Error", "Konnte Lauftext nicht erstellen!")
  End
EndIf 

;Hauptschleife
Repeat 
  ExamineKeyboard() 
  ClearScreen(0,0,0) 
  MoveScrolltext(hScrolltext, 0.5, #ST_Up)
  ;ist der Scrolltext oben verschwunden fängt er unten wieder an
  If Scrolltext()\Y < -Scrolltext()\Size * Scrolltext()\CountString
    Scrolltext()\Y = 1024
  EndIf
  StartDrawing(ScreenOutput())
  DrawScrolltext(hScrolltext, $FF0000)
  StopDrawing()
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_Escape)
^^Weil ich grad kurz am PC war und eh nichts Sinnvolles machen konnte hatte ich den Code von Batze mal kurz verändert ... und grad noch schnell fertig gemacht <) ...

^^Und schön lernen ... hoffe sind nicht zu viele Rechtschreibfehler in den kommentaren drinne /:-> ...
Und ich vermute mal, das du den Zeilenumbruch nicht so einfach Programmiert bekommst ... also das wenn die Zeile zu lang ist, ein automatischer Zeilenumbruch statt findet, aber das schafst du schon :wink: ... sonnst einfach ne möglichkeit überlegen, das du diesen nicht brauchst^^

Achja, ne Lauftext.txt Datei brauchst auch hier ... hab ja mit Batzes Code angefangen :D

MFG PMV
alte Projekte:
TSE, CWL, Chatsystem, GameMaker, AI-Game DLL, Fileparser, usw. -.-
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:

Beitrag von Batze »

Er wollte es ja mit einer Textdatei. :wink:
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Benutzeravatar
MVXA
Beiträge: 3823
Registriert: 11.09.2004 00:45
Wohnort: Bremen, Deutschland
Kontaktdaten:

Beitrag von MVXA »

> offensichtlich Anfänger sind
Seiner eigenen Aussage nach ist er aber kein Anfänger mehr.
Bin schon still ich böser böser Mensch ich.
Bild
Antworten