A tool which scrolls horizontally and vertically.
Vector Lib based and supports Gradient Colors - All OS.
Changing the fontsize change automatically the tool size.
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