Scroll text horizontally

Just starting out? Need help? Post your questions and find answers here.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Scroll text horizontally

Post by RASHAD »

Hi JHPJHP
I like your last snippet
Specially moving the text while keeping the background intact
Well,next is the same effect using my own code

Code: Select all

Global x

Procedure scrollText()
  x - 4
  If x = -380
    x = 380
  EndIf
  ResizeGadget(1,x,#PB_Ignore,#PB_Ignore,#PB_Ignore)
EndProcedure

chk = 12
CreateImage(10, chk*2,chk*2)
StartDrawing(ImageOutput(10))
Box(0,0,chk,chk,$4BE0FE)
Box(chk,0,chk,chk,$CFFEE7)
Box(0,chk,chk,chk,$CFFEE7)
Box(chk,chk,chk,chk,$4BE0FE)
StopDrawing()
hBrush = CreatePatternBrush_(ImageID(10))

OpenWindow(0, 0, 0, 400, 130, "Scroller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,380,80,#PB_Container_Flat)
SetClassLongPtr_(GadgetID(0), #GCL_HBRBACKGROUND, hBrush)
ImageGadget(1,0,12,380,80,0)
CloseGadgetList()
text.s = " .... Scroll Text .... "
CreateImage(0,376,76,32,#PB_Image_Transparent)
StartVectorDrawing(ImageVectorOutput(0))
AddPathBox(0,0,376,76)
VectorSourceColor($01000000)
FillPath()
VectorFont(FontID(0),40)
MovePathCursor(6,2)
VectorSourceColor($E2E2E2|$FF000000)
DrawVectorText(text)
MovePathCursor(8,4)
VectorSourceColor($000000|$FF000000)
DrawVectorText(text)
MovePathCursor(7,3)
VectorSourceColor($959595|$FF000000)
DrawVectorText(text) 
StopVectorDrawing()
SetGadgetState(1,ImageID(0))

ButtonGadget(2,10,98,40,24,"ON",#PB_Button_Toggle)

AddWindowTimer(0,125,10)
Repeat
  Select WaitWindowEvent(1)
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            SetGadgetText(2,"OFF")
            BindEvent(#PB_Event_Timer,@scrollText())
          Else
            SetGadgetText(2,"ON")
            UnbindEvent(#PB_Event_Timer,@scrollText())
            x = 0
            ResizeGadget(1,x,#PB_Ignore,#PB_Ignore,#PB_Ignore)
          EndIf          
      EndSelect
  EndSelect
Until Quit = 1
Egypt my love
User avatar
Paul
PureBasic Expert
PureBasic Expert
Posts: 1243
Joined: Fri Apr 25, 2003 4:34 pm
Location: Canada
Contact:

Re: Scroll text horizontally

Post by Paul »

JHPJHP wrote: This example demonstrates fairly smooth scrolling and applies a unique ease-in/out effect.
Very cool JHPJHP!
And so far it's the only example posted that doesn't jitter or stutter at some point on my screen while scrolling.
Image Image
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post by Saki »

@Paul
His first code stutters extremely.

With his second, the whole animation takes maybe half a second.
You're right, I don't see stuttering either. :wink:
地球上の平和
JHPJHP
Addict
Addict
Posts: 2129
Joined: Sat Oct 09, 2010 3:47 am
Contact:

Re: Scroll text horizontally

Post by JHPJHP »

Hi RASHAD,
RASHAD wrote:I like your last snippet
Thanks, I really like the simplicity and flexibility of CSS.
Not only can it be loaded from a file, included as a String or stored in a DataSection, but there are literally millions of examples floating around the net.

Hi Paul,
Paul wrote:Very cool JHPJHP!
And so far it's the only example posted that doesn't jitter or stutter at some point on my screen while scrolling.
Thank you.
Good to hear. You never know with different browsers, OS, PureBasic versions, etc.
Saki/walbus wrote:His first code stutters extremely.
Duh, really? That was the point. Read the post. I was demonstrating to IdeasVacuum that not all JavaScript / CSS examples are equal.
Saki/walbus wrote:With his second, the whole animation takes maybe half a second.
You do realize that every aspect of the animation is configurable; pathetic.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Scroll text horizontally

Post by Fangbeast »

JHPJHP, I don't think he was having a go at you (I hope). He has a tendency to argue with everyone at the drop of a hat and boast a lot but he will grow up one day if he lives long enough:):)

It's typical of a coder's mind that they just say whatever is in their head at the time and then their brains start writing code to see if they could do it differently and try to boast about it but it's not worth losing sleep over it.

I'm not smart enough to do that (and getting older and uglier by the minute):):)
Amateur Radio, D-STAR/VK3HAF
JHPJHP
Addict
Addict
Posts: 2129
Joined: Sat Oct 09, 2010 3:47 am
Contact:

Re: Scroll text horizontally

Post by JHPJHP »

Hi Fangbeast,

Of course you're right.
I don't usually get dragged into "tit for tat" confrontations, I blame COVID; living in lockdown for a year has frayed my nerves.
Thank you for being the goat... I mean voice of reason in these unreasonable times.

NB*: You don't hold a monopoly on being old and ugly, there's plenty to go around.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Scroll text horizontally

Post by Fangbeast »

Of course you're right.
Please tell that to my wife?? She is always correcting me:):)
I don't usually get dragged into "tit for tat" confrontations, I blame COVID; living in lockdown for a year has frayed my nerves.
Know the feeling. I have neuropathy on top of everything else and keep having bad accidents and not knowing it until someone points it out to me. Now more than ever.
Thank you for being the goat.
Don't tell my daughter or my best friend, they will think I have stolen their collection again.
You don't hold a monopoly on being old and ugly, there's plenty to go around.
I know I am not as old as Idle's shamefully abused sheep collection but I turn 63 this year (I think my body may be 82) and the bathroom mirror cries constantly when I go near it.

When I was born, the doctor slapped both my parents and asked them what they were thinking. Then he turned me upside down, looked at my bottom and said to them they had twins!!! (hehehehehe)
Amateur Radio, D-STAR/VK3HAF
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Scroll text horizontally

Post by idle »

whats that about my sheep. Here's some festering old buggy mess from a decade ago PB 4.60, it scrolls and zooms nicely with ctrl and mouse wheel

Code: Select all

; Author: IDLE
; Date: March 4, 2011
; PB version: v4.60 linux windows 
; Version 0.57b 
; ******************************************************************************
;-Description:
;*******************************************************************************
;Freestyle TextEditGadgetEx 
;Background images 
;Gradients
;Auto word wrap
;Mouse wheel scroll 
;Marquee scrollers 
;Multiple fonts - colors - styles
;Auto Gadget Resize with image scaling and optional font scaling  
;Mouse wheel Zoom text  

#DEBUG = 1 ; if set to 1 will write out the average marquee running time after a 1000 cycles 
                      ; want to get the render speed down with panel backgrounds

;-Enums constants 
;The maximum number of fonts in a document
#MAXNUMFONT = 20
#TGEX_TAB_SIZE = 3
Enumeration
  #TGEX_WordWrap
  #TGEX_MarqueeH
  #TGEX_MarqueeV
  #Circular
  #Eliptic 
  #Linear  
  #TGEX_LeftDown
  #TGEX_RightDown 
  #TGEX_LeftUP
  #TGEX_RightUP
EndEnumeration 

#TGEX_NoScale = 0            ;fixed sized control
#TGEX_ScaleGadget = 1     ;auto resize control
#TGEX_ScaleFont = 2         ;auto scale fonts 
#TGEX_TAB = 9
#TGEX_Back = 8
#TGEX_Del = 255
#TGEX_Control = 65508
#TGEX_ShiftL =  65505
#TGEX_ShiftR =  65506
#TGEX_AltL = 65513
#TGEX_AltR = 65027 
#TGEX_CAP = 65509
#TGEX_INS = 65379
#TGEX_SRL = 65300
#TGEX_PBR = 65299
#TGEX_LWI = 65515
#TGEX_LWR=65516
#TGEX_MEN = 65383
#TGEX_NUM = 65407

 CompilerIf  #PB_Compiler_OS = #PB_OS_Linux
   #TGEX_REGULAR = 0
   #TGEX_ITALICS = 2
   #TGEX_BOLD = 1
   #TGEX_BOLDITALICS = 3
CompilerEndIf   
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
   #TGEX_REGULAR = 0
   #TGEX_ITALICS = 512
   #TGEX_BOLD = 256
   #TGEX_BOLDITALICS = 768
CompilerEndIf  

;- Structure 
CompilerIf Defined(rect,#PB_Structure)=#False
Structure rect
  left.i
  right.i
  top.i
  bottom.i
EndStructure
CompilerEndIf

Structure Font
  name.s
  style.i
  size.i
  color.i
EndStructure 

Structure Words
  word.s
  img.i
  width.i
  height.i
  size.i
  rc.rect
  line.i
  font.font
 EndStructure   

Structure Marquee
  timer.i
  mode.i
  steps.i
  startX.i
  startY.i
  busy.i
  delay.i
 EndStructure

Structure Gradient
  mode.i
  x.i
  y.i
  col1.i
  col2.i
EndStructure 

Structure glyph
  img.i
  ref.i
EndStructure  

Structure TextGadgetEX
    *vt
    List ltype.words()
    fonts.font[#MAXNUMFONT]
    Map glyphs.glyph()
    fontcount.i
    left.i
    top.i
    width.i
    height.i
    colums.i
    start.i        
    insert.i
    bedit.i
    Currentword.s
    keybuff.s
    Inputkey.i
    Gadget.i   
    BackColor.i
    BackGroundImg.i
    textimg.i
    outputImg.i
    BackBuffer.i
    alpha.i
    max.i
    MarginLeft.i
    MarginRight.i
    win.i
    mode.i
    pWinWidth.i
    pWinHeight.i
    sfx.f
    sfy.f
    scalefont.f
    Scalemode.i
    cfont.Font
    marquee.marquee
    gradient.gradient
    sum.i
    count.i
    isEditor.i
    bSelect.i
    mx.i
    my.i
    SelStart.i
    SelEnd.i
    bSelRange.i
    lstate.i
    baltgt.i
    *hl.Highlights 
    HighlightRule.i
EndStructure         

;-Declares
 
Declare TextGadgetEx_AddText(*this.TextGadgetEX,word.s,font=-1,size=12,color=-1,style=0)
Declare TextGadgetEx_ChooseFont(*this.TextGadgetEX)
Declare TextGadgetEx_LoadFont(*this.TextGadgetEX,font.s,size=12,style=0)
Declare TextGadgetEx_Output(*this.TextGadgetEX)
Declare TextGadgetEx_Scroll(*this.TextGadgetEX,dir,amount)
Declare TextGadgetEX_MouseScroll(*this.TextGadgetEX,dir,key)
Declare TextGadgetEx_Gadget(*this.TextGadgetEX)
Declare TextGadgetEX_Clear(*this.TextGadgetEX)
Declare TextGadgetEx_Free(*this.TextGadgetEX)
Declare TextGadgetEx_StartMarquee(*this.TextGadgetEX,steps,fps)
Declare TextGadgetEx_Marquee(*this.TextGadgetEX,mEventTimer)
Declare TextGadgetEx_StopMarquee(*this.TextGadgetEX)
Declare TextGadgetEX_SetGradient(*this.TextGadgetEX,mode,colf,colb,alpha=255,x=0,y=0,radius=0,minor=0)
Declare TextGadgetEx_ToggleEdit(*this.TextGadgetEX)
Declare TextGadgetEx_ProcessEvents(*this.TextGadgetEx,event.i,EventGadget.i,EventType.i)
Declare TextGadgetEX_Rescale(*this.TextGadgetEX,width.i,height.i)
Declare TextGadgetEX_ScaleFont(*this.TextGadgetEX,scale.f=1,bRedraw=1)
Declare TextGadgetEx_Del(*this.TextGadgetEX,key.i)
Declare TextGadgetEx_ClearSelection(*this.TextGadgetEx)
Declare TextGadgetEx_Paste(*this.TextGadgetEx)
Declare TextGadgetEX_Copy(*this.TextGadgetEx)
Declare TextGadgetEX_CreateGlyph(*this.TextGadgetEx,word.s)

Declare New_TextGadgetEx(win,left,top,width,height,marginleft,marginright,BackColor,isEditor=0,backGroundImg=0,alpha=0,mode=#TGEX_WordWrap,scalemode=#TGEX_NoScale)
Declare CanvasCallBack(hwnd,msg,wparam,lparam);
;-Globals

Global gTextGadgetExTimer.i =1 
Global  NewList gClipBoard.words()
;-Interface

Interface TextGadget_EX
     AddText(word.s,font=0,size=12,color=-1,style=0)
     ChooseFont()
     LoadFonts(font.s,size=12,style=0)
     Output()
     Scroll(dir.i,amount.i)
     MouseScroll(amount.i)
     StartMarquee(steps,fps)
     StopMarquee()
     Marquee(mEventTimer)
     ToggleEdit()
     ProcessEvents(Event.i,EventGadget.i,EventType.i)
     SetGradient(mode,colf,colb,alpha=255,x=0,y=0,radius=0,minor=0)
     Zoom(scale)
     GadgetID()
     Clear()
     Free()
EndInterface     

DataSection
   VT_TextGadgetEX:
   Data.i @TextGadgetEx_AddText()
   Data.i @TextGadgetEx_ChooseFont()
   Data.i @TextGadgetEx_LoadFont()
   Data.i @TextGadgetEx_Output()
   Data.i @TextGadgetEx_Scroll()
   Data.i @TextGadgetEX_MouseScroll()
   Data.i @TextGadgetEx_StartMarquee()
   Data.i @TextGadgetEx_StopMarquee()
   Data.i @TextGadgetEx_Marquee()
   Data.i @TextGadgetEx_ToggleEdit()
   Data.i @TextGadgetEx_ProcessEvents()
   Data.i @TextGadgetEX_SetGradient()
   Data.i @TextGadgetEX_ScaleFont()
   Data.i @TextGadgetEx_Gadget()
   Data.i @TextGadgetEx_Clear()
   Data.i @TextGadgetEx_Free()
EndDataSection

;-Private
;************************************************************************************
;private TextGadgetEx_Marquee()
;purpose  update Marquee on window timer event     
;params meventTimer 
; ************************************************************************************
Procedure TextGadgetEx_Marquee(*this.TextGadgetEX,mEventTimer)
  Protected result,ct 
  ct = ElapsedMilliseconds()  ;in case the render takes longer than the timer event GDK may locks up otherwise
  If ct - *this\marquee\busy  > *this\marquee\delay
    *this\start-*this\marquee\steps
     result = TextGadgetEx_Output(*this)
     If result = 0
         If *this\marquee\mode = #TGEX_MarqueeH
            *this\start = *this\width
         Else
            *this\start = -*this\height
         EndIf 
      EndIf 
      *this\marquee\busy = ElapsedMilliseconds() 
   EndIf    
 EndProcedure
;************************************************************************************
;private TextGadgetEx_MouseScroll()
;purpose  wrapper to scroll the Gadget by mouse wheel 
;params  
;************************************************************************************
Procedure TextGadgetEX_MouseScroll(*this.TextGadgetEX,dir,key)
   
  If dir = 1
    If key <> #PB_Canvas_Control
      TextGadgetEX_Scroll(*this,1,*this\max)
    Else 
      TextGadgetEX_ScaleFont(*this,1.25)
       
    EndIf   
  ElseIf dir= -1
      If  key <> #PB_Canvas_Control
         TextGadgetEX_Scroll(*this,0,*this\max)
      Else 
        TextGadgetEX_ScaleFont(*this,0.8)
     EndIf 
  EndIf   
     
EndProcedure 
;************************************************************************************
;private TextGadgetEx_Rescale()
;purpose Resizes the gadget and Scales the font depending on the mode      
;params the current window width and window height  
; ************************************************************************************
Procedure TextGadgetEX_Rescale(*this.TextGadgetEX,winwidth.i,winheight.i)
  Protected iw,ih
 If (winwidth > 10) And (winheight > 10) And (*this\Scalemode = 1) Or (*this\Scalemode = 3)    
      
      *this\sfx = winwidth / *this\pWinWidth  
      *this\sfy = winheight / *this\pWinHeight 
       *this\width * *this\sfx 
      *this\height * *this\sfy 
      *this\left * *this\sfx 
      *this\top * *this\sfy
       If IsImage(*this\BackGroundImg) 
         If IsImage(*this\BackBuffer)
             FreeImage(*this\BackGroundImg)
             *this\BackGroundImg = CopyImage(*this\BackBuffer,#PB_Any)
             ResizeImage(*this\BackGroundImg,*this\width,*this\height,#PB_Image_Smooth) 
          Else 
             ResizeImage(*this\BackGroundImg,*this\width,*this\height,#PB_Image_Smooth) 
         EndIf 
      EndIf     
      ResizeImage(*this\outputImg,*this\width,*this\height)
      ResizeImage(*this\textimg,*this\width,*this\height)
      ResizeGadget(*this\Gadget,*this\left,*this\top,*this\width,*this\height)
      
      If (*this\Scalemode = 2) Or (*this\Scalemode=3)
        *this\scalefont = winheight / *this\pWinHeight 
        TextGadgetEX_Scalefont(*this,*this\scalefont,0)  
      EndIf 
        *this\pWinWidth  = winwidth 
        *this\pWinHeight = winheight
        TextGadgetEx_Output(*this)
  EndIf   
    
  EndProcedure
   
;************************************************************************************
;private TextGadgetEx_del()
;purpose backspace or del key funtion      
; ************************************************************************************
  Procedure TextGadgetEx_Del(*this.TextGadgetEX,keyb.i)
    Protected key.s
    If *this\insert <> 0
      ChangeCurrentElement(*this\ltype(),*this\insert)
      If keyb = #TGEX_Del And ListIndex(*this\ltype()) < ListSize(*this\ltype())-2
        NextElement(*this\ltype()) 
      ElseIf keyb = #TGEX_Del 
         ProcedureReturn 
      EndIf   
    EndIf  
    
     
    If ListIndex(*this\ltype()) > 0 
      If (Asc(*this\ltype()\word) = 13 Or  Asc(*this\ltype()\word) = 10) And keyb <>  #TGEX_Del  
        DeleteElement(*this\ltype())
      EndIf  
      key = *this\ltype()\word+ *this\ltype()\font\name+Str( *this\ltype()\font\size)+Str(*this\ltype()\font\style)+Str(*this\ltype()\font\color) 
      DeleteElement(*this\ltype())
      If IsImage(*this\glyphs(key)\img)
        *this\glyphs(key)\ref -1
        If *this\glyphs(key)\ref < 1 
           FreeImage(*this\glyphs(key)\img)
          *this\glyphs(key)\img = 0 
        EndIf 
      EndIf 
    Else 
      FirstElement(*this\ltype())
       key = *this\ltype()\word+ *this\ltype()\font\name+Str( *this\ltype()\font\size)+Str(*this\ltype()\font\style)+Str(*this\ltype()\font\color) 
       If IsImage(*this\glyphs(key)\img)
        *this\glyphs(key)\ref -1
        If *this\glyphs(key)\ref < 1 
           FreeImage(*this\glyphs(key)\img)
          *this\glyphs(key)\img = 0 
        EndIf 
      EndIf 
      *this\ltype()\word = ""
    EndIf   
   If *this\ltype()\font\name <> ""
       CopyStructure(@*this\ltype()\font,@*this\cfont,font)
   EndIf     
   *this\insert = @*this\ltype()
    TextGadgetEx_Output(*this)
  EndProcedure 
;************************************************************************************
;private TextGadgetEx_Copy()
;purpose copy selection to clipboard and internal formated clipboard      
; ************************************************************************************
  Procedure TextGadgetEX_Copy(*this.TextGadgetEx)
  Protected cliptext.s
  ClearList(gClipboard())
  If (*this\selStart And *this\SelEnd) 
    ChangeCurrentElement(*this\ltype(),*this\SelStart)
    While *this\SelEnd <> @*this\ltype()  
      AddElement(gClipboard())
      CopyStructure(@*this\ltype(),@gClipBoard(),words)
      cliptext + *this\ltype()\word 
      NextElement(*this\ltype())
    Wend 
    AddElement(gClipboard())
    CopyStructure(@*this\ltype(),@gClipBoard(),words)
    cliptext + *this\ltype()\word 
    SetClipboardText(cliptext)
    *this\selStart=0 
    *this\SelEnd =0
  EndIf   
  
EndProcedure 
 ;************************************************************************************
;private TextGadgetEx_paste()
;purpose pastes clipboard or internal formated clipboard      
; ************************************************************************************                      
Procedure TextGadgetEx_Paste(*this.TextGadgetEx)
  Protected cliptext.s,key.s,timg.i
  
   If ListSize(gClipboard())>0 
    ChangeCurrentElement(*this\ltype(),*this\insert)
    ForEach gClipboard() 
       AddElement(*this\ltype())
       CopyStructure(@gClipboard(),@*this\ltype(),words)
       If IsImage(gClipboard()\img)
          key = *this\ltype()\word+ *this\ltype()\font\name+Str( *this\ltype()\font\size)+Str(*this\ltype()\font\style)+Str(*this\ltype()\font\color) 
          timg = *this\glyphs(key)\img 
          If Not timg 
            *this\ltype()\img = CopyImage(gClipBoard()\img,#PB_Any)
            *this\glyphs(key)\img  = *this\ltype()\img
            *this\glyphs(key)\ref +1
          Else 
             *this\glyphs(key)\ref +1
           EndIf 
       EndIf     
     Next 
   Else
     cliptext = GetClipboardText()
     If cliptext <> ""
       TextGadgetEx_AddText(*this,cliptext)
     EndIf 
   EndIf 
   *this\insert = @*this\ltype()
   TextGadgetEX_Output(*this)
 EndProcedure 
;************************************************************************************
;private TextGadgetEx_ClearSelection()
;purpose clears the selected text      
; ************************************************************************************
  Procedure TextGadgetEx_ClearSelection(*this.TextGadgetEx)
    Protected key.s
    If (ListSize(*this\ltype())) And (*this\SelStart <> 0) And (*this\SelEnd <> 0)
     ChangeCurrentElement(*this\ltype(),*this\SelEnd)
     While @*this\ltype() <> *this\Selstart
      key = *this\ltype()\word+ *this\ltype()\font\name+Str( *this\ltype()\font\size)+Str(*this\ltype()\font\style)+Str(*this\ltype()\font\color) 
      If IsImage(*this\glyphs(key)\img)
        *this\glyphs(key)\ref -1
        If *this\glyphs(key)\ref < 1 
           FreeImage(*this\glyphs(key)\img)
          *this\glyphs(key)\img = 0 
        EndIf 
      EndIf 
      DeleteElement(*this\ltype())
     Wend  
     *this\insert = @*this\ltype()
   EndIf 
 EndProcedure 
 
 CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
Procedure CanvasCallBack(hwnd,msg,wparam,lparam)
  Protected proc,obj,ctrl,*obj.TextGadgetEX 
  proc = GetProp_(hwnd,"proc")
  obj = GetProp_(hwnd,"obj")
  *obj = obj 
  If msg = #WM_CHAR 
   If  wparam > 31   
     TextGadgetEx_AddText(obj,Chr(wparam)) 
     TextGadgetEx_Output(obj)
   EndIf
  ElseIf msg = #WM_KEYUP
    If wparam = #VK_TAB
      *obj\lstate=1
      TextGadgetEx_AddText(lobj,Chr(wparam)) 
      TextGadgetEx_Output(lobj)
    EndIf 
  ElseIf msg = #WM_NCDESTROY
    RemoveProp_(hwnd, "proc")
    RemoveProp_(hwnd, "obj") 
  EndIf 
  ProcedureReturn CallWindowProc_(proc,hwnd,msg,wparam,lparam)  
EndProcedure

CompilerEndIf
  
  
;-Public Methods exposed 
;************************************************************************************
; Name: New_TextGadgetEx()
; Purpose:  Create a New TextGadgetEX
;;************************************************************************************
Procedure New_TextGadgetEx(win,left,top,width,height,marginleft,marginright,BackColor,isEditor=0,backGroundImg=0,alpha=0,mode=#TGEX_WordWrap,scalemode=#TGEX_NoScale)
  Protected *obj.TextGadgetEX
  
  If IsWindow(win)
    *obj = AllocateMemory(SizeOf(TextGadgetEX))
    InitializeStructure(*obj,TextGadgetEX)
    *obj\vt = ?VT_TextGadgetEX
    *obj\Left = Left
    *obj\Top = top
    *obj\Width = width
    *obj\Height = height
    *obj\MarginLeft = marginleft
    *obj\MarginRight = marginright
    *obj\BackColor = BackColor
    *obj\isEditor = isEditor
    *obj\Gadget = CanvasGadget(#PB_Any,left,top,width,height,  #PB_Canvas_Keyboard)
    *obj\textimg =  CreateImage(#PB_Any,width,height,24)
    *obj\outputImg  =  CreateImage(#PB_Any,width,height,24)
    *obj\BackGroundImg = backGroundImg
    *obj\alpha = alpha
    *obj\win = win
    *obj\mode = mode
    *obj\pWinWidth = WindowWidth(win)
    *obj\pWinHeight = WindowHeight(win)
    *obj\sfx = 1.0
    *obj\sfy = 1.0
    *obj\Scalemode = scalemode 
    *obj\scalefont = 1.0
    ;*obj\hl =  New_Highlighter()
     CompilerIf #PB_Compiler_OS = #PB_OS_Windows 
      Protected style.i 
      style = GetWindowLong_(GadgetID(*obj\Gadget),#GWL_STYLE)
      style ! #WS_TABSTOP
      SetWindowLong_(GadgetID(*obj\gadget),#GWL_STYLE,style)
      SetProp_(GadgetID(*obj\Gadget),"proc",SetWindowLongPtr_(GadgetID(*obj\Gadget),#GWL_WNDPROC, @CanvasCallBack()))
      SetProp_(GadgetID(*obj\Gadget),"obj",*obj)
    CompilerEndIf
    
     StartDrawing(ImageOutput(*obj\textimg))
            DrawingMode(#PB_2DDrawing_Default)
            Box(0,0,*obj\width,*obj\height,*obj\BackColor) 
     StopDrawing() 
    
    If IsImage(backgroundimg)
       StartDrawing(ImageOutput(*obj\outputImg))
         DrawingMode(#PB_2DDrawing_Default)
         DrawImage(ImageID(*obj\BackGroundImg),0,0)
         DrawingMode(#PB_2DDrawing_AlphaBlend)
         Box(0,0,*obj\width,*obj\height,RGBA(255-*obj\alpha,255-*obj\alpha,255-*obj\alpha,255-*obj\alpha)) 
        StopDrawing()   
        *obj\BackBuffer = CopyImage(*obj\backgroundimg,#PB_Any) 
        SetGadgetAttribute(*obj\Gadget,#PB_Canvas_Image,ImageID(*obj\outputImg))
      EndIf
           
    ProcedureReturn *obj   
Else     
     ProcedureReturn 0 
EndIf   
EndProcedure
;************************************************************************************
; Interface Name:  Free()
; Purpose:  Free TextGadgetEX
; Params:  none 
;************************************************************************************
Procedure TextGadgetEx_Free(*this.TextGadgetEX)
  If *this
     TextGadgetEx_Clear(*this)
     If IsImage(*this\BackGroundImg)
       FreeImage(*this\BackGroundImg)
     EndIf 
     If IsImage(*this\textimg)
       FreeImage(*this\textimg)
     EndIf 
     If IsImage(*this\BackBuffer)
       FreeImage(*this\BackBuffer)
     EndIf
     ;*this\hl\free()
     FreeMemory(*this)
    *this = 0
  EndIf
EndProcedure
;************************************************************************************
; Interface Name:  Clear()
; Purpose:  Clear document
; Params:  none 
;************************************************************************************
Procedure  TextGadgetEx_Clear(*this.TextGadgetEX)
  
   ForEach *this\glyphs()
       If IsImage(*this\glyphs()\img)
         FreeImage(*this\glyphs()\img)
         *this\glyphs()\img = 0
         *this\glyphs()\ref = 0 
       EndIf 
    Next   
    
    ClearList(*this\ltype())
        
     AddElement(*this\ltype())
     *this\ltype()\rc\left = *this\MarginLeft
     *this\ltype()\rc\right = *this\MarginRight - *this\MarginLeft+1
     *this\ltype()\rc\bottom = 1
     If *this\cfont\size <> 0 
       CopyStructure(*this\cfont,*this\ltype()\font,font)
     EndIf 
     AddElement(*this\ltype())
    *this\insert = @*this\ltype() 
    TextGadgetEx_Output(*this)
    *this\bedit = 0
  EndProcedure
  
;  Procedure TextGadgetEX_SethighLighter(*this.TextGadgetEX,format.s)
;     *this\hl\SetLanguage(format)
;  EndProcedure   
; Procedure TextGadgetEX_LoadHighLighter(*this.TextGadgetEX,file.s)
;     
; EndProcedure 

 ;************************************************************************************
; Interface Name:  ToggleEdit()
; Purpose:  Sets edit mode on and off
; Params:  none 
;************************************************************************************
  Procedure  TextGadgetEx_ToggleEdit(*this.TextGadgetEX)
    Protected px,py
       
    px = WindowMouseX(*this\win)
    py = WindowMouseY(*this\win) 
   
    If  *this\isEditor
      *this\SelEnd =0
      px - *this\left
      py - *this\top 
          
       If ListSize(*this\ltype()) > 0 
         *this\insert=0
         ForEach *this\ltype()
             If px >= *this\ltype()\rc\left And px <= *this\ltype()\rc\right And py >= *this\ltype()\rc\top And py <= *this\ltype()\rc\bottom
               PreviousElement(*this\ltype())
               *this\insert = @*this\ltype()
                 Break   
             ElseIf *this\ltype()\rc\left > 0  
                *this\insert = @*this\ltype()
             EndIf 
           Next
        Else 
            AddElement(*this\ltype())
            *this\ltype()\rc\left = *this\MarginLeft
            *this\insert = @*this\ltype()
       EndIf 
      
      *this\bedit = 1
      *this\bselect = 1 
     *this\SelStart = *this\insert  
      TextGadgetEx_Output(*this)  
 EndIf
  
EndProcedure   

Procedure TextGadgetEX_CreateGlyph(*this.TextGadgetEx,word.s)
       Protected key.s,tf,width,height,timg
  
        CopyStructure(@*this\cfont,@*this\ltype()\font,font)
        
        key = word+ *this\cfont\name + Str(*this\cfont\size)+Str(*this\cfont\style)+Str(*this\ltype()\font\color)
        timg = *this\glyphs(key)\img
        If Not timg
          tf=LoadFont(#PB_Any, *this\cfont\name,*this\cfont\size,*this\cfont\style)
          timg = CreateImage(#PB_Any,1,1)
          StartDrawing(ImageOutput(timg))
             DrawingFont(FontID(tf))
               width = TextWidth(word)
               height = TextHeight(word)
           StopDrawing()
           FreeImage(timg)
           If width
                *this\ltype()\img = CreateImage(#PB_Any,width,height,24)
                 StartDrawing(ImageOutput(*this\ltype()\img))
                    DrawingMode(#PB_2DDrawing_Default)
                    DrawingFont(FontID(tf))
                    DrawText(0,0,word,*this\ltype()\font\color,*this\BackColor)
                StopDrawing()
                *this\glyphs(key)\img =  *this\ltype()\img
                *this\glyphs(key)\ref+1
          EndIf
          If IsFont(tf)
            FreeFont(tf)
          EndIf
        Else
          *this\glyphs(key)\ref+1
          *this\ltype()\img = timg   
           width = ImageWidth(timg)
           height = ImageHeight(timg)
        EndIf   
          *this\ltype()\word = word
          *this\ltype()\width = width
            
          *this\ltype()\height = height
          If  *this\ltype()\height  >= *this\max
             *this\max =  *this\ltype()\height
          EndIf
   
  EndProcedure

Procedure TextGadgetEx_AddText(*this.TextGadgetEX,mword.s,font=-1,size=12,color=-1,style=0)
  Protected timg,width,height,ct,word.s,a,tf.i,key.s,ttword.s
  Protected hStyle,hColor,hlen,tword.s ,tele,b;,*hitem.symbol 
If ListSize(*this\ltype()) = 0
   AddElement(*this\ltype())
   If *this\cfont\size <> 0
      CopyStructure(*this\cfont,*this\ltype()\font,font)
    EndIf
EndIf

If  *this\SelEnd <> 0 And *this\selStart <> 0 
   TextGadgetEx_ClearSelection(*this)
EndIf
*this\SelEnd = 0

ct = Len(mword)
 
  If *this\cfont\size = 0 And font = -1
    *this\cfont\name = *this\fonts[0]\name
  ElseIf font <> -1
    *this\cfont\name = *this\fonts[font]\name
  EndIf   
  *this\cfont\size = size
  *this\cfont\style = style
   If color = -1 : color = 0 : EndIf
   *this\cfont\color = color
   
    For a = 1 To ct
        word = Mid(mword,a,1) ;
        If *this\insert <> 0
            ChangeCurrentElement(*this\ltype(),*this\insert)
            If *this\ltype()\font\size <> 0 And *this\bedit
               CopyStructure(@*this\ltype()\font,@*this\cfont,font)
            EndIf   
       EndIf   

        AddElement(*this\ltype())
        *this\insert = @*this\ltype()
               
       If  Asc(word) = 13 Or Asc(word) = 10 Or Asc(word) = #TGEX_TAB
           *this\ltype()\word = word
           CopyStructure(@*this\cfont,@*this\ltype()\font,font);
           *this\ltype()\height = *this\max
           ;If (*this\bedit);  And *this\hl\rule(word) <> #TGEX_HL_Comments)
           ;  TextGadgetEx_CheckSyntax(*this)
           ;EndIf   
             Continue  
       EndIf 
       CopyStructure(@*this\cfont,@*this\ltype()\font,font)
       If word <> "" 
          *this\ltype()\word = word 
           ;If (*this\hl\rule(word) <> 0  And *this\bedit)
           ;  TextGadgetEx_CheckSyntax(*this)
          ; EndIf
           TextGadgetEX_CreateGlyph(*this,word)
       EndIf
  Next
   
  If IsFont(tf)
     FreeFont(tf)
  EndIf
   
EndProcedure

;************************************************************************************
;Interface Name ChooseFont()
;purpose  Opens a requester to add a font to the font array  
;params  none
; ************************************************************************************
Procedure TextGadgetEx_ChooseFont(*this.TextGadgetEX)
 
  If *this\fontcount < #MAXNUMFONT
     If  FontRequester("arial", 12, #PB_FontRequester_Effects)
       *this\fonts[*this\fontcount]\name = SelectedFontName()
       *this\fonts[*this\fontcount]\style = SelectedFontStyle()
       *this\fontcount+1
    EndIf
EndIf

EndProcedure   
;************************************************************************************
;Interface Name LoadFont()
;purpose  Opens a requester to add a font   
;params 
;    font: Font name
;    size:  size of font Y
;    style: style of font optional 
; ************************************************************************************
Procedure TextGadgetEx_LoadFont(*this.TextGadgetEX,font.s,size=12,style=0)
    If LoadFont(*this\fontcount,font,size,style)
      *this\fonts[*this\fontcount]\name = font
      *this\fonts[*this\fontcount]\style = style
      FreeFont(*this\fontcount)
      *this\fontcount+1
  EndIf   
EndProcedure
;************************************************************************************
;Interface Name StartMarquee()
;purpose  Starts Marquee Scrolling   
;params 
;    step:   the step in pixels 
;    fps:     Frames per second   
; ************************************************************************************
Procedure TextGadgetEx_StartMarquee(*this.TextGadgetEX,steps,fps)
  If Not *this\marquee\timer
      *this\marquee\delay = 1000 / fps
      
      If *this\mode = #TGEX_MarqueeH
        *this\marquee\mode = #TGEX_MarqueeH 
         *this\marquee\startX = *this\width
       Else 
         *this\marquee\mode = #TGEX_MarqueeV
         *this\marquee\startY = -*this\height
      EndIf    
      
      *this\marquee\steps = steps
      *this\marquee\timer = gTextGadgetExTimer
      AddWindowTimer(*this\win,gTextGadgetExTimer,1000/fps)
      gTextGadgetExTimer+1
      *this\start - *this\marquee\steps
      
    EndIf
 
EndProcedure 
;************************************************************************************
;Interface Name StopMarquee()
;purpose  Stop Marquee Scrolling remove timer   
; ************************************************************************************
Procedure TextGadgetEx_StopMarquee(*this.TextGadgetEX)
  If *this\marquee\timer
     RemoveWindowTimer(*this\win,*this\marquee\timer)
  EndIf    
   *this\marquee\timer = 0
  EndProcedure 
 
;************************************************************************************
;Interface Name OutPut()
;purpose  Draws the Document   
;params 
;    Start:  Scroll position optional
; ************************************************************************************
Procedure TextGadgetEx_Output(*this.TextGadgetEX)
  Protected posH,posW,row,tf,result,img1.i,st,et,currentword,startword,endword 
  Protected startposW,startPosH,LastElement
  Protected *tword.Words
   
  st=ElapsedMilliseconds()
  If *this\mode = #TGEX_WordWrap Or *this\marquee\mode = #TGEX_MarqueeV     
    posH=*this\max - *this\start
    posW = *this\MarginLeft 
  ElseIf *this\mode = #TGEX_MarqueeH
    posH =  (*this\height + *this\max) / 2 
    posW = *this\start 
  EndIf   
  
  *tword = *this\insert    
   
   If  GetWindowState(*this\win) <> #PB_Window_Minimize  And StartDrawing(ImageOutput(*this\textimg))        
    DrawingMode(#PB_2DDrawing_Default)
    Box(0,0,*this\width,*this\height,*this\backColor)
    If ListSize(*this\ltype()) > 0
      LastElement(*this\ltype())
      LastElement= @*this\ltype()  
      FirstElement(*this\ltype())
      startword = @*this\ltype()
      startposW = posW
      startPosH = posH
      ForEach *this\ltype()
        endword = @*this\ltype()
        If *this\mode = #TGEX_WordWrap  Or  *this\marquee\mode = #TGEX_MarqueeV   
          If (posW + *this\ltype()\width >= *this\width-*this\MarginRight) 
            posH + *this\max
            posW = *this\MarginLeft
            startposW = posW
            startPosH = posH
            row+1
          EndIf
        EndIf 
              
        If *this\ltype()\word = " " Or (Asc(*this\ltype()\word)=13)  Or @*this\ltype() = LastElement
          ChangeCurrentElement(*this\ltype(),startword) 
          Repeat 
            If StartposH > 0 And StartPosH < *this\height + *this\max And StartposW+*this\ltype()\width > 0 And StartposW < *this\width
              If  IsImage(*this\ltype()\img) 
                 DrawImage(ImageID(*this\ltype()\img),startposw,startposh-*this\ltype()\height);
                result=1  
               EndIf
            EndIf   
             
             If  (Asc(*this\ltype()\word)=10) 
               startposH + *this\max
               startposW = *this\MarginLeft
               row+1 
            ElseIf  (Asc(*this\ltype()\word)=#TGEX_TAB)
                startposW + (*this\ltype()\font\size * #TGEX_TAB_SIZE) - (startposW % (*this\ltype()\font\size * #TGEX_TAB_SIZE))
             EndIf 
            *this\ltype()\rc\left =   startPosW 
            *this\ltype()\rc\right =   startPosW +  *this\ltype()\width
            If *this\ltype()\height
              *this\ltype()\rc\top = startposH-*this\ltype()\height
            Else 
              *this\ltype()\rc\top = startposH-*this\max
            EndIf   
              *this\ltype()\rc\bottom = startPosH 
              *this\ltype()\line = row
              startPosW + *this\ltype()\width
              NextElement(*this\ltype())  
          Until @*this\ltype() = endword 
          startword = @*this\ltype()
          posW=startposW
          posH =startposH
      EndIf
      posW + *this\ltype()\width 
    Next    
    *this\ltype()\line = row  
  EndIf  
  StopDrawing()
      
  If *this\BackGroundImg
    StartDrawing(CanvasOutput(*this\Gadget)); 
      DrawingMode(#PB_2DDrawing_Default)
      DrawImage(ImageID(*this\BackGroundImg),0,0)
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      DrawAlphaImage(ImageID(*this\textimg),0,0,255-*this\alpha) 
      If *this\bedit  And *this\insert
        DrawingMode(#PB_2DDrawing_Default)
        Box(*tword\rc\right,*tword\rc\top,1,*this\max,0)
      EndIf
      If *this\bSelRange 
        DrawingMode(#PB_2DDrawing_AlphaBlend)
        ChangeCurrentElement(*this\ltype(),*this\insert)
        Protected tele,bnext 
        If (*this\mx > *this\ltype()\rc\left) Or (*this\my > *this\ltype()\rc\top) 
          bnext =1
          NextElement(*this\ltype())
        EndIf  
        Repeat 
           Box(*this\ltype()\rc\left,*this\ltype()\rc\top,*this\ltype()\width,*this\ltype()\height,RGBA(127,127,127,127))
           If *this\mx >= *this\ltype()\rc\left And *this\mx <= *this\ltype()\rc\right And *this\my >= *this\ltype()\rc\top-(*this\max*0.25) And *this\my <= *this\ltype()\rc\bottom+(*this\max*0.25) 
             *this\selEnd = @*this\ltype()
             Break 
           EndIf 
           If bnext  
              tele = NextElement(*this\ltype()) 
           Else  
             tele = PreviousElement(*this\ltype())
           EndIf 
         Until tele = 0
         If tele = 0
           *this\SelEnd = *this\SelStart
         Else   
           If Not bnext 
              tele = *this\SelEnd
             *this\SelEnd = *this\SelStart
             *this\SelStart = tele
           EndIf
         EndIf 
      ElseIf (*this\SelStart  And *this\SelEnd)
         DrawingMode(#PB_2DDrawing_AlphaBlend)
         ChangeCurrentElement(*this\ltype(),*this\SelStart)
         tele = NextElement(*this\ltype())
         While *this\selEnd <> @*this\ltype()  And tele <> 0
            Box(*this\ltype()\rc\left,*this\ltype()\rc\top,*this\ltype()\width,*this\ltype()\height,RGBA(127,127,127,127))
            tele = NextElement(*this\ltype())
         Wend 
      EndIf   
    StopDrawing()  
  Else 
    StartDrawing(CanvasOutput(*this\Gadget)) 
      DrawingMode(#PB_2DDrawing_Default)
      DrawImage(ImageID(*this\textimg),0,0) 
      If *this\bedit  And *this\insert
        DrawingMode(#PB_2DDrawing_Default)
        Box(*tword\rc\right,*tword\rc\top,1,*this\max,0)
      EndIf 
    StopDrawing()
  EndIf                         
   
  EndIf
  
  CompilerIf #DEBUG
    et = ElapsedMilliseconds() 
   *this\sum + et-st
   *this\count+1
   If *this\count > 1000 
     TextGadgetEx_AddText(*this," Time " + StrF(*this\sum / 1000,3) + " ",0,12,255,0)
     *this\count = 0
     *this\sum = 0
   EndIf   
  CompilerEndIf 
  
  ProcedureReturn result
  
EndProcedure

;************************************************************************************
;Interface Name ProcessEvents()
;purpose  processes marquee scroll input keys    
;; ************************************************************************************
Procedure TextGadgetEx_ProcessEvents(*this.TextGadgetEx,event.i,EventGadget.i,EventType.i)
  Protected evtimer,key.i,row,max,mx,my,ww,wh,mods 
 
  If event <> 0
  
    If event = #PB_Event_Timer
      evtimer = EventTimer()
      If (*this\marquee\timer <> 0 And evtimer= *this\marquee\timer) 
         TextGadgetEx_Marquee(*this,evtimer)
      EndIf
    EndIf 
      
    If EventGadget = *this\Gadget 
      
      Select EventType     
        Case  #PB_EventType_MouseEnter 
          If *this\isEditor 
            SetGadgetAttribute(*this\Gadget,#PB_Canvas_Cursor, #PB_Cursor_IBeam) 
          EndIf   ; 
        Case  #PB_EventType_MouseLeave     
             SetGadgetAttribute(*this\Gadget,#PB_Canvas_Cursor, #PB_Cursor_Default)  
        Case  #PB_EventType_MouseMove      
          If *this\bSelect 
            mx = GetGadgetAttribute(*this\Gadget,#PB_Canvas_MouseX) 
            my = GetGadgetAttribute(*this\Gadget,#PB_Canvas_MouseY)
            If mx And my <> 0
              If *this\mx <> mx And *this\my <> my And *this\bSelect  
                 *this\mx = mx 
                 *this\my = my  
                 TextGadgetEX_Output(*this)
                 *this\bSelRange = 1
                EndIf 
              EndIf   
          EndIf 
        Case  #PB_EventType_MouseWheel      
          TextGadgetEX_MouseScroll(*this,GetGadgetAttribute(*this\Gadget,#PB_Canvas_WheelDelta), GetGadgetAttribute(*this\Gadget,#PB_Canvas_Modifiers))   
        Case  #PB_EventType_LeftButtonDown   
          TextGadgetEx_ToggleEdit(*this)
          
        Case  #PB_EventType_LeftButtonUp    
          *this\bSelect = 0
          *this\bSelRange = 0
        Case  #PB_EventType_RightButtonDown  
        Case  #PB_EventType_RightButtonUp   
        Case #PB_EventType_Input 
           Debug "Input"
        Case  #PB_EventType_Focus          
        Case  #PB_EventType_LostFocus       
          If *this\lstate =1 
            SetActiveGadget(*this\Gadget)
          Else   
            *this\bedit = 0
            *this\SelEnd = 0
            TextGadgetEx_Output(*this)
          EndIf           
        Case #PB_EventType_KeyUp
          key =  GetGadgetAttribute(*this\Gadget,#PB_Canvas_Key)
          If key =  #TGEX_AltR
            *this\baltgt = 0
          EndIf  
        Case #PB_EventType_KeyDown         
         
             key =  GetGadgetAttribute(*this\Gadget,#PB_Canvas_Key)
             mods = GetGadgetAttribute(*this\Gadget,#PB_Canvas_Modifiers) 
            
             Select key   
               Case #PB_Shortcut_Left
                 *this\lstate = 1
                 ChangeCurrentElement(*this\ltype(),*this\insert)
                  PreviousElement(*this\ltype())
                 *this\insert = @*this\ltype()
                  TextGadgetEx_Output(*this)
               Case #PB_Shortcut_Right
                  *this\lstate  =1 
                  ChangeCurrentElement(*this\ltype(),*this\insert)
                  NextElement(*this\ltype())
                  *this\insert = @*this\ltype() 
                  TextGadgetEx_Output(*this)
               Case #PB_Shortcut_Up
                 *this\lstate = 1
                 ChangeCurrentElement(*this\ltype(),*this\insert)
                   row = *this\ltype()\line -1
                   If row >= 0
                     Repeat 
                       PreviousElement(*this\ltype())
                      Until row = *this\ltype()\Line  
                     *this\insert = @*this\ltype() 
                   EndIf 
                   TextGadgetEx_Output(*this)
               Case #PB_Shortcut_Down
                   *this\lstate = 1
                  LastElement(*this\ltype())
                  max = *this\ltype()\line
                  ChangeCurrentElement(*this\ltype(),*this\insert)
                  row = *this\ltype()\line+1
                  If row <= max
                    Repeat 
                        NextElement(*this\ltype())
                    Until row = *this\ltype()\Line  
                    If Not *this\ltype()\img 
                       NextElement(*this\ltype())
                    EndIf  
                    *this\insert = @*this\ltype() 
                  EndIf     
                  TextGadgetEx_Output(*this)
              Case #PB_Shortcut_Home
                ; *this\lstate = 1
                 *this\start = 0 
                 TextGadgetEx_Output(*this) 
              Case #PB_Shortcut_End
               ; *this\lstate = 1
                LastElement(*this\ltype())
                PreviousElement(*this\ltype())
                *this\start = *this\ltype()\rc\top
                TextGadgetEx_Output(*this)
               Case #PB_Shortcut_Escape
               Case #TGEX_AltR
                 *this\baltgt =1
               Case #TGEX_ShiftL,#TGEX_ShiftR, #TGEX_AltL  
               Case #TGEX_CAP,#TGEX_INS
               Case #TGEX_SRL,#TGEX_PBR 
               Case #TGEX_LWI,#TGEX_LWR,#TGEX_MEN  
               Case #PB_Shortcut_PageUp 
                  TextGadgetEx_Scroll(*this,-1,*this\height)
               Case #PB_Shortcut_PageDown    
                   TextGadgetEx_Scroll(*this,1,*this\height)
               Case #PB_Shortcut_Return
                 TextGadgetEx_AddText(*this,#CRLF$)   
                 TextGadgetEx_Output(*this)
               Case #PB_Shortcut_Delete
                  TextGadgetEx_Del(*this,#TGEX_Del)
               Case #PB_Shortcut_Back
                  TextGadgetEx_Del(*this,#TGEX_Back)
               Default     
                 *this\lstate =0
                 If *this\isEditor 
                 If mods = #PB_Canvas_Control
                     
                    Select key 
                     Case 'c','C'
                        If *this\SelEnd <> 0 And *this\SelStart <> 0 
                          TextGadgetEX_Copy(*this)
                           TextGadgetEx_Output(*this)
                        EndIf 
                     Case 'v','V'
                           TextGadgetEx_Paste(*this)
                            TextGadgetEx_Output(*this)
                         
                     Case 'a','A'
                       FirstElement(*this\ltype()) 
                       *this\SelStart = @*this\ltype() 
                       LastElement(*this\ltype())
                       PreviousElement(*this\ltype())
                       *this\SelEnd = @*this\ltype() 
                       *this\insert = *this\SelStart 
                        TextGadgetEx_Output(*this)
                      EndSelect
                    
                  Else 
                     
                     If key = #PB_Shortcut_Tab 
                       *this\lstate =1 
                     EndIf   
                     CompilerIf #PB_Compiler_OS = #PB_OS_Linux 
                       Debug "altgt " + Str(*this\baltgt)
                       If (Asc(Chr(key)) > 127 And (mods > 0 Or  *this\baltgt))
                          TextGadgetEx_AddText(*this,Chr(key)) 
                       ElseIf (Asc(Chr(key)) < 127 And mods < 2)
                         TextGadgetEx_AddText(*this,Chr(key)) 
                       EndIf   
                       TextGadgetEx_Output(*this)
                    CompilerEndIf  
                 EndIf   
                 EndIf
                EndSelect
             
          EndSelect         
      EndIf
      ww = WindowWidth(*this\win)
      wh =  WindowHeight(*this\win)
    
    If Event = #PB_Event_SizeWindow ;(ww <> *this\pWinWidth Or wh <> *this\pWinHeight)  
      TextGadgetEX_Rescale(*this,ww,wh)
    EndIf   
        
 EndIf
EndProcedure
;************************************************************************************
;Interface Name Scroll()
;purpose  Scroll the document   
;params 
;    Dir:  Direction  1 up 0 down 
;    Amount:   number of pixels 
; ************************************************************************************

Procedure TextGadgetEx_Scroll(*this.TextGadgetEX,dir,amount)
   If dir = 1 
     *this\start-amount
   Else
     *this\start+amount
   EndIf
   If *this\start < 0 And Not *this\marquee\timer 
     *this\start =0
   EndIf   
   TextGadgetEx_output(*this)
   
  EndProcedure 
   
;************************************************************************************
;Interface  Name GadgetID()
;Purpose  Returns the Gadget number for use in eventloop   
;params  none 
; ************************************************************************************ 
  Procedure  TextGadgetEx_Gadget(*this.TextGadgetEX)
      ProcedureReturn *this\Gadget
  EndProcedure
 ;************************************************************************************
; Interface Name:  SetGradient()
; Purpose:  Create a background gradient
; Params:  
;         mode #circular #Eliptical #Linear   
;         col1  1st color 
;         col2   2nd color 
;         alpha transparency 
;         radius or major axis 
;         minor minoraxis 
;************************************************************************************
  Procedure TextGadgetEX_SetGradient(*this.TextGadgetEX,mode,col1,col2,alpha=255,x=0,y=0,radius=0,minor=0)
    Protected r,m
    If *this\BackGroundImg
      FreeImage( *this\BackGroundImg )
    EndIf   
   *this\alpha = Alpha 
    *this\BackGroundImg = CreateImage(#PB_Any,*this\width,*this\height,24)
    StartDrawing(ImageOutput(*this\BackGroundImg))
      DrawingMode(#PB_2DDrawing_Gradient)   
     GradientColor(0.0, col1)
     GradientColor(1.0, col2)
       
    Select mode
       Case #Circular
          If radius
             r = radius
          Else
            r = Sqr((*this\width-x) * (*this\width-x) + (*this\height-y) * (*this\height-y))  / 2
          EndIf   
         If x Or y   
            CircularGradient(x,y,r)
         Else
           CircularGradient(*this\width/2,*this\height/2,r)
         EndIf   
         Circle(*this\width/2,*this\height/2,r)
      Case #Eliptic 
          If radius Or minor
            r = radius
            m = minor
          Else
            r = (*this\width-x)
            m=(*this\height-y)
          EndIf   
         If x Or y   
            EllipticalGradient(x,y,r,m)
         Else
            EllipticalGradient(*this\width/2,*this\height/2,r,m)
         EndIf   
         Ellipse(*this\width/2,*this\height/2,r,r)
      Case #Linear   
         LinearGradient(0, 0, 0, *this\height)   
         Box(0,0,*this\width,*this\height)   
     EndSelect   
    
     StopDrawing()
     
     If IsImage(*this\BackBuffer)
        FreeImage(*this\BackBuffer)
     EndIf 
     *this\BackBuffer = CopyImage(*this\BackGroundImg,#PB_Any) 
          
  EndProcedure   
 ;************************************************************************************
;interface name Zoom(scale.f)
;purpose  zooms the font      
;params scale.f 
; ************************************************************************************
  Procedure TextGadgetEX_ScaleFont(*this.TextGadgetEX,scale.f=1,bRedraw=1)
    Protected tf,width,height,timg,ts.i,key.s
    
    ts = *this\max * scale 
    If ts < *this\width*0.50 And ts > 8 
        
      *this\Scalefont = scale 
      *this\cfont\size * *this\scalefont 
      If *this\cfont\size >= 12 And *this\cfont\size <=28 
       *this\cfont\size + *this\cfont\size % 2
      ElseIf *this\cfont\size >=28 And *this\cfont\size <=72
        *this\cfont\size + *this\cfont\size % 4
      ElseIf  *this\cfont\size >= 72 
        *this\cfont\size + *this\cfont\size % 8
      EndIf  
      *this\max =0
      ForEach *this\ltype() 
        If *this\ltype()\font\size <> 0  And (Asc(*this\ltype()\word) <> 13) And (Asc(*this\ltype()\word) <> 10)  
          If Asc(*this\ltype()\word) <> 9
              key = *this\ltype()\word+ *this\ltype()\font\name+Str( *this\ltype()\font\size)+Str(*this\ltype()\font\style)+Str(*this\ltype()\font\color) 
              If IsImage(*this\glyphs(key)\img)
                  *this\glyphs(key)\ref -1
                  If *this\glyphs(key)\ref = 0 
                    FreeImage(*this\glyphs(key)\img)
                   *this\glyphs(key)\img = 0 
                  EndIf 
              EndIf 
                      
              *this\ltype()\font\size * *this\scalefont                             
               If  *this\ltype()\font\size >= 12 And  *this\ltype()\font\size <=28 
                 *this\ltype()\font\size + *this\ltype()\font\size % 2
              ElseIf  *this\ltype()\font\size >=28 And  *this\ltype()\font\size <=72
                 *this\ltype()\font\size + *this\ltype()\font\size % 4
              ElseIf  *this\ltype()\font\size >= 72 
                *this\ltype()\font\size + *this\ltype()\font\size % 8
              EndIf     
              
              If  *this\ltype()\font\size = 0 
                Debug *this\ltype()\word 
                Debug "oops"
              EndIf 
              
              
              
              key = *this\ltype()\word+ *this\ltype()\font\name+Str( *this\ltype()\font\size)+Str(*this\ltype()\font\style)+Str(*this\ltype()\font\color)  
              timg = *this\glyphs(key)\img              
              
              If Not timg
                  If IsFont(tf)
                     FreeFont(tf)
                  EndIf
                  
                  tf=LoadFont(#PB_Any,*this\ltype()\font\name,*this\ltype()\font\size,*this\ltype()\font\style)
                  timg = CreateImage(#PB_Any,1,1)
                  StartDrawing(ImageOutput(timg))
                    DrawingFont(FontID(tf)) 
                    width = TextWidth(*this\ltype()\Word)
                    height = TextHeight(*this\ltype()\Word) 
                  StopDrawing() 
                  FreeImage(timg)
                  If width 
                    *this\ltype()\img = CreateImage(#PB_Any,width,height,24)
                    StartDrawing(ImageOutput(*this\ltype()\img))
                      DrawingMode(#PB_2DDrawing_Default)
                      DrawingFont(FontID(tf)) 
                      DrawText(0,0,*this\ltype()\Word,*this\ltype()\font\color,*this\BackColor)
                      StopDrawing()
                      *this\glyphs(key)\img =  *this\ltype()\img
                      *this\glyphs(key)\ref +1
                    EndIf 
             Else 
                *this\glyphs(key)\ref+1
                *this\ltype()\img = timg   
                width = ImageWidth(timg)
                height = ImageHeight(timg)
              EndIf 
          Else
             *this\ltype()\font\size * *this\scalefont    
          EndIf  
          *this\ltype()\width = width
          *this\ltype()\height = height
             If  *this\ltype()\height  >= *this\max
                 *this\max =  *this\ltype()\height
            EndIf
         EndIf    
      Next   
      If bRedraw 
         TextGadgetEx_Output(*this)
      EndIf 
    EndIf 
  
  EndProcedure
  
  ;-End of TextGadgetEX
; ************************************************************************************ 

;for sake of  having a background image julia set
Global mback 
Procedure CreateBackground(w,h)
   Protected x,y,i,j,nR.d,nI.d,aR.d,aI.d,cR.f,cI.f,z.f,c.i,px.f,py.f
   z.f=1.0 
   cI.f=0.26015
   cR.f=-0.72
   px=w/2
   py=h/2
   mback = CreateImage(#PB_Any,w,h,32)
   StartDrawing(ImageOutput(mback))
   For x = 1 To w -1
    For y = 1 To h-1
        nR=(x-w/2)/(0.5*z*w)+(1/w*(px-(w/2)))
        nI=(y-h/2)/(0.5*z*h)+(1/h*(py-(h/2)))
        For i = 0 To 128-1
          aR=nR:
          aI=nI:
          nR=aR*aR-aI*aI+cR:
          nI=2*aR*aI+cI:
          If((nR*nR+nI*nI)>4)
            Break
          EndIf
        Next
        c = Pow(i,4)
        Plot(x,y,c)
    Next
  Next
  StopDrawing():
   
EndProcedure 
;******************************************************************************************************
;-Example
; Start button starts Top marquee 
; Stop button Stops Top and right marquee  
; Clear button clears left panel 
; right click on right panel starts marquee 
; mouse wheel scrolls gadget up down or left right 
; left click in gadget toggles edit mode in the left and right panels
; arrow keys navigate cursor 
; backspace and del deletes 
; return key new line 
; tab tab 
; ctrl+a select all 
; ctrl+c copy selection
; ctrl+a paste selection 
; selection left click drag 
; Resize window scales panels note difference in gadget attributes regarding how they scale
; crtl + mousewheel zooms the text 
;******************************************************************************************************
Define a,ev,evt,evg,txt.s,rh,flags.i
;Declare gadget variables
Global *tg1.TextGadget_EX
Global *tg2.TextGadget_EX
Global *tg3.TextGadget_EX
Global butUP,butDown,ButStart,butclear,butStop
Global strLorum.s = "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt"
strLorum + "ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"
strLorum + "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate"
strLorum + "velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt"
strLorum + "in culpa qui officia deserunt mollit anim id est laborum." + #CRLF$  

;create a background image 
CreateBackground(400,530)
flags = #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget |#PB_Window_MaximizeGadget 
OpenWindow(0,0,0,800,600,"text",flags)
*tg1 = New_TextGadgetEx(0,0,40,400,530,20,10,RGB(255,255,255),1,mback,64,#TGEX_WordWrap,#TGEX_ScaleFont | #TGEX_ScaleGadget)
*tg2 = New_TextGadgetEX(0,0,0,800,40,0,0,RGB(255,255,255),0,0,0,#TGEX_MarqueeH,#TGEX_ScaleGadget)
*tg3 = New_TextGadgetEX(0,400,40,400,530,20,10,RGB(255,255,255),0,0,0,#TGEX_WordWrap,#TGEX_ScaleGadget)

butClear = ButtonGadget(#PB_Any,0,575,60,25,"Clear")
butUp = ButtonGadget(#PB_Any,60,575,60,25,"Up")
butDown =ButtonGadget(#PB_Any,120,575,60,25,"Down")
ButStart = ButtonGadget(#PB_Any,180,575,60,25,"Start")
butStop = ButtonGadget(#PB_Any,240,575,60,25,"Stop")

*tg1\ChooseFont() 
*tg2\ChooseFont()   

*tg1\AddText("Click to edit " + #CRLF$ + " here ",0,14)
*tg1\Output()

*tg2\AddText("TextGadgetEX Demo Horizontal Marquee Mode ",0,18,RGB(0,255,0))
*tg2\Output()

;load a font for other marquee
*tg3\LoadFonts("arial",10)
*tg3\SetGradient( #Linear ,RGB(0,64,255),RGB(255,255,255),127)
*tg3\AddText("Right Click to start Marquee " + #CRLF$,1,12,RGB(Random(127),Random(127),Random(127)))
For a = 0 To 100
   *tg1\AddText(strLorum,0,10,RGB(0,0,0),0); 
   *tg3\AddText(strLorum,0,10,RGB(0,0,0),0); 
Next   
*tg1\Output()
*tg3\Output()
*tg2\StartMarquee(1,60)

Repeat
 
  ev = WaitWindowEvent() 
  Select ev
      Case #PB_Event_Gadget
        evg = EventGadget()
        evt = EventType()   
        Select evg
          Case butClear 
            *tg1\Clear()
           Case butUP
              *tg1\Scroll(1,5)
           Case butDown
              *tg1\Scroll(0,5)
           Case ButStart
                *tg2\StartMarquee(1,60)
            Case butStop 
               *tg2\StopMarquee()
               *tg3\StopMarquee()
            Case *tg3\GadgetID()
                If evt = #PB_EventType_RightButtonDown  
                    *tg3\StartMarquee(-2,30)
                EndIf
         EndSelect
      Case #PB_Event_SizeWindow 
        rh = WindowHeight(0)-25
        ResizeGadget(butclear,0,rh,60,25)
        ResizeGadget(butup,60,rh,60,25)
        ResizeGadget(butDown,120,rh,60,25)
        ResizeGadget(ButStart,180,rh,60,25)
        ResizeGadget(butStop,240,rh,60,25)
        
    EndSelect
        
    ;Process Gadget events. mousewheel, marquee and editing 
    *tg1\ProcessEvents(ev,evg,evt)
    *tg2\ProcessEvents(ev,evg,evt)
    *tg3\ProcessEvents(ev,evg,evt)
       
    Until ev = #PB_Event_CloseWindow
   
   *tg2\free()
   *tg1\free()   
   *tg3\free()

Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Scroll text horizontally

Post by Fangbeast »

whats that about my sheep. Here's some festering old buggy mess from a decade ago PB 4.60, it scrolls and zooms nicely with ctrl and mouse wheel
To be fair, the sheep were srod's first and some of the positions he put them in were medically impossible but then you got a hold of them and did those *shudder* things that we cannot speak of.

Wow, that's a huge bit of code that I will never understand but I'll steal it anyway (The polite term would have been 'snag' but i'm not polite, only an old goat)
Amateur Radio, D-STAR/VK3HAF
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post by Saki »

The problems with scrolling are due to the OS, you can't fix that.
Scrolling and moving causes problems on WinOS, no matter what you do.
You can't fix that.
It always depends on whether the micro jerk falls into the delay or beside it.
So it's sometimes there, sometimes a lot, sometimes a little, sometimes it's gone.

It also has nothing to do with picking fights,
he started it, then the answer is appropriate.
That's not bad either, but it does get a bit more rustic.
Half a metre of code for a line of text is already heavy.
And why I don't use JavaScript, well, that's easy, because I code in PB and not in JavaScript.
Last edited by Saki on Sat Apr 10, 2021 4:55 pm, edited 1 time in total.
地球上の平和
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Scroll text horizontally

Post by netmaestro »

@JHPJHP: Thank you for posting that wonderful example! Many coders (including myself) often dismiss CSS as a potential solution. It sits dormant, unsung and unloved until someone puts its awesome power on display. Super solution, hats off. :mrgreen:
walbus wrote:Scrolling and moving causes problems on WinOS, no matter what you do.
You can't fix that.
What you mean is you can't fix that. There are many very skilled German PB coders and if you are able to put your enormous ego aside and take constructive criticism when it comes you may someday be counted among them.
BERESHEIT
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post by Saki »

Well, you're certainly right.

I value your opinion, as well as that of JHPJHP, RASHAD and all the others.
When you challenge people a little bit, you usually get a lot of nice codes out of it.
I myself don't see it maliciously, more as an exchange of codes and opinions to create something new.
Without looking at what others can do and how they do it, I would be lost anyway.
My interests are rather limited, some graphics, some cypher, self created databases, that's it.
Corona probably leads to doing a lot of unimportant things that you don't have time for otherwise.

Here is something to inspire, its ready.
I don't think gradient color on the text background makes sense, it's just a nuisance.

Image
地球上の平和
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Scroll text horizontally

Post by mk-soft »

I still can't get a jerk-free output ...

Update
- Added Calc Delay
- Added SendEvent
- Fix Linux

Code: Select all

;-TOP

;- Begin Mini Thread Control

;  by mk-soft, Version 1.08, 20.10.2019

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf

Structure udtThreadControl
  ThreadID.i
  UserID.i
  Signal.i
  Pause.i
  Exit.i
EndStructure

Procedure StartThread(*Data.udtThreadControl, *Procedure) ; ThreadID
  If Not IsThread(*Data\ThreadID)
    *Data\Exit = #False
    *Data\Pause = #False
    *Data\ThreadID = CreateThread(*Procedure, *Data)
  EndIf
  ProcedureReturn *Data\ThreadID
EndProcedure

Procedure StopThread(*Data.udtThreadControl, Wait = 1000) ; Void
  If IsThread(*Data\ThreadID)
    *Data\Exit = #True
    If *Data\Pause
      *Data\Pause = #False
      SignalSemaphore(*Data\Signal)
    EndIf
    If Wait
      If WaitThread(*Data\ThreadID, Wait) = 0
        KillThread(*Data\ThreadID)
      EndIf
      *Data\ThreadID = 0
      *Data\Pause = #False
      *Data\Exit = #False
      If *Data\Signal
        FreeSemaphore(*Data\Signal)
        *Data\Signal = 0
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure FreeThread(*Data.udtThreadControl, Stop = #True, Wait = 1000) ; True or False
  If IsThread(*Data\ThreadID)
    If Stop
      StopThread(*Data, Wait)
      FreeStructure(*Data)
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  Else
    If *Data\Signal
      FreeSemaphore(*Data\Signal)
    EndIf
    FreeStructure(*Data)
    ProcedureReturn #True
  EndIf
EndProcedure

Procedure ThreadPause(*Data.udtThreadControl) ; Void
  If IsThread(*Data\ThreadID)
    If Not *Data\Signal
      *Data\Signal = CreateSemaphore()
    EndIf
    If Not *Data\Pause
      *Data\Pause = #True
    EndIf
  EndIf
EndProcedure

Procedure ThreadResume(*Data.udtThreadControl) ; Void
  If IsThread(*Data\ThreadID)
    If *Data\Pause
      *Data\Pause = #False
      SignalSemaphore(*Data\Signal)
    EndIf
  EndIf
EndProcedure

;- End Mini Thread Control

;- Begin macOS NapStop

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  ; Author : Danilo
  ; Date   : 25.03.2014
  ; Link   : https://www.purebasic.fr/english/viewtopic.php?f=19&t=58828
  ; Info   : NSActivityOptions is a 64bit typedef - use it with quads (.q) !!!
  
  #NSActivityIdleDisplaySleepDisabled             = 1 << 40
  #NSActivityIdleSystemSleepDisabled              = 1 << 20
  #NSActivitySuddenTerminationDisabled            = (1 << 14)
  #NSActivityAutomaticTerminationDisabled         = (1 << 15)
  #NSActivityUserInitiated                        = ($00FFFFFF | #NSActivityIdleSystemSleepDisabled)
  #NSActivityUserInitiatedAllowingIdleSystemSleep = (#NSActivityUserInitiated & ~#NSActivityIdleSystemSleepDisabled)
  #NSActivityBackground                           = $000000FF
  #NSActivityLatencyCritical                      = $FF00000000
  
  Procedure BeginWork(Option.q, Reason.s= "MyReason")
    Protected NSProcessInfo = CocoaMessage(0,0,"NSProcessInfo processInfo")
    If NSProcessInfo
      ProcedureReturn CocoaMessage(0, NSProcessInfo, "beginActivityWithOptions:@", @Option, "reason:$", @Reason)
    EndIf
  EndProcedure
  
  Procedure EndWork(Activity)
    Protected NSProcessInfo = CocoaMessage(0, 0, "NSProcessInfo processInfo")
    If NSProcessInfo
      CocoaMessage(0, NSProcessInfo, "endActivity:", Activity)
    EndIf
  EndProcedure
CompilerEndIf

;- End macOS NapStop

; ********

;-Begin SendEvent

; Comment : SendEvent
; Author  : mk-soft
; Version : v1.06
; Create  : unknown
; Update  : 07.08.2016

;- Structure
Structure udtSendEvent
  Signal.i
  Result.i
  *pData
EndStructure

; ----

Procedure SendEvent(Event, Window = 0, Object = 0, EventType = 0, pData = 0, Semaphore = 0)
  
  Protected MyEvent.udtSendEvent, result
  
  With MyEvent
    If Semaphore
      \Signal = Semaphore
    Else
      \Signal = CreateSemaphore()
    EndIf
    \pData = pData
    PostEvent(Event, Window, Object, EventType, @MyEvent)
    WaitSemaphore(\Signal)
    result = \Result
    If Semaphore = 0
      FreeSemaphore(\Signal)
    EndIf
  EndWith
  
  ProcedureReturn result
  
EndProcedure

; ----

Procedure SendEventData(*MyEvent.udtSendEvent)
  ProcedureReturn *MyEvent\pData
EndProcedure

; ----

Procedure DispatchEvent(*MyEvent.udtSendEvent, result)
  *MyEvent\Result = result
  SignalSemaphore(*MyEvent\Signal)
EndProcedure

;- End SendEvent

; ********

;-* Example 4: Text Scroll

#Example = 4

CompilerIf #Example = 4
  
  ; ---- String Helper ----
  
  Procedure AllocateString(String.s) ; Result = Pointer
    Protected *mem.string = AllocateStructure(String)
    If *mem
      *mem\s = String
    EndIf
    ProcedureReturn *mem
  EndProcedure
  
  Procedure.s FreeString(*mem.string) ; Result String
    Protected r1.s
    If *mem
      r1 = *mem\s
      FreeStructure(*mem)
    EndIf
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Enumeration #PB_Event_FirstCustomValue
    #MyEvent_ThreadSendString
    #MyEvent_ThreadSendImage
    #MyEvent_ThreadFinished
  EndEnumeration
  
  Enumeration Gadget
    #Canvas
    #List
    #ButtonStart1
    #ButtonPauseResume1
    #ButtonStop1
  EndEnumeration
  
  
  ; Extends always own data structure with structure from thread control
  Structure udtThreadData Extends udtThreadControl
    ; Parameters
    Window.i
    Text.s
    Delay.i
    Font.i
    FrontColor.i
    BackColor.i
    OutputWidth.i
    OutputHeight.i
  EndStructure
  
  Procedure MyThread(*Data.udtThreadData)
    Protected Image, OutputImage
    Protected x, y, dx, dy, dummy
    Protected text_dx, text_dy
    Protected offset_dx, delay_time, time
    
    With *Data
      
      ; Get text range
      dummy = CreateImage(#PB_Any, 32, 32)
      If StartDrawing(ImageOutput(dummy))
        DrawingFont(FontID(\Font))
        text_dx = TextWidth(\Text)
        text_dy = TextHeight(\Text)
        StopDrawing()
      Else
        ProcedureReturn 0
      EndIf
      FreeImage(dummy)
      
      ; Create image
      dx = \OutputWidth * 2 + text_dx
      dy = \OutputHeight
      
      Image = CreateImage(#PB_Any, dx, dy, 32, \BackColor)
      If StartDrawing(ImageOutput(Image))
        DrawingFont(FontID(\Font))
        x = \OutputWidth
        y = \OutputHeight / 2 - text_dy / 2
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(x, y, \Text, \FrontColor)
        StopDrawing()
      Else
        ProcedureReturn 0
      EndIf
      
      ; Begin
      dx = \OutputWidth + text_dx
      delay_time = ElapsedMilliseconds()
      
      Repeat
        ; 1. Query on thread pause
        If \Pause
          WaitSemaphore(\Signal)
          ; Continue
          delay_time = ElapsedMilliseconds()
        EndIf
        ; 2. Query on thread cancel
        If \Exit
          Break
        EndIf
        ; Cyle Process
        delay_time = ElapsedMilliseconds()
        OutputImage = GrabImage(Image, #PB_Any, offset_dx, 0, \OutputWidth, \OutputHeight)   
        SendEvent(#MyEvent_ThreadSendImage, \Window, 0, 0, OutputImage)
        FreeImage(OutputImage)
        ; new offset
        offset_dx + 2
        If offset_dx > dx
          offset_dx = 0
        EndIf
        ; calc delay
        time = \Delay - (ElapsedMilliseconds() - delay_time)
        If time > 0
          Delay(time)
        EndIf
      ForEver
      
      ; Free resources
      If IsImage(Image)
        FreeImage(Image)
      EndIf
      
      If IsImage(OutputImage)
        FreeImage(OutputImage)
      EndIf
      
      ; 3. Clear ThreadID 
      \ThreadID = 0
    EndWith
  EndProcedure
  
  ;-- Main
  
  ; Create Data always with AllocateStructure  
  Global *th1.udtThreadData = AllocateStructure(udtThreadData)
  With *th1
    \UserID = 1
    \Window = 1
    \OutputWidth = 590
    \OutputHeight = 100
    \FrontColor = #Blue
    \BackColor = #Yellow
    \Font = 0
    \Text = "Mini Thread Control - Scroll Text Example !"
    \Delay = 16
  EndWith
  
  Global image
  Global event_image
  
  LoadFont(0, "Arial", 36, #PB_Font_Bold)
  
  If OpenWindow(1, 50, 50, 600, 400, "Mini Thread Control", #PB_Window_SystemMenu)
    CanvasGadget(#Canvas, 5, 5, 590, 100, 0)
    ListViewGadget(#List, 5, 110, 590, 250)
    
    ButtonGadget(#ButtonStart1, 5, 365, 120, 30, "Start")
    ButtonGadget(#ButtonPauseResume1, 130, 365, 120, 30, "Pause")
    ButtonGadget(#ButtonStop1, 255, 365, 120, 30, "Stop")
    Repeat
      Select WaitWindowEvent() 
        Case #PB_Event_CloseWindow
          FreeThread(*th1)
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #ButtonStart1
              StartThread(*th1, @MyThread())
            Case #ButtonPauseResume1
              If IsThread(*th1\ThreadID)
                If Not *th1\Pause
                  ThreadPause(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Resume")
                Else
                  ThreadResume(*th1)
                  SetGadgetText(#ButtonPauseResume1, "Pause")
                EndIf
              EndIf
            Case #ButtonStop1
              StopThread(*th1)
              SetGadgetText(#ButtonPauseResume1, "Pause")
              
          EndSelect
          
        Case #MyEvent_ThreadSendImage
          event_image = EventData()
          image = SendEventData(event_image)
          CompilerIf #PB_Compiler_OS = #PB_OS_Linux
            If StartDrawing(CanvasOutput(#Canvas))
              DrawImage(ImageID(image), 0, 0)
              StopDrawing()
            EndIf
          CompilerElse
            SetGadgetAttribute(#Canvas, #PB_Canvas_Image, ImageID(image)) ; Linux not work with depth 32
          CompilerEndIf
          DispatchEvent(event_image, 1)
      EndSelect
    ForEver
  EndIf
  
CompilerEndIf
Last edited by mk-soft on Sun Apr 11, 2021 12:33 pm, edited 3 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post by Saki »

It is related to the processing of window events.
Whenever there is a traffic jam here it hangs.
地球上の平和
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Scroll text horizontally

Post by mk-soft »

It's just not a real-time operating system.
But it runs quite well for a normal gadget with graphics.
The only alternative is OpenGL or DirectX.

P.S. Linux Bug ?!
OS: Ubuntu 20.04 (x64)
[21:23:26] [WARNING] MiniThreadControl_SendImages.pb (Zeile: 299)
[21:23:26] [WARNING] GdkPixbuf (CRITICAL): gdk_pixbuf_copy_area: assertion '!(gdk_pixbuf_get_has_alpha (src_pixbuf) && !gdk_pixbuf_get_has_alpha (dest_pixbuf))' failed
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply