ScrollingText_enhanced_Horizontal &Vertical -Module - All OS

Share your advanced PureBasic knowledge/code with the community.
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

ScrollingText_enhanced_Horizontal &Vertical -Module - All OS

Post by Saki »

ScrollingText_enhanced_Horizontal -Module - All OS - DPI aware

A tool which scrolls horizontally and vertically.
Vector Lib based and supports Gradient Colors - All OS.

Changing the fontsize change automatically the tool size.

Image

Image

Because of the dependencies with the images you can copy it into
the GFX_Wizzard_BF archive with the other demo codes, then it runs with the included images.
You can also start the code directly like this, but then the images are missing.

A very extended tool with additional demo code will go online with the next Wizzard update in its archive.
Under the name "ScrollingText_BF".

Code: Select all

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 ScrollTextImage_V_ST(image_ID,                  ; Vertical 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
  Declare GradientColor_Pos_ST(GradientColor_Pos_ST_.d,   ; Output pos (0.0 to 1.0) for GradientColor and defined color
                               Gradient_Pos_Color_ST_)
  Declare LinearGradient_ST(ActivateLinearGradient_ST_=0, ; Activate LinearGradient = 1
                            LinearGradient_X_ST_=0,       ; LinearGradient_X
                            LinearGradient_Y_ST_=0,       ; LinearGradient_Y
                            LinearGradient_XX_ST_=0,      ; LinearGradient_XX
                            LinearGradient_YY_ST_=0)      ; LinearGradient_YY
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 ScrollTextImage_V_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, text_width, step_width)
    If Not temp_image_1_ID : ProcedureReturn 0 : EndIf
    Protected temp_image_2_ID=GrabDrawingImage(#PB_Any, 0, step_width, text_width, text_height-step_width)
    If Not temp_image_2_ID : FreeImage(temp_image_1_ID) : ProcedureReturn 0 : EndIf
    DrawImage(ImageID(temp_image_1_ID), 0, text_height-step_width)
    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
  
  Procedure GradientColor_Pos_ST(GradientColor_Pos_ST_.d,
                                 Gradient_Pos_Color_ST_)
    GradientColor_Pos_ST.d=GradientColor_Pos_ST_.d
    Gradient_Pos_Color_ST=Gradient_Pos_Color_ST_
    ProcedureReturn 1
  EndProcedure
  
  Procedure LinearGradient_ST(ActivateLinearGradient_ST_=0,
                              LinearGradient_X_ST_=0,
                              LinearGradient_Y_ST_=0,
                              LinearGradient_XX_ST_=0,
                              LinearGradient_YY_ST_=0)
    ActivateLinearGradient_ST=ActivateLinearGradient_ST_
    LinearGradient_X_ST=LinearGradient_X_ST_
    LinearGradient_Y_ST=LinearGradient_Y_ST_
    LinearGradient_XX_ST=LinearGradient_XX_ST_
    LinearGradient_YY_ST=LinearGradient_YY_ST_
    ProcedureReturn 1
  EndProcedure
  
EndModule

UseModule ScrollingText_BF

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

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  UsePNGImageDecoder()
  
  Define window_ID=OpenWindow(#PB_Any, 5 ,5 ,800 ,520 ,"Scrolling text BF" ,#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  SetWindowColor(window_ID, $909090)
  
  Define font_ID=LoadFont(#PB_Any,"Tahoma", 24) ; TODO Used font size
  
  Define text_color=#Yellow
  Define background_color=#Blue
  
  ; ####################################### Vertical ##########################################
  
  ; ##### Init text image for vertical scrolling #####
  Define text_v$=#LF$+#LF$+"Hello World, this is scrolling text BF"+#LF$+"AAAAAAAAAAAAAAAAAA"+#LF$+"BBBBBBBBB"+#LF$+
                 "CCCCCCCCCCCC"+#LF$+"DDDDDDDD"+#LF$+"EEEEEEEEEEEEEEE"+#LF$+"FFFFFFFFFFFFFFFFF"+#LF$+"GGGGGGGGGGGGGG"+
                 #LF$+"HHHHHHHHHHHHHHHHHHHHHHHH"+#LF$+"IIIIIIIIIIIIIIIIIIIIIIIIIII"+#LF$+"JJJJJJJJJJJ  JJJJJJJJJJJJ"+#LF$+
                 "KKKKKK  KKKKKKKKKK  KKKKKK"
  Global image_v_ID=CreateTextImage_ST(text_v$, font_ID, text_color, background_color)
  ; ##################################################
  
  ; #### Create text image for vertical scrolling ####
  GradientColor_Pos_ST(0.5, text_color) ; Output pos (0.0 to 1.0) for GradientColor and defined color 
  
  LinearGradient_ST(1,                            ; Activate LinearGradient = 1
                    0,                            ; LinearGradient_X
                    -ImageHeight(image_v_ID)*1.5, ; LinearGradient_Y
                    0,                            ; LinearGradient_XX
                    ImageHeight(image_v_ID)*2.3)  ; LinearGradient_YY
  FreeImage(image_v_ID)
  
  Define text_alignement=2 ; Text alignement 0=left - 1=right - 2=center -  TODO Text alignment
  Global image_v_ID=CreateTextImage_ST(text_v$, font_ID, text_color, background_color, text_alignement)
  ; ##################################################
  
  ; ###################################### Horizontal #########################################
  
  ; ####### Init text image for horizontal scrolling #######
  Define text_h$="     Hello World, how are you ?, I hope you are well"
  Global image_h_ID=CreateTextImage_ST(text_h$, font_ID, text_color, background_color)
  ; ########################################################
  
  ; ###### Create text image for horizontal scrolling ######
  GradientColor_Pos_ST(0.5, text_color) ; Output pos (0.0 to 1.0) for GradientColor and defined color 
  
  LinearGradient_ST(1,                            ; Activate LinearGradient = 1
                    0,                            ; LinearGradient_X
                    -ImageHeight(image_h_ID)*1.5, ; LinearGradient_Y
                    0,                            ; LinearGradient_XX
                    ImageHeight(image_h_ID)*2.3)  ; LinearGradient_YY
  FreeImage(image_h_ID)
  Global image_h_ID=CreateTextImage_ST(text_h$, font_ID, text_color, background_color, text_alignement)
  ; ########################################################
  
  Define image_1_ID=LoadImage(#PB_Any, "../GFX_Wizzard_BF/Image_Set/Foxy.png")
  Define image_2_ID=LoadImage(#PB_Any, "../GFX_Wizzard_BF/Image_Set/Chicken_1_Alpha/Chicken_1_Alpha1.png")
  Define image_3_ID=LoadImage(#PB_Any, "../GFX_Wizzard_BF/Image_Set/PureBasicLogo.bmp")
  
  If image_1_ID And image_2_ID And image_3_ID
    ResizeImage(image_1_ID, ImageWidth(image_v_ID)/5.5, ImageHeight(image_v_ID)/4)
    ResizeImage(image_2_ID, ImageWidth(image_v_ID)/3, ImageHeight(image_v_ID)/3)
    ResizeImage(image_3_ID, ImageWidth(image_v_ID)/4, ImageHeight(image_v_ID)/20)
    
    ; ### Image v output ###
    StartDrawing(ImageOutput(image_v_ID))
    DrawAlphaImage(ImageID(image_1_ID), ImageWidth(image_v_ID)/25,  ImageHeight(image_v_ID)/3)
    DrawAlphaImage(ImageID(image_2_ID), ImageWidth(image_v_ID)/3,  -30*ImageHeight(image_v_ID)/200)
    DrawAlphaImage(ImageID(image_3_ID), ImageWidth(image_v_ID)/1.4,  ImageHeight(image_v_ID)/2.3)
    StopDrawing()
    
    ; ### Image h output ###
    StartDrawing(ImageOutput(image_h_ID))
    DrawAlphaImage(ImageID(image_1_ID), -12*ImageWidth(image_h_ID)/200, -1*ImageHeight(image_v_ID)/200)
    StopDrawing()
  EndIf

  #CanvasOutput=#True ; Choose CanvasGadget for output or ButtonImageGadget - For ButtonImageGadget the WinOS stutter fix is deactivated
  
  ; Vertical
  If #CanvasOutput
    Global winOS_stutter_Fix=1
    Global gadget_1_ID=CanvasGadget(#PB_Any,
                                    WindowWidth(window_ID)/2-ImageWidth(image_v_ID)/2/DesktopResolutionX(),
                                    WindowHeight(window_ID)/15,
                                    ImageWidth(image_v_ID)/DesktopResolutionX(),
                                    ImageHeight(image_v_ID)/DesktopResolutionY()/1.4, #PB_Canvas_Border) 
  Else 
    ; Output on a ButtonImageGadget
    winOS_stutter_Fix=0
    gadget_1_ID=ButtonImageGadget(#PB_Any,
                                  WindowWidth(window_ID)/2-ImageWidth(image_v_ID)/2/DesktopResolutionX(),
                                  WindowHeight(window_ID)/15,
                                  ImageWidth(image_v_ID)/DesktopResolutionX(),
                                  ImageHeight(image_v_ID)/DesktopResolutionY()/1.4, 0) 
  EndIf
  
  ; Horizontal
  If #CanvasOutput
    ; Output on a CanvasGadget
    Global gadget_2_ID=CanvasGadget(#PB_Any,
                                    WindowWidth(window_ID)/2-ImageWidth(image_h_ID)/2/DesktopResolutionX()/1.2,
                                    WindowHeight(window_ID)/1.17,
                                    ImageWidth(image_h_ID)/DesktopResolutionX()/1.2,
                                    ImageHeight(image_h_ID)/DesktopResolutionY(), #PB_Canvas_Border)
  Else
    ; Output on a ButtonImageGadget
    gadget_2_ID=ButtonImageGadget(#PB_Any,
                                  WindowWidth(window_ID)/2-ImageWidth(image_h_ID)/2/DesktopResolutionX()/1.2,
                                  WindowHeight(window_ID)/1.17,
                                  ImageWidth(image_h_ID)/DesktopResolutionX()/1.2,
                                  ImageHeight(image_h_ID)/DesktopResolutionY(), 0) 
  EndIf
  
  ; Scroll vertical
  Procedure DrawScrollingText_V()
    SetGadgetAttribute(gadget_1_ID, #PB_Button_Image, ImageID(image_v_ID))
    ScrollTextImage_V_ST(image_v_ID, 1) ; 1 = Step width
    ProcedureReturn 1
  EndProcedure
  
  ; 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_V())
    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_V()
        DrawScrollingText_H()
      EndIf
      Repeat
        Define win_event=WindowEvent()
        If win_event=#PB_Event_CloseWindow 
          End
        EndIf
      Until Not win_event 
    ForEver 
  EndIf
  
CompilerEndIf
地球上の平和
User avatar
VB6_to_PBx
Enthusiast
Enthusiast
Posts: 617
Joined: Mon May 09, 2011 9:36 am

Re: ScrollingText_enhanced_Horizontal &Vertical -Module - Al

Post by VB6_to_PBx »

Scrolls very smooth in both directions , great Code , thanks !
 
PureBasic .... making tiny electrons do what you want !

"With every mistake we must surely be learning" - George Harrison
Post Reply