Ticker - Textlaufband | suche Code und Tipps

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
stab
Beiträge: 92
Registriert: 24.02.2006 16:09
Computerausstattung: 286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Wohnort: Hardt
Kontaktdaten:

Ticker - Textlaufband | suche Code und Tipps

Beitrag von stab »

Hier ist mein Ticker, den ich so fast unverändert seit nunmehr 17 Jahren als Teil meines Infosystems laufen habe.

Code: Alles auswählen

; Auszug aus Programm"

MessageRequester("Hinweis","Programmabbruch mittels ESC")

; aktuelle Auflösung ermitteln
Global AuflBreite.l=GetSystemMetrics_(#SM_CXSCREEN)
Global AuflHoehe.l=GetSystemMetrics_(#SM_CYSCREEN)

;Fensterdaten
Global Dim FNr.b(5):For x = 1 To 5:FNr(x)=x : Next
Global Dim FPosX.l(5)
Global Dim FPosY.l(5)
Global Dim FBreite.l(5)
Global Dim FHoehe.l(5)
Global Dim FTitel.s(5): FTitel(4)="Ticker"
;Global Dim FFarbe(5) = $FFFFFF

;ticker
Global NewList Tickertexte.s() ;Textzeilen für Laufband
AddElement(Tickertexte()):Tickertexte()="Dies ist ein Beispieltext für mein Laufband. Zeile 1 "
AddElement(Tickertexte()):Tickertexte()="Nach Zeile 1 folgt dann die zweite Zeile mit einer weiteren wichtigen Nachricht. "
AddElement(Tickertexte()):Tickertexte()="Zum Schluss noch ein weiterer Hinweis. Dies ist dann Zeile Nummer 3. Weiter geht es wieder mit der ersten Zeile. "

Global posTickerzeile.s = "oben" ; "oben" oder "unten"
Global tickerzeigen.b = 1
;Farben Beispiele   000000 schwarz - FFFFFF weiss - 0000FF rot - FF0000 blau - 00FFFF gelb - 008000 grün 
Global tickerhintergrundfarbe=$0000FF  
Global tickertextfarbe=$000000 
Global tickerhoehe.w = 10
Global tickerfont.s = "Arial" ;"Utah" ;"Belgium" ;"Algerian" ;"Courier New" ;"Arial"
Global tickerfontstyle.l
Global tickerspeed.b = 5 ; kleiner = schneller
Global tickertext.s
Global tickerstop.b
;Global TickerMitUhrzeit.b

Declare _ticker(speed)
Declare oeffneFensterTicker()

For z = 1 To 5 ;maximale Fenstergröße für alle Fenster setzen
 FPosX(z)=0
 FPosY(z)=0
 FHoehe(z)=AuflHoehe
 FBreite(z)=AuflBreite
Next

If tickerzeigen
  FHoehe(4) = AuflHoehe * tickerhoehe / 100 ;Tickerfensterhöhe
   Select posTickerzeile
    Case "oben"
      ; For z = 1 To 3: FPosY(z) = FHoehe(4)  : Next :  FPosY(5) = FHoehe(4)   ;Startposition der Fenster 1-3 ändern
    Case "unten"
      ShowWindow_(FindWindow_("Shell_TrayWnd",""),#SW_HIDE)
      FPosY(4) = AuflHoehe - FHoehe(4) +1  ; Y-Position Tickerfenster ändern
  EndSelect
  oeffneFensterTicker()
EndIf


Procedure oeffneFensterTicker(); öffnet Fenster 4 Laufschrift und startet _ticker als Thread
  tickerschriftart = LoadFont(0,tickerfont,FHoehe(4)/2)
;  RegisterFontFile("B:\Compiler\_PUREBASIC\HARNGTON.TTF"):tickerschriftart = LoadFont(0,"HARNGTON",FHoehe(4)/2)
  OpenWindow(FNr(4),FPosX(4),FPosY(4),FBreite(4),FHoehe(4),FTitel(4),#PB_Window_BorderLess)
          ;  AddWindowTimer(FNr(4), FNr(4), 2000)  
            AddKeyboardShortcut(FNr(4), #VK_ESCAPE, 1)
  SetWindowColor(FNr(4), tickerhintergrundfarbe) 
  _ticker = CreateThread(@_ticker(),tickerspeed)
EndProcedure

Procedure _ticker(speed)
  Repeat
    ForEach Tickertexte()
      ;If tickerstop = 1 : Break : EndIf
      If StartDrawing(WindowOutput(FNr(4)))
        DrawingFont(FontID(0))
            tw = TextWidth(tickertexte())
            For xpos = FBreite(4) To -(tw) Step -1 : Delay(speed) 
              DrawText(xpos,tickerhoehe, tickertexte(), tickertextfarbe, tickerhintergrundfarbe)
            Next                  
      StopDrawing()
     EndIf
   Next
 Until tickerstop = 1
 tickerstop = 0
 ;aendereTickertext() ; ruft diesen Thread wieder auf 
 EndProcedure 

Repeat
  Select WaitWindowEvent(1)
      Case #PB_Event_Menu
        ShowWindow_(FindWindow_("Shell_TrayWnd",""),#SW_SHOW)
        If IsThread(_ticker): KillThread(_ticker): EndIf
        End
  EndSelect
ForEver
 
Im Wesentlichen habe ich das Codeschnipsel damals aus dem PB Forum hier abgeschrieben.
Obwohl sich nie ein Kunde beschwert hat, versuchte ich immer, das Teil zu optimieren, so dass es ohne ruckeln und zuckeln und mit so wenig wenig CPU-Auslastung wie möglich über den Bildschirm läuft. Die Systeme laufen teilweise 24Std. Eine Zeit lang hatte ich dann auch die gleichen Fonts-Probleme wie 'Ara'.
http://forums.purebasic.com/german/vie ... c66f459fe

Auf einmal nach Umstieg von XP auf W7 lief das Laufband mit gewissen Fonts extrem langsam. Experimente mit RegisterFontFile halfen auch nicht. Einzig allein die Umstellung auf "Courier New" als Font, das ging immer. Mittlerweile scheint das Problem erledigt. Habe gerade auf meinem W10 Rechner noch mal getestet und alle Fonts laufen sauber durch. Ich schaue aber immer wieder neidisch auf die schönen Textlaufbänder bei n-tv oder wie sie alles heißen. So sauber habe ich das nie hinbekommen.

Dazu auch noch eine Frage:
Die Laufbänder laufen im Gegensatz zu den hier veröffentlichten Codes ohne Unterbrechnung durch Leerzeichen.
Ich meine folgendes:

Beispiel: Der String "Purebasic ist toll" läuft durch.
Am Ende steht "l ". Erst dann fängt das Ganze wieder mit P an. " P"

Bei den Professionals im TV läuft die Schleife ohne Leerzeichen-Unterbrechnungen.
Als Beispiel wäre der Bildschirmausschnitt wie folgt: "c ist toll. Purebasi"
Um das hinzubekommen müsste ich mir so eine Art Zylinder programmieren, auf dem der Text steht, dieser dann gedreht wird.

Oder hat jemand solch einen Code parat?
Paul sagt: "Max lügt."
Max sagt: "Otto lügt."
Otto sagt: "Max und Paul lügen."

Wer lügt hier wirklich und wer sagt die Wahrheit?

_________________________________________

286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Benutzeravatar
dige
Beiträge: 1182
Registriert: 08.09.2004 08:53

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von dige »

Direkt auf ein Fenster zu zeichnen kann zum flackern führen, falls das Fenster sich neu zeichnet. Spontan würde ich das ganze auf Canvas umstellen, weil hier die Ausgabe gepuffert ist.

Um den Ticker ohne Leerlauf zu programmieren würde ich zunächst die Länge des Textes in Pixeln ermitteln und ggf. den Text verdoppeln, damit genug Zeichen für die volle Bildschirmbreite vorhanden sind. Wenn ich Zeit habe, bastel ich mal was ;-)
"Papa, mein Wecker funktioniert nicht! Der weckert immer zu früh."
Benubi
Beiträge: 186
Registriert: 22.10.2004 17:51
Wohnort: Berlin, Wedding

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von Benubi »

Cool, habe ich mir erstmal gesichert...

Ich habe bei einem alten "Projekt" einen Lauftext Gadget für meine Sprite GUI geschrieben, mit XML importer bevor PureBasic die XML Lib implementiert hatte btw. Das Ganze lief in einer Endlos-Schleife, um den von Dir benannten Effekt hinzubekommen. Dabei ist nur wichtig das Rendern auszulassen falls der Gadget-Text leer ist ;)
Zeilen-Umbrüche werden zu Leerzeichen konvertiert. Ich glaube ich hatte einen Flag eingesetzt, damit beide Effekte auswählbar waren (leerer balken vs Text wiederholen bzw. anbinden). Mich hat fasziniert, dass Lauftexte auch mal blinken können, von/nach oben/unten verschoben werden können und Farbschnickschnack, jedenfalls bei den "Analogen" Lauftexten die verschiedene Gewerbe in den Schaufenstern haben. Nun so viel konnte mein Lauftext auch nicht, ich habe mir überlegt eine kleine Meta-Sprache einzubauen mit irgendwelchen Steuerzeichen damit dann solche Funktionen nutzen könnte, aber das war mir dann zu lang und das "Projekt" ist eh, wie eigentlich immer, auf Grund gelaufen.

Die Profis im TV benutzen garantiert spezielle Hardware und Software die man als normal sterblicher kaum erwerben kann. Sicherlich werden diese nicht über einen Desktop Output rendern - sondern eher im "Fullscreen" mit schnellen 2D/3D GraKas. Ich nehme an, daß sie z.B. für Chroma-Key usw. auch dedizierte Chips einsetzen. Auch könnten sie Sachen immer ein paar Millisekunden vorberechnen, über Threads oder anders nicht-blockend ausgelagert, um dann einfach eine Ruckelfreie Animation Frame für Frame zu zeichenen - sodaß man eventuelle Ruckler ausschließen kann. Ist aber nur so wie ich mir das vorstelle.
Benutzeravatar
stab
Beiträge: 92
Registriert: 24.02.2006 16:09
Computerausstattung: 286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Wohnort: Hardt
Kontaktdaten:

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von stab »

@dige
Spontan würde ich das ganze auf Canvas umstellen, weil hier die Ausgabe gepuffert ist.
Mit dem Canvas-Gadget habe ich noch nicht viel gearbeitet. Hatte mal testweise angefangen, das darauf zu transportieren und hatte erstmal nur Schlieren.
Wenn ich Zeit habe, bastel ich mal was
Gerne, danke. Sollst aber auch nicht meine Arbeit machen.

@benubi
Ja, ich hatte mir auch schon einiges überlegt. Text steht und blinkt und läuft dann weiter.
Oder die aktuelle Uhrzeit mit date() wird angefügt. Hier war nur das Problem, dass sich mittendrin dabei die Textlänge ändert und die Berechnung dann nicht mehr stimmt.
Auch den Text von unten einblenden zu lassen. Darf dann halt nur eine bestimme Länge nicht überschreiten bzw. muss eine automatisache Texttrennung mit rein.
Seltsamerweise hab ich dem Ticker immer mehr Aufmerksamkeit gewidmet als es die Kunden taten. Ist halt ein Programmierspaß und ein schönes Gimmick.
Paul sagt: "Max lügt."
Max sagt: "Otto lügt."
Otto sagt: "Max und Paul lügen."

Wer lügt hier wirklich und wer sagt die Wahrheit?

_________________________________________

286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
ccode_new
Beiträge: 1214
Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von ccode_new »

Hi!

Müssen die Ticker alle verschiedene Fenster sein?

Es wäre extrem einfacher wenn alle Ticker auf einem Fenster liefen.
Eventuell könnte man ja bestimmte Fensterausschnitte transparent machen.

Oder man startet jeden Ticker als eigenes Programm.
(Eventuell mit Parameterübergabe)

Und von einer Verwendung des direkten WindowOutput würde ich auch erstmal abraten.
Das CanvasGadget wäre da eine bessere Idee.

Ein wichtiger Tipp:
Zeichne am besten den Text erst auf ein Image und scrolle dann dieses Bild pixelweise.

->
Ich habe mal was gebastelt, aber ich glaube eine direkte Canvas-Ausgabe wäre besser.
Außerdem sollte man am besten "High-Resolution"-Timer verwenden.
(Man könnte bei meinem Beispiel mehrere Bilder erstellen und diese hintereinander versetzt anzeigen lassen.)

Code: Alles auswählen

;Window-Ticker-Test

ExamineDesktops()

;-Global
Global.i ScreenWidth = DesktopWidth(0)
Global.i ScreenHeight = DesktopHeight(0)

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  #MAX_TEXTURWIDTH = 8192
CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux
  #MAX_TEXTURWIDTH = 6144
CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
  #MAX_TEXTURWIDTH = 6144
CompilerEndIf

Structure TTickerWindow
  nr.i ;ticker number (id)
  
  posx.i ;window x-pos
  posy.i ;window y-pos
  
  width.i ;window width
  height.i;window height
  
  titel.s ;window title
  
  bgcolor.l
  textcolor.l
  
  font.s
  fontstyle.l
  
  speed.w ;ticker speed
  
  tx.i ;text x-pos
  ty.i ;text y-pos
  tw.i ;text width
  th.i ;text height
  
  List text.s() ;ticker text (list)
  line.i
  
  show.b ;show/hide the text
  stop.b ;stop the ticker
EndStructure

Global Dim Ticker.TTickerWindow(5)

Global NewList Tickertexte.s() ;Textzeilen für Laufband
AddElement(Tickertexte()):Tickertexte()="Dies ist ein Beispieltext für mein Laufband. Zeile 1 "
AddElement(Tickertexte()):Tickertexte()="Nach Zeile 1 folgt dann die zweite Zeile mit einer weiteren wichtigen Nachricht. "
AddElement(Tickertexte()):Tickertexte()="Zum Schluss noch ein weiterer Hinweis. Dies ist dann Zeile Nummer 3. Weiter geht es wieder mit der ersten Zeile. "

;-Functions

Declare TickerWindow(nr.i, titel.s, List text.s(), width.i, height.i, px.i = 0, py.i = 0)

Declare SetTickerColor(nr.i, textcolor.l, bgcolor.l)
Declare SetTickerFont(nr.i, tickerfont.s, tickerfontstyle = 0)
Declare SetTickerTitle(nr.i, title.s)
Declare SetTickerText(nr.i, List text.s())
Declare SetTickerPosition(nr.i, px.i, py.i)
Declare SetTickerShow(nr.i, show.b)
Declare SetTickerStop(nr.i, stop.b)
Declare SetTickerSpeed(nr.i, speed.w)

Declare DrawTicker(nr.i)

Declare CloseTicker(nr.i)

Declare SetTickerImage(nr.i)

; Change Text-Image
Procedure SetTickerImage(nr.i)
  Protected.s mtext
  
  If IsWindow(nr)
    If Ticker(nr)\line >= 0 And Ticker(nr)\line < ListSize(Ticker(nr)\text())
      SelectElement(Ticker(nr)\text(), Ticker(nr)\line)
    ElseIf Ticker(nr)\line >= ListSize(Ticker(nr)\text())
      Ticker(nr)\line = 0
    EndIf
    
    If IsImage(nr)
      StartDrawing(ImageOutput(nr))
      
      ForEach Ticker(nr)\text()
        mtext + Ticker(nr)\text() + " "
      Next
      
      SelectElement(Ticker(nr)\text(), Ticker(nr)\line)
      
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(nr))
      
      Ticker(nr)\tw = TextWidth(mtext)
      Ticker(nr)\th = TextHeight(mtext)
      
      If Ticker(nr)\tw <= 0 Or Ticker(nr)\tw > #MAX_TEXTURWIDTH
        MessageRequester("Oversize!", ~"Die maximale Texturgröße wurde überschritten!\n\n" +
                                      "Verwenden Sie mehrere Bilder, oder änderen Sie die Textlänge.", #PB_MessageRequester_Error)
        End 0
      EndIf
      
      Box(0, 0, OutputWidth(), OutputHeight(), Ticker(nr)\bgcolor)
      
      DrawText(0, (Ticker(nr)\height / 2) - (Ticker(nr)\th / 2), mtext, Ticker(nr)\textcolor)
      
      StopDrawing()
      
      SetGadgetState(nr, ImageID(nr))
      
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

; Default-TickerWindow
Procedure TickerWindow(nr.i, titel.s, List text.s(), width.i, height.i, px.i = 0, py.i = 0)
  Protected.i tw, th
  Protected.s mtext
  
  If nr >= 0 And nr < ArraySize(Ticker())
    
    ;initTickerWindow
    With Ticker(nr)
      \nr = nr
      
      \width = width
      \height = height
      \posx = px
      \posy = py
      \titel = titel
      
      \show = #False
      
      \bgcolor = RGB(255, 0, 0)
      \textcolor = RGB(0, 0, 0)
      
      \font = "Arial" ;"Utah" ;"Belgium" ;"Algerian" ;"Courier New" ;"Arial"
      \fontstyle = 0
      
      \speed = Int(1000 / DesktopFrequency(0))
      
      \stop = #True
      
      \tx = width
      
      CopyList(text(), \text())
      
      \line = 0
    EndWith
    
    If LoadFont(nr, Ticker(nr)\font, Ticker(nr)\height / 2, Ticker(nr)\fontstyle)
      
      ;openTickerWindow
      If OpenWindow(nr, Ticker(nr)\posx, Ticker(nr)\posy, Ticker(nr)\width, Ticker(nr)\height, Ticker(nr)\titel)
        
        SetWindowColor(nr, Ticker(nr)\bgcolor)
        
        ForEach Ticker(nr)\text()
          mtext + Ticker(nr)\text() + " "
        Next
        
        If CreateImage(nr, #MAX_TEXTURWIDTH, WindowHeight(nr))
          StartDrawing(ImageOutput(nr))
          DrawingMode(#PB_2DDrawing_Transparent)
          DrawingFont(FontID(nr))
          
          Ticker(nr)\tw = TextWidth(mtext)
          Ticker(nr)\th = TextHeight(mtext)
          
          Box(0, 0, OutputWidth(), OutputHeight(), Ticker(nr)\bgcolor)
          
          StopDrawing()
          
          If Ticker(nr)\tw <= 0 Or Ticker(nr)\tw > #MAX_TEXTURWIDTH
            MessageRequester("Oversize!", ~"Die maximale Texturgröße wurde überschritten!\n\n" +
                                          "Verwenden Sie mehrere Bilder, oder änderen Sie die Textlänge.", #PB_MessageRequester_Error)
            End 0
          Else
            ResizeImage(nr, Ticker(nr)\tw, WindowHeight(nr))
          EndIf
        Else
          ProcedureReturn #False
        EndIf
        
        If IsImage(nr)
          ContainerGadget(nr+100, 0, 0, WindowWidth(nr), WindowHeight(nr))
          SetGadgetColor(nr+100, #PB_Gadget_BackColor, Ticker(nr)\bgcolor)
          ImageGadget(nr, 0, 0, WindowWidth(nr), WindowHeight(nr), ImageID(nr))
          CloseGadgetList()
        Else
          ProcedureReturn #False
        EndIf
        
        SelectElement(Ticker(nr)\text(), Ticker(nr)\line)
        
        SetTickerImage(nr)
        
        AddWindowTimer(nr, nr, Ticker(nr)\speed)
        
        AddKeyboardShortcut(nr, #PB_Shortcut_Escape, 1)
      Else
        ProcedureReturn #False
      EndIf
      
    Else
      ProcedureReturn #False
    EndIf
    
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure SetTickerColor(nr.i, textcolor.l, bgcolor.l)
  If IsWindow(nr)
    With Ticker(nr)
      \textcolor = textcolor
      \bgcolor = bgcolor
    EndWith
    SetWindowColor(nr, bgcolor)
    SetGadgetColor(nr+100, #PB_Gadget_BackColor, bgcolor)
    SetTickerImage(nr)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerFont(nr.i, tickerfont.s, tickerfontstyle = 0)
  If IsWindow(nr)
    With Ticker(nr)
      \font = tickerfont
      \fontstyle = tickerfontstyle
    EndWith
    If IsFont(nr)
      FreeFont(nr)
      If LoadFont(nr, Ticker(nr)\font, Ticker(nr)\height / 2, Ticker(nr)\fontstyle)
        SetTickerImage(nr)
      Else
        ProcedureReturn #False
      EndIf
    Else
      ProcedureReturn #False
    EndIf
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerTitle(nr.i, title.s)
  If IsWindow(nr)
    Ticker(nr)\titel = title
    SetWindowTitle(nr, title)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerText(nr.i, List text.s())
  If IsWindow(nr)
    CopyList(text(), Ticker(nr)\text())
    SetTickerImage(nr)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerPosition(nr.i, px.i, py.i)
  If IsWindow(nr)
    With Ticker(nr)
      \posx = px
      \posy = py
    EndWith
    ResizeWindow(nr, px, py, Ticker(nr)\width, Ticker(nr)\height)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerShow(nr.i, show.b)
  If IsWindow(nr)
    Ticker(nr)\show = show
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerStop(nr.i, stop.b)
  If IsWindow(nr)
    Ticker(nr)\stop = stop
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure SetTickerSpeed(nr.i, speed.w)
  If IsWindow(nr)
    Ticker(nr)\speed = speed
    RemoveWindowTimer(nr, nr)
    AddWindowTimer(nr, nr, Ticker(nr)\speed)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure


Procedure DrawTicker(nr.i)
  If IsWindow(nr) And Ticker(nr)\stop = #False
    
    If Ticker(nr)\tx > -Ticker(nr)\tw
      Ticker(nr)\tx - 1
    EndIf
    
    ResizeGadget(nr, Ticker(nr)\tx, #PB_Ignore, #PB_Ignore, #PB_Ignore)
    
    Ticker(nr)\stop = #False
    
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure 


Procedure CloseTicker(nr.i)
  If IsWindow(nr)
    RemoveWindowTimer(nr, nr)
    Ticker(nr)\stop = #True
    Ticker(nr)\show = #False
    CloseWindow(nr)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure


;-Main

TickerWindow(0, "Ticker", Tickertexte(), ScreenWidth, 100)

SetTickerTitle(0, "Ticker 1")

SetTickerSpeed(0, 20)
SetTickerStop(0, #False)
SetTickerShow(0, #True)


NewList DemoText.s()
AddElement(DemoText()) : DemoText() = "Guten Tag!" + Space(100)
AddElement(DemoText()) : DemoText() = "Good afternoon!" + Space(100)
AddElement(DemoText()) : DemoText() = "Bonne journée!" + Space(100)
AddElement(DemoText()) : DemoText() = "Dobrý den!" ;+ Space(100)
                                                   ;AddElement(DemoText()) : DemoText() = "buenos días!" + Space(100)

TickerWindow(1, "Ticker 2", Tickertexte(), ScreenWidth, 100, 0, 500)

SetTickerColor(1, RGB(255, 0, 0), RGB(255, 255, 0))
SetTickerFont(1, "Times", #PB_Font_Italic)

SetTickerText(1, DemoText())

SetTickerSpeed(1, 6)
SetTickerStop(1, #False)
SetTickerShow(1, #True)

Repeat
  If IsWindow(0) Or IsWindow(1)
    WndEvent = WindowEvent()
    AWindow = EventWindow()
    
    Select WndEvent
      Case #PB_Event_Timer
        Select EventTimer()
          Case 0
            If Ticker(0)\tx <= -Ticker(0)\tw
              SelectElement(Ticker(0)\text(), 0)
              
              Ticker(0)\tx = Ticker(0)\width
              SetTickerImage(0)
            EndIf
            
            DrawTicker(0)
          Case 1
            If Ticker(1)\tx <= -Ticker(1)\tw
              SelectElement(Ticker(1)\text(), 0)
              
              Ticker(1)\tx = Ticker(1)\width
              SetTickerImage(1)
            EndIf
            
            DrawTicker(1)
        EndSelect
      Case #PB_Event_Menu
        Break
      Case #PB_Event_CloseWindow
        CloseTicker(AWindow)
    EndSelect
  Else
    quit = #True
    Break
  EndIf
Until quit = #True

End 1
Hinweise:
1. DrawText() erstellt ja intern auch nur ein Bild des Textes.
2. Für reinen Text würde es auch reichen ein TextGadget per ResizeGadget-Befehl über das Fenster zu verschieben.

Code: Alles auswählen

;Simple Ticker-Test
ExamineDesktops()

Global.i evt

Global.i Ticker

Global.i tw, th, tx, ty

Global speed = 3

Global.s TickerText = "Guten Tag!" + Space(20) +
                      "Good afternoon!" + Space(20) +
                      "Bonne journée!" + Space(20) +
                      "Dobrý den!" + Space(20) +
                      "buenos días!" + Space(20) +
                      "Хороший день!" + Space(20) +
                      "Buona giornata!" + Space(20) +
                      "Jó nap!" + Space(20) +
                      "Goededag!" + Space(20) +
                      "Hyvää päivää!" + Space(20)
                    

Debug TickerText

Procedure.i GetTextWidth(win.i, font.i, txt.s)
  Protected dtw.i
  If IsFont(font) And IsWindow(win)
    StartDrawing(WindowOutput(win))
      DrawingFont(FontID(font))
      dtw = TextWidth(txt)
    StopDrawing()
    ProcedureReturn dtw  
  EndIf
  ProcedureReturn #False
EndProcedure


If OpenWindow(0, 10, 10, DesktopWidth(0), 100, "Ticker")
  
  SetWindowColor(0, RGB(255,0,0))
  
  LoadFont(0, "Arial", WindowHeight(Ticker)-10, 0)
  
  tx = WindowWidth(0) 
  
  tw = GetTextWidth(0, 0, TickerText)
  
  Debug tw
  
  Ticker = TextGadget(#PB_Any, tx, 0, tw, WindowHeight(0), TickerText)
  
  SetGadgetFont(Ticker, FontID(0))
  SetGadgetColor(Ticker, #PB_Gadget_BackColor, RGB(255,0,0))
  SetGadgetColor(Ticker, #PB_Gadget_FrontColor, RGB(255,255,0))
  
  AddWindowTimer(0, 0, speed)
  
  Repeat
    evt = WaitWindowEvent(1)
    
    Select evt
      Case #PB_Event_Timer
        Select EventTimer()
          Case 0
            If tx <= -tw
              tx = WindowWidth(0)
            Else
              tx - 1
            EndIf
            ResizeGadget(Ticker, tx, #PB_Ignore, #PB_Ignore, #PB_Ignore)
        EndSelect
    EndSelect
    
  Until evt = #PB_Event_CloseWindow
  
EndIf
Extra:

Code: Alles auswählen

;Simple Ticker-Test2 ("Litfaßsäulen (Zylinder)" - optimierte Version ;) )
ExamineDesktops()

Global.i evt

Global.i Ticker, Ticker2

Global.i tw, th, tx, ty

Global.i speed = 10

Global.s TickerText = "Purebasic ist toll"

Debug TickerText

Procedure.i GetTextWidth(win.i, font.i, txt.s)
  Protected dtw.i
  If IsFont(font) And IsWindow(win)
    StartDrawing(WindowOutput(win))
    DrawingFont(FontID(font))
    dtw = TextWidth(txt + " ")
    StopDrawing()
    ProcedureReturn dtw  
  EndIf
  ProcedureReturn #False
EndProcedure


If OpenWindow(0, 10, 10, DesktopWidth(0), 100, "Ticker")
  
  SetWindowColor(0, RGB(255,0,0))
  
  LoadFont(0, "Arial", WindowHeight(Ticker)-20, 0)
  
  tw = GetTextWidth(0, 0, TickerText)
  
  tx = -tw
  
  Debug tw
  
  Ticker = TextGadget(#PB_Any, tx, 0, tw, WindowHeight(0), TickerText)
  Ticker2 = TextGadget(#PB_Any, (tx+WindowWidth(0)), 0, tw, WindowHeight(0), TickerText)
  
  SetGadgetFont(Ticker, FontID(0))
  SetGadgetColor(Ticker, #PB_Gadget_BackColor, RGB(255,0,0))
  SetGadgetColor(Ticker, #PB_Gadget_FrontColor, RGB(255,255,0))
  
  SetGadgetFont(Ticker2, FontID(0))
  SetGadgetColor(Ticker2, #PB_Gadget_BackColor, RGB(255,0,0))
  SetGadgetColor(Ticker2, #PB_Gadget_FrontColor, RGB(255,255,0))
  
  AddWindowTimer(0, 0, speed)
  
  Repeat
    evt = WaitWindowEvent(1)
    
    Select evt
      Case #PB_Event_Timer
        Select EventTimer()
          Case 0
            If tx >= WindowWidth(0)
              tx - WindowWidth(0)
            Else
              tx + 1
            EndIf
            ResizeGadget(Ticker, tx, #PB_Ignore, #PB_Ignore, #PB_Ignore)
            ResizeGadget(Ticker2, (tx - WindowWidth(0)), #PB_Ignore, #PB_Ignore, #PB_Ignore)
        EndSelect
    EndSelect
    
  Until evt = #PB_Event_CloseWindow
  
EndIf
Betriebssysteme: div. Windows, Linux, Unix - Systeme

no Keyboard, press any key
no mouse, you need a cat
DePe
Beiträge: 153
Registriert: 26.11.2017 16:17
Wohnort: Wien
Kontaktdaten:

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von DePe »

Hallo stab,

hier gibt es ein Modul für einen Lauftext:
https://www.purebasic.fr/english/viewtopic.php?t=77077

Und hier einen längeren Thread, mit Link auf das obige Modul:
https://www.purebasic.fr/english/viewtopic.php?t=77015

Peter
Benutzeravatar
stab
Beiträge: 92
Registriert: 24.02.2006 16:09
Computerausstattung: 286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Wohnort: Hardt
Kontaktdaten:

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von stab »

@code_new

Hallo,
wow, sowas mal schnell hingebastelt, super. Danke.

Ein kleines Missverständnis. Mein Tickerfenster gibt es im Programm nur einmal. Sorry, wenn das falsch rüberkam.
Ich habe den Code-Abschnitt aus dem Programm herausgezogen. Deshalb die Verwirrung.
Zur Veranschaulichung, die anderen Fenster haben andere Inhalte: https://sb-edv.de/dienstleistungen/infosystem

Du hast anstatt WindowOutput() ImageOutput() verwendet. Läuft bei mir quälend langsam.
Das hatte ich auch schon getestet. Mit WindowOutput() läuft es bei mir eigentlich am besten.
Auch wenn davon immer abgeraten wird.
High-Resolution"-Timer? Sagt mir erstmal nichts. Was ist das?

Die Textzeilen aneinandergehängt laufen ja auch einmal durch, bevor es die Wiederholung gibt.
Ich möchte eigentlich folgende Idee umsetzen:

Code: Alles auswählen

text$="Diese Zeile wiederholt sich laufend. "
OpenConsole("Console")
EnableGraphicalConsole(1)
While text$
  PrintN(text$)
  zl$=Left(text$,1)
  text$=text$+zl$
  text$=Right(text$,Len(text$)-1)
  Delay(100)
  ClearConsole()
Wend
Was ich halt noch nicht probiert habe, ist es, das Ganze auf das CanvasGadget zu projezieren.
Meine ersten Versuche waren gescheitert. :|
Paul sagt: "Max lügt."
Max sagt: "Otto lügt."
Otto sagt: "Max und Paul lügen."

Wer lügt hier wirklich und wer sagt die Wahrheit?

_________________________________________

286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Benutzeravatar
stab
Beiträge: 92
Registriert: 24.02.2006 16:09
Computerausstattung: 286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Wohnort: Hardt
Kontaktdaten:

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von stab »

Hallo Peter,

habe gerade erst Deine Nachricht gelesen.
Danke für die Links.
Hier wird ja das Canvas eingesetzt.
Werde ich mir die nächsten Tage mal anschauen.
Danke und Grüße
Paul sagt: "Max lügt."
Max sagt: "Otto lügt."
Otto sagt: "Max und Paul lügen."

Wer lügt hier wirklich und wer sagt die Wahrheit?

_________________________________________

286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
ccode_new
Beiträge: 1214
Registriert: 27.11.2016 18:13
Wohnort: Erzgebirge

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von ccode_new »

stab hat geschrieben: 20.03.2023 19:34 Hallo,
wow, sowas mal schnell hingebastelt, super. Danke.
Danke, war keine große Sache.
stab hat geschrieben: 20.03.2023 19:34 Du hast anstatt WindowOutput() ImageOutput() verwendet. Läuft bei mir quälend langsam.
Das hatte ich auch schon getestet. Mit WindowOutput() läuft es bei mir eigentlich am besten.
Auch wenn davon immer abgeraten wird.
High-Resolution"-Timer? Sagt mir erstmal nichts. Was ist das?
ImageOutput läuft bei dir langsam?
Ok!
Welche Hardware hast du?

Auch wenn du die Speed-Werte herab setzt, oder/und z.b. die tx-1 auf tx-10 (text_x_position) setzt?

Auf die High-Resolution-Timer bin ich auch erst jetzt vor kurzen so richtig gestoßen.
Im Englischen-Forum gibt es da z.B. dieses Modul:
https://www.purebasic.fr/english/viewto ... r&start=15 (StarBootics)

Anbei:
Das Modul verwendet fast 1:1 den "Timer-Code" der auch in der physac - Include der "raylib" steht.

Insgesamt sind das etwas präziser arbeitende Timer.

Aber insgesamt dürfte das für einen "Ticker" (Laufband) keine Rolle spielen.
stab hat geschrieben: 20.03.2023 19:34 Die Textzeilen aneinandergehängt laufen ja auch einmal durch, bevor es die Wiederholung gibt.
Ich möchte eigentlich folgende Idee umsetzen: ...
Das verstehe ich nicht ganz.
Möchtest du die Textzeilen jeweils nur einzeln ausgeben lassen?
(Also nicht zusammen hängend.)

Für den Effekt mit dem Verschwinden auf der einen Seite und dem Auftauchen auf der anderen Seite könnte man ein 2. identisches Bild nehmen.
Dieses Bild würde dann versetzt mitlaufen.
(Das war/ist halt meine kleine bescheidene einfache Idee.)
Betriebssysteme: div. Windows, Linux, Unix - Systeme

no Keyboard, press any key
no mouse, you need a cat
Benutzeravatar
stab
Beiträge: 92
Registriert: 24.02.2006 16:09
Computerausstattung: 286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Wohnort: Hardt
Kontaktdaten:

Re: Ticker - Textlaufband | suche Code und Tipps

Beitrag von stab »

Hallo ccode_new

meine Hardware ist schlicht und einfach ein in die Jahre gekommener Office-PC i7-4790.
Das sollte aber eigentlich für einen Ticker ausreichen. Letztendlich läuft meine Software auf NIC's.
Das verstehe ich nicht ganz.
Möchtest du die Textzeilen jeweils nur einzeln ausgeben lassen?
(Also nicht zusammen hängend.)
Es ging mir um folgenden Effekt:

falsch:

Code: Alles auswählen

NewList text$()
AddElement(text$()): text$()="Boris schon wieder im Knast"
AddElement(text$()): text$()="Mick das 17. mal Vater"
AddElement(text$()): text$()="Gerhard jetzt auch bei China-Gaz im Aufsichtsrat"
lz$="                                                                             "
ResetList(text$())

OpenConsole("Console")
EnableGraphicalConsole(1)

While NextElement(text$())
text$=lz$+text$()
While Len(text$) > 0
  PrintN(text$)
  text$=Right(text$,Len(text$)-1)
  Delay(100)
  ClearConsole()
Wend
If ListIndex(text$())+1 = ListSize(text$()): ResetList(text$()): EndIf
Wend
richtig:

Code: Alles auswählen

text1$="Boris schon wieder im Knast # "
text2$="Mick das 17. mal Vater # "
text3$="Gerhard jetzt auch bei China-Gaz im Aufsichtsrat # "
text$=text1$ + text2$ + text3$
OpenConsole("Console")
EnableGraphicalConsole(1)
While text$
  PrintN(text$)
  zl$=Left(text$,1)
  text$=text$+zl$
  text$=Right(text$,Len(text$)-1)
  Delay(100)
  ClearConsole()
Wend

Der Auszug aus GFX_Wizzard_BF sieht aber schon ziemlich perfekt aus.
http://forums.purebasic.com/english/vie ... a9ee7d753b
https://www.purebasic.fr/english/viewtopic.php?t=77077

Super Laufband.
Werde versuchen, das jetzt zu extrahieren und auf meine gewünschten Maße (ganze Bildschirmbreite) zu projizieren.
Den Beitrag mit den vielen Beispielen hatte ich auch schon mal gelesen. Irgendwie aber wohl die finale Version von saki übersehen.

Danke noch mal.
Zuletzt geändert von stab am 21.03.2023 16:56, insgesamt 1-mal geändert.
Paul sagt: "Max lügt."
Max sagt: "Otto lügt."
Otto sagt: "Max und Paul lügen."

Wer lügt hier wirklich und wer sagt die Wahrheit?

_________________________________________

286er Big Tower; 16MHz; 1MB Ram; 40MB Festplatte, 5 1/4" und 3 1/2" Diskettenlaufwerk; VGA Farbmonitor 14"; Windows 3.1; PureBasic 0.5
Antworten