PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Ticker - Textlaufband | suche Code und Tipps

https://www.purebasic.fr/german/viewtopic.php?t=32941

Seite 2 von 2

Re: Ticker - Textlaufband | suche Code und Tipps

Verfasst: 21.03.2023 13:16
von ccode_new
Huhu,
ich werde mal, wenn ich Zeit finde, ein Laufband proggen, wo man die Buchstaben einzeln zur Laufzeit modifizieren kann, und die Position der einzelnen Buchstaben verändern kann. Dies wäre für Sprung oder individuelle Farbwechseleffekte ganz gut.

Entweder werde ich das CanvasGadget verwenden, oder evtl. dass OpenGL-Gadget.

Anbei:
Ich habe gesehen wie sehr mein TextGadget Beispiel auf einem echten Windowssystem flackert.
Unter Linux/MacOs wird das Alles immer doppelt gepuffert.

Unter Windows müsste man da tiefer in die Windows-API Trickkiste greifen und das Zeichnen auf das passende WM-PAINT - Event verlegen, oder so ähnlich.
???

Re: Ticker - Textlaufband | suche Code und Tipps

Verfasst: 21.03.2023 20:21
von stab
So, ich denke, ich habe gefunden was ich gesucht habe.

Das sieht alles sehr gut aus.
Ist ein Auszug aud dem GFX_Wizzard_BF Modul.
http://forums.purebasic.com/english/vie ... a9ee7d753b

Code: Alles auswählen

DeclareModule ScrollingText_BF
  EnableExplicit
  Declare CreateTextImage_ST(text$,
                             font_ID,
                             text_color=#Black,
                             background_color=#White,
                             text_alignment=0)            ; text_alignement 0=left - 1=right - 2=center
  Declare ScrollTextImage_H_ST(image_ID,                  ; Horizontal scrolling
                               step_width=1)
  Declare TextOffset_X_ST(TextOffset_X_ST_)               ; Adjust the text output position X
  Declare TextOffset_Y_ST(TextOffset_Y_ST_)               ; Adjust the text output position Y
  Declare TextImage_Width_ST(TextImage_Width_ST_)         ; Adjust the text image width
  Declare TextImage_Height_ST(TextImage_Height_ST_)       ; Adjust the text image height
  Declare GetTextLineHeight_ST()                          ; Get the line height - For creating vertical text steps
EndDeclareModule

