Ticker - Textlaufband | suche Code und Tipps
Verfasst: 14.03.2023 11:10
Hier ist mein Ticker, den ich so fast unverändert seit nunmehr 17 Jahren als Teil meines Infosystems laufen habe.
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?
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
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?
