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