Module ScrollingText_BF
  ; Text scrolling - By Saki - DPI aware - This is a part from GFX_Wizzard_BF
  
  Global GradientColor_Pos_ST.d, Gradient_Pos_Color_ST, CreateMaskedAlphaImage_ST
  Global ActivateLinearGradient_ST, LinearGradient_X_ST, LinearGradient_Y_ST, LinearGradient_XX_ST, LinearGradient_YY_ST
  Global TextOffset_X_ST, TextOffset_Y_ST, TextImage_Width_ST, TextImage_Height_ST, GetTextLineHeight_ST
  
  Procedure.d VectorTextWidth_Multiline_Pro_BF(text$, flag=#PB_VectorText_Default)
    If FindString(text$, #CR$)
      text$=ReplaceString(text$, #CRLF$, #LF$)
      text$=ReplaceString(text$, #LFCR$, #LF$)
      ReplaceString(text$, #CR$, #LF$, #PB_String_InPlace)
    EndIf
    Protected i, width.d, result.d=0.0, count=CountString(text$, #LF$)
    For i=0 To count
      width=VectorTextWidth(StringField(text$, i+1, #LF$), flag)
      If width>result
        result=width
      EndIf
    Next
    ProcedureReturn result
  EndProcedure
  
  Procedure.d VectorTextHeight_Multiline_Pro_BF(text$, flag=#PB_VectorText_Default)
    If FindString(text$, #CR$)
      text$=ReplaceString(text$, #CRLF$, #LF$)
      text$=ReplaceString(text$, #LFCR$, #LF$)
      ReplaceString(text$, #CR$, #LF$, #PB_String_InPlace)
    EndIf
    ProcedureReturn VectorTextHeight(" ", flag)*(CountString(text$,#LF$)+1)
  EndProcedure
  
  Procedure CreateTextImage_ST(text$,
                               font_ID,
                               text_color=#Black,
                               background_color=#White,
                               text_alignment=0)
    
    Protected image_ID=CreateImage(#PB_Any, 16, 16, 24, background_color)
    If Not image_ID : ProcedureReturn 0 : EndIf
    If Not StartVectorDrawing(ImageVectorOutput(image_ID)) : FreeImage(image_ID) : ProcedureReturn 0 : EndIf
    VectorFont(FontID(font_ID))
    GetTextLineHeight_ST=VectorTextHeight(" ")
    Protected text_width=VectorTextWidth_Multiline_Pro_BF(text$)
    Protected text_height=VectorTextHeight_Multiline_Pro_BF(text$)
    Protected text_offset_x ; Optional adjustment variables
    Protected text_offset_y
    Protected image_size_offset_x
    Protected image_size_offset_y
    
    If Not (FindString(text$, #LF$)|FindString(text$, #CRLF$)|FindString(text$, #LFCR$))
      text_alignment=0
    EndIf
    
    Select text_alignment
      Case 0 ; Left
        Protected flag=#PB_VectorParagraph_Left
        CompilerIf #PB_Compiler_OS=#PB_OS_Windows
          text_offset_x=VectorTextWidth(" ")*1.5
          image_size_offset_x+VectorTextWidth(" ")*1.5
        CompilerEndIf
        CompilerIf #PB_Compiler_OS=#PB_OS_Linux
          text_offset_x=VectorTextWidth(" ")
          image_size_offset_x+VectorTextWidth(" ")
        CompilerEndIf
        CompilerIf #PB_Compiler_OS=#PB_OS_MacOS
          text_offset_x=VectorTextWidth(" ")/0.5
          image_size_offset_x+VectorTextWidth("  ")
        CompilerEndIf
      Case 1 ; Right
        flag=#PB_VectorParagraph_Right
        CompilerIf #PB_Compiler_OS=#PB_OS_Windows
          text_offset_x=-VectorTextWidth(" ")/5
          image_size_offset_x+VectorTextWidth("  ")
        CompilerEndIf
        CompilerIf #PB_Compiler_OS=#PB_OS_Linux
          text_offset_x=VectorTextWidth(" ")/1.6
          image_size_offset_x+VectorTextWidth("  ")
        CompilerEndIf
        CompilerIf #PB_Compiler_OS=#PB_OS_MacOS
          text_offset_x=-VectorTextWidth(" ")/4
          image_size_offset_x+VectorTextWidth("  ")
        CompilerEndIf
      Case 2 ; Centered
        flag=#PB_VectorParagraph_Center
        CompilerIf #PB_Compiler_OS=#PB_OS_Windows
          text_offset_x=VectorTextWidth("  ")/2.5
          image_size_offset_x+VectorTextWidth("  ") 
        CompilerEndIf
        CompilerIf #PB_Compiler_OS=#PB_OS_Linux
          text_offset_x=VectorTextWidth(" ")
          image_size_offset_x+VectorTextWidth("  ")
        CompilerEndIf
        CompilerIf #PB_Compiler_OS=#PB_OS_MacOS
          text_offset_x=VectorTextWidth(" ")/1.2
          image_size_offset_x+VectorTextWidth("  ")
        CompilerEndIf
    EndSelect
    
    StopVectorDrawing()
    
    If Not (FindString(text$, #LF$)|FindString(text$, #CRLF$)|FindString(text$, #LFCR$))
      CompilerIf #PB_Compiler_OS=#PB_OS_Windows
        text_height*1.2 ; Mono line output - enlarge text image height a little
      CompilerEndIf
      CompilerIf #PB_Compiler_OS=#PB_OS_Linux
        text_height*1.1
      CompilerEndIf
      CompilerIf #PB_Compiler_OS=#PB_OS_MacOS
        text_height*1.2
      CompilerEndIf
    EndIf
    
    text_width+text_offset_x
    text_height+text_offset_y
    
    ResizeImage(image_ID, text_width+TextImage_Width_ST+image_size_offset_x, text_height+TextImage_Height_ST+image_size_offset_y)
    
    StartVectorDrawing(ImageVectorOutput(image_ID))
    
    If ActivateLinearGradient_ST
      VectorSourceLinearGradient(LinearGradient_X_ST, LinearGradient_Y_ST, LinearGradient_XX_ST, LinearGradient_YY_ST)
      VectorSourceGradientColor($FF000000|Gradient_Pos_Color_ST, GradientColor_Pos_ST.d)
    Else
      VectorSourceColor($FF000000|text_color)
    EndIf
    
    VectorFont(FontID(font_ID))
    MovePathCursor(TextOffset_X_ST+text_offset_x, TextOffset_Y_ST)
    If FindString(text$, #LF$)|FindString(text$, #CRLF$)|FindString(text$, #LFCR$)
      DrawVectorParagraph(text$, text_width, 32e3, flag)
    Else
      DrawVectorText(text$)
    EndIf
    StopVectorDrawing()
    ProcedureReturn image_ID
  EndProcedure
  
  Procedure ScrollTextImage_H_ST(image_ID,
                                 step_width=1)
    step_width*DesktopResolutionX()
    If step_width<1 : step_width=1 : EndIf
    Protected text_width=ImageWidth(image_ID)
    Protected text_height=ImageHeight(image_ID)
    If Not StartDrawing(ImageOutput(image_ID)) : ProcedureReturn 0 : EndIf
    Protected temp_image_1_ID=GrabDrawingImage(#PB_Any, 0, 0, step_width, text_height)
    If Not temp_image_1_ID : ProcedureReturn 0 : EndIf
    Protected temp_image_2_ID=GrabDrawingImage(#PB_Any, step_width, 0, text_width-step_width, text_height)
    If Not temp_image_2_ID : FreeImage(temp_image_1_ID) : ProcedureReturn 0 : EndIf
    DrawImage(ImageID(temp_image_1_ID), text_width-step_width, 0)
    DrawImage(ImageID(temp_image_2_ID), 0, 0)
    StopDrawing() 
    FreeImage(temp_image_1_ID) : FreeImage(temp_image_2_ID)
    ProcedureReturn image_ID
  EndProcedure
  
  Procedure TextOffset_X_ST(TextOffset_X_ST_)
    TextOffset_X_ST=TextOffset_X_ST_
  EndProcedure
  
  Procedure TextOffset_Y_ST(TextOffset_Y_ST_)
    TextOffset_Y_ST=TextOffset_Y_ST_
  EndProcedure
  
  Procedure TextImage_Width_ST(TextImage_Width_ST_)
    TextImage_Width_ST=TextImage_Width_ST_
  EndProcedure
  
  Procedure TextImage_Height_ST(TextImage_Height_ST_)
    TextImage_Height_ST=TextImage_Height_ST_
  EndProcedure
  
  Procedure GetTextLineHeight_ST()
    ProcedureReturn GetTextLineHeight_ST
  EndProcedure
  
  
EndModule

UseModule ScrollingText_BF

; ###### Get the result ######

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  UsePNGImageDecoder()
  ExamineDesktops()
  Define window_ID=OpenWindow(#PB_Any, 0 ,0 ,DesktopWidth(0) ,DesktopHeight(0)/12 ,"Scrolling text BF" ,#PB_Window_BorderLess)
  
  
  SetWindowColor(window_ID, $909090)
  
  Define font_ID=LoadFont(#PB_Any,"Tahoma", DesktopHeight(0)/20) ; TODO Used font size     Tahoma
  
  Define text_color=#Yellow
  Define background_color=#Blue
  
  Define text_alignement=2 ; Text alignement 0=left - 1=right - 2=center -  TODO Text alignment
  Define text_h$=" -  Boris schon wieder im Knast  -  Mick das 17. Mal Vater  -  Gerhard auch bei China-Gaz im Aufsichtsrat"
  Global image_h_ID=CreateTextImage_ST(text_h$, font_ID, text_color, background_color)
  FreeImage(image_h_ID)
  Global image_h_ID=CreateTextImage_ST(text_h$, font_ID, text_color, background_color, text_alignement)

  #CanvasOutput=#True ; Choose CanvasGadget for output or ButtonImageGadget - For ButtonImageGadget the WinOS stutter fix is deactivated
  
                     Global winOS_stutter_Fix=1
  If #CanvasOutput
     Global gadget_2_ID=CanvasGadget(#PB_Any,0,0,1920,100)
  EndIf
  ; Scroll horizontal
  Procedure DrawScrollingText_H()
    SetGadgetAttribute(gadget_2_ID, #PB_Button_Image, ImageID(image_h_ID))
    If winOS_stutter_Fix
      ScrollTextImage_H_ST(image_h_ID, 2) ; 1 = Step width
    Else
      ScrollTextImage_H_ST(image_h_ID, 1) ; 1 = Step width
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  #BindEventMethod=#False ; Try what you want - On Win10 it works better without BindEvent
  
  Define speed_ms=10 ; Speed ms delay
  
  Procedure WaitForVerticalBlank() ; WinOS - Stutter fix - Use not with ButtonImageGadget - By Chi 
    CompilerIf #PB_Compiler_OS=#PB_OS_Windows
      If winOS_stutter_Fix
        Static *ddraw.IDirectDraw
        If Not *ddraw
          DirectDrawCreate_(0, @*ddraw, 0)
        EndIf
        *ddraw\WaitForVerticalBlank(1, 0)
      EndIf
    CompilerEndIf
  EndProcedure
  
  If #BindEventMethod
    ; BindEvent method
    AddWindowTimer(window_ID, 1, speed_ms/DesktopResolutionX()) ; Speed
    BindEvent(#PB_Event_Timer, @DrawScrollingText_H())
    Repeat
      Define win_event=WaitWindowEvent()   
    Until win_event=#PB_Event_CloseWindow
  Else
    ; Timer method
    Define time
    Repeat
      Delay(1)
      WaitForVerticalBlank()
      If ElapsedMilliseconds()>time
        time=ElapsedMilliseconds()+speed_ms ; Speed
        DrawScrollingText_H()
      EndIf
      Repeat
        Define win_event=WindowEvent()
        If win_event=#PB_Event_CloseWindow 
          End
        EndIf
      Until Not win_event 
    ForEver 
  EndIf
  
CompilerEndIf
Danke an alle !!!

Re: Ticker - Textlaufband | suche Code und Tipps

Verfasst: 09.04.2023 09:02
von Ara
Bei mir war es damals einfach eine große Laufschrift mit Uhrzeit, was beim Wechsel der Sekunden extrem ruckelte.
Hier die Lösung, die ich für mich gefunden habe, an das Laufband ein wenig angepasst.
Es ist nicht die sauberste Programmierung, aber vielleicht kann es jemand gebrauchen und für seine Zwecke anpassen.

Code: Alles auswählen

If InitSprite() = 0 Or InitKeyboard() = 0
  MessageRequester("Error", "Can't open the sprite system", 0)
  End
EndIf

EnableExplicit

Enumeration Window
  #Ticker_Window
EndEnumeration

Global Width.l = GetSystemMetrics_(#SM_CXSCREEN)                                      ;Bildschirmauflösung X
Global Height.l = GetSystemMetrics_(#SM_CYSCREEN)                                     ;Bildschirmauflösung Y
Global TickerHeight.l = Height / 15                                                   ;Tickerhöhe
Global speed.d = 0.3                                                                  ;Geschwindigkeit

Global FontWinkel.d = 15
Global Font.s = "Arial"
Global FontSize.l = TickerHeight * 0.6
Global SchattenFarbe.i = RGB(80, 80, 80)
Global SchattenX = 3
Global SchattenY = 1

Global TickerText.s, tmpTickerText.s

Global Dim Text.s(0)

Global xsize.d, xpos1.d, xpos2.d, textl.d
Global a, j, l, le, n, spr, t
Global tmA.d

Structure werte
  sprite.i            ;Spritenummer für Zeichen
  schatten.i          ;Sprite Nummer für Schatten
  schattenx.d         ;Schattenabstand X
  schatteny.d         ;Schattenabstand Y
  tmA.d               ;Basislinie von oben
  tmD.d               ;Basislinie von unten
  tmH.d               ;Texthöhe
  tmW.d               ;Textbreite
EndStructure

Global NewMap Zeichen.werte()

;[color=#rrggbb] setzt die Farbe
TickerText = "[color=#ff0000]Dies ist ein Beispieltext für ein Laufband. Zeile 1   "
TickerText + "[color=#0080ff]Nach Zeile 1 folgt dann die zweite Zeile mit einer weiteren wichtigen Nachricht (Datum). %ww, %d. %mmmm %yyyy   "
TickerText + "[color=#ff8040]Zum Schluß noch die Uhrzeit: %hh:%ii:%ss Uhr. Dies ist dann Zeile Nummer 3. Weiter geht es wieder mit der ersten Zeile.   "

;Sprite im Winkel verzerren
Procedure TransformChar(Sprite.s, Winkel.d)
  Protected X1.d = Zeichen(Sprite)\tmA*Tan(Radian(fontwinkel))
  Protected X2.d = Zeichen(Sprite)\tmW+Zeichen(Sprite)\tmA*Tan(Radian(fontwinkel))
  Protected X3.d = Zeichen(Sprite)\tmW+Zeichen(Sprite)\tmD*Tan(Radian(fontwinkel))* -1
  Protected X4.d = Zeichen(Sprite)\tmD*Tan(Radian(fontwinkel))* -1
  TransformSprite(Zeichen(Sprite)\sprite, X1, 0, X2, 0, X3, Zeichen(Sprite)\tmH, X4, Zeichen(Sprite)\tmH)
  TransformSprite(Zeichen(Sprite)\schatten, X1, 0, X2, 0, X3, Zeichen(Sprite)\tmH, X4, Zeichen(Sprite)\tmH)
EndProcedure

;Text bereinigen
Procedure.s Replace_LineBreaks_to_LF(text$)
  If FindString(text$, #CR$)
    text$=ReplaceString(text$, #CRLF$, #LF$)
    text$=ReplaceString(text$, #LFCR$, #LF$)
    ReplaceString(text$, #CR$, #LF$, #PB_String_InPlace)
  EndIf
  If CreateRegularExpression(0, "\[color=#[0-9a-fA-F]{6}\]")
    text$ = ReplaceRegularExpression(0, text$, "")
  EndIf
  ProcedureReturn text$
EndProcedure

;Zeichengröße ermitteln
Procedure getTextInfo(t.s, text$)
  Protected tm.TEXTMETRIC
  Protected lg.SIZE
  ;Protected font = Zeichen(t)\sprite
  Protected hdc = GetWindowDC_(WindowID(#Ticker_Window))
  text$ = Replace_LineBreaks_to_LF(text$)
  If text$
    SelectObject_(hdc, FontID(0))
    GetTextMetrics_(hdc, @tm.TEXTMETRIC)
    GetTextExtentPoint32_(hdc, text$, Len(text$), @lg.SIZE)
    Zeichen(t)\tmA = tm\tmAscent
    Zeichen(t)\tmD = tm\tmDescent
    Zeichen(t)\tmH = tm\tmHeight
    Zeichen(t)\tmW = lg\cx
    ReleaseDC_(WindowID(#Ticker_Window), hdc)
  EndIf
EndProcedure

;Farb String zerlegen
Procedure.i SplitString(string$, delimiter$, Array a.s(1))
  If CreateRegularExpression(0, delimiter$)
    ProcedureReturn ExtractRegularExpression(0, string$, a())
  EndIf
EndProcedure

;Datum und Uhrzeit durch alle möglichen Zeichen ersetzen
Procedure.s FormatDateExZeichen (mask$)
  mask$ = ReplaceString(mask$, "%ww", "DFMSTWacdeghimnorstuwy")
  mask$ = ReplaceString(mask$, "%w", ".DFMSTWadehinortu")
  mask$ = ReplaceString(mask$, "%mmmm", "ADFJMNOSabceghiklmnoprstuvyzä")
  mask$ = ReplaceString(mask$, "%mmm", ".ADFJMNOSabcegiklnoprtuvyzä")
  mask$ = ReplaceString(mask$, "%yyyy", "0123456789")
  mask$ = ReplaceString(mask$, "%yy", "0123456789")
  mask$ = ReplaceString(mask$, "%mm", "0123456789")
  mask$ = ReplaceString(mask$, "%dd", "0123456789")
  mask$ = ReplaceString(mask$, "%hh", "0123456789")
  mask$ = ReplaceString(mask$, "%ii", "0123456789")
  mask$ = ReplaceString(mask$, "%ss", "0123456789")
  mask$ = ReplaceString(mask$, "%d", "0123456789")
  mask$ = ReplaceString(mask$, "%m", "0123456789")
  mask$ = ReplaceString(mask$, "%h", "0123456789")
  mask$ = ReplaceString(mask$, "%i", "0123456789")
  mask$ = ReplaceString(mask$, "%s", "0123456789")
  ProcedureReturn mask$
EndProcedure

;Tagesname
Procedure.s LocalizedDayName (DayOfWeek.i, short.i=#False)
  Protected fmt.i, buffer$, bufferSize.i=80
  If DayOfWeek = 0
    DayOfWeek = 7
  EndIf
  If short
    fmt = #LOCALE_SABBREVDAYNAME1
  Else
    fmt = #LOCALE_SDAYNAME1
  EndIf
  buffer$ = Space(bufferSize)
  GetLocaleInfo_(#LOCALE_USER_DEFAULT, fmt + DayOfWeek - 1, @buffer$, bufferSize)
  ProcedureReturn buffer$
EndProcedure

;Monatsname
Procedure.s LocalizedMonthName (MonthOfYear.i, short.i=#False)
  Protected fmt.i, buffer$, bufferSize.i=80
  If short
    fmt = #LOCALE_SABBREVMONTHNAME1
  Else
    fmt = #LOCALE_SMONTHNAME1
  EndIf
  buffer$ = Space(bufferSize)
  GetLocaleInfo_(#LOCALE_USER_DEFAULT, fmt + MonthOfYear - 1, @buffer$, bufferSize)
  ProcedureReturn buffer$
EndProcedure

;Datum / Uhr formatieren
Procedure.s FormatDateEx (mask$, date.i=-1)
  If date = -1
    date = Date()
  EndIf
  mask$ = ReplaceString(mask$, "%ww",   LocalizedDayName(DayOfWeek(date)))
  mask$ = ReplaceString(mask$, "%w",    LocalizedDayName(DayOfWeek(date), #True))
  mask$ = ReplaceString(mask$, "%mmmm", LocalizedMonthName(Month(date)))
  mask$ = ReplaceString(mask$, "%mmm",  LocalizedMonthName(Month(date), #True))
  mask$ = FormatDate(mask$, date)
  mask$ = ReplaceString(mask$, "%d", Str(Day(date)))
  mask$ = ReplaceString(mask$, "%m", Str(Month(date)))
  mask$ = ReplaceString(mask$, "%h", Str(Hour(date)))
  mask$ = ReplaceString(mask$, "%i", Str(Minute(date)))
  mask$ = ReplaceString(mask$, "%s", Str(Second(date)))
  ProcedureReturn mask$
EndProcedure

Procedure SetCharSprite(t)
  If Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\sprite = 0
    Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\sprite = spr
    Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schatten = spr +1
    Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schattenx = schattenx
    Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schatteny = schatteny
    LoadFont(0, Font, FontSize)
    ;LoadFont(0, Font, Random(70,30))
    getTextInfo(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)), Mid(tmpTickerText, t, 1))
    
    ;Zeichen
    CreateSprite(Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\sprite, 
                 Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmW,
                 Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmH)
    
    If StartDrawing(SpriteOutput(Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\sprite))
      DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_Outlined)
      DrawingFont(FontID(0))
      
      DrawText(0, 0, Mid(tmpTickerText, t, 1), RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2))))
      StopDrawing()
    EndIf
    
    ;-Schatten
    CreateSprite(Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schatten, 
                 Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmW,
                 Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmH)
    
    If StartDrawing(SpriteOutput(Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schatten))
      DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_Outlined)
      DrawingFont(FontID(0))
      
      DrawText(0, 0, Mid(tmpTickerText, t, 1), schattenfarbe)
      StopDrawing()
    EndIf
    TransformChar(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)), fontwinkel)
    
    FreeFont(0)
    spr +2
  EndIf
EndProcedure

OpenWindow(#Ticker_Window, 0, 0, width, TickerHeight, "", #PB_Window_BorderLess)
OpenWindowedScreen(WindowID(#Ticker_Window), 0, 0, width, TickerHeight, 1, 0, 0, #PB_Screen_NoSynchronization)
SpriteQuality(#PB_Sprite_BilinearFiltering)

LoadFont(0, Font, TickerHeight)
getTextInfo("0", " ")
tmA = TickerHeight / Zeichen("0")\tmH * Zeichen("0")\tmA

tmpTickerText = FormatDateExZeichen (TickerText)
SplitString(tmpTickerText, "\[color=#[0-9a-fA-F]{6}\]", Text())
xsize = Width

For j=0 To ArraySize(Text())
  tmpTickerText = Right(tmpTickerText, Len(tmpTickerText)-Len(Text(j)))
  a = FindString(tmpTickerText, "[color=#")
  If a
    For t = 1 To Len(Left(tmpTickerText, a-1))
      SetCharSprite(t)
    Next
    tmpTickerText = Right(tmpTickerText, Len(tmpTickerText)-a+1)
  Else
    For t = 1 To Len(tmpTickerText)
      SetCharSprite(t)
    Next
  EndIf
Next

Repeat
  ClearScreen(0)
  xsize -speed
  xpos1 = xsize
  Repeat
    tmpTickerText = FormatDateEx(TickerText)
    Dim Text(0)
    SplitString(tmpTickerText, "\[color=#[0-9a-fA-F]{6}\]", Text())
    n = 1 : l = 0
    For j = 0 To ArraySize(Text())
      tmpTickerText = Right(tmpTickerText, Len(tmpTickerText)-Len(Text(j)))
      a = FindString(tmpTickerText, "[color=#")
      
      If a
        le = Len(Left(tmpTickerText, a-1))
      Else
        le = Len(tmpTickerText)
      EndIf
      
      For t = 1 To le
        ;Schatten
        DisplayTransparentSprite(Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schatten, 
                                 xpos1 + xpos2 + Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schattenx, 
                                 tmA-Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmA + Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\schatteny)
        
        ;Zeichen
        DisplayTransparentSprite(Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\sprite, 
                                 xpos1 + xpos2, 
                                 tmA-Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmA)
        
        xpos1 +Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmW
        l +Zeichen(font + ":" + Str(RGB(Val("$"+Mid(Text(j), 9, 2)), Val("$"+Mid(Text(j), 11, 2)), Val("$"+Mid(Text(j), 13, 2)))) + ":" + StrD(FontSize) + ":" + Asc(Mid(tmpTickerText, t, 1)))\tmW
        If xpos1 > width : n=0: Break 3 : EndIf
      Next
      If a
        tmpTickerText = Right(tmpTickerText, Len(tmpTickerText)-a+1)
      EndIf
    Next
    textl = l
  ForEver
  
  If textl And xsize < -textl
    xsize + textl
    textl = 0
  EndIf
  
  If n
    xpos2 = xpos1 - width
    xpos1 = width
    
  EndIf
  
  FlipBuffers()
  WindowEvent()
  Delay (1)
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    End
  EndIf
  
ForEver
Alle Zeiten sind UTC+02:00
Seite 2 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de