TextEditGadgetEx PB 4.60

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
idle
Always Here
Always Here
Posts: 5886
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

TextEditGadgetEx PB 4.60

Post by idle »

Cross platform freestyle TextEditGadgetEx
Windows / Linux
PB 4.60

Features
-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
-Editor

Editor
Select Copy Paste
-mouse selection
-select all ctrl+a
-copy ctrl+c
-paste ctrl+v
Cursor navigation
- arrow keys
Page navigation
-home
-End
-page up
-page down
-mouse wheel
Input keys
-Tab
-Delete
-Backspace
-Return
-All print keys with, AltGtr key support for international keyboards
(numeric keypad not working linux)

Todo
-Columns tables pages
-Aligned images auto text wrap
-Spell Checker (maybe)
-Auto complete (maybe)
-Screen mode

Build history
v 0.58
fixed clear bug
v 0.57b
Changed to use 4.60 canvas gadget, added Glyph cache, fixed reverse selection copy. fixed tab key windows
v 0.56
tab
mouse selection
clipboard function for text only copies and pastes unformated text to from external apps
copies and pastes formated text internally between gadgets
Select all ctrl+ A
copy ctrl + C
paste ctrl + V
tab
v 0.55
changed navigation to single letters, added delete key, changed font sizing
v 0.541
fixed minimize window bug windows
v0.54
fixed cursor bug, page navigation bug, minimize on windows .
v0.54b
fixed font scale mode change on clear or wheel zoom, start of line bug
Added scroll down on input, page up, page down,home,end , changed scroll to scroll by text height
v0.53a
Redid drawing was taking ~30ms on right panel running marquee down to ~11ms should aim for around 6-8ms
v 0.52a+
Added AltGtr key support international keyboards
v 0.51a
fixed return bug traped non print keys
v 0.5a
added Auto resize , scaling and font zoom
v 0.41b
added cursor navigation With arrow keys
v 0.4b
added input cursor, return & backspace, clear
v 0.4a
Added basic Editing, needs better handling of messages, and a cursor
v 0.3
Added Marquees
Added Gradients
Changed render method
v 0.2
added margins
fixed word wrap
fixed clear

Code: Select all

; Author: IDLE
; Date: March 4, 2011
; PB version: v4.60 linux windows 
; Version 0.58b 
; ******************************************************************************
;-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  
;Editor 
;  -  cursor navigation
;        arrow keys
;  -  page navigation
;         home, End, page up, page down
;         mouse wheel 
;  -  input keys 
;         backspace del tab
;         All print key with, AltGtr key support for international keyboards
;
;*******************************************************************************
;-Todo 
;*******************************************************************************
;  colums 
;  aligned images text will automatically wrap around images 
;  Screen mode 
;*******************************************************************************
;-build history
;*******************************************************************************
;v 0.57
;  changed to 4.60 , added Glyph cache, fixed backwards selection copy 
;v 0.56
;  tab 
;  mouse selection 
;  clipboard function for text only copies and pastes unformated text to from external apps
;                  copies and pastes formated text internally between gadgets   
;  Select all ctrl+ A 
;  copy  ctrl + C 
;  paste ctrl + V 
;  tab 
;v 0.55
; Changed to single letter navigation added del key 
;v 0.54
; fixed cursor bug, pageup/down home/end not working when another gadget is active
;v 0.54b
; fixed font scale mode, change on clear or wheel zoom, start of line bug
; Added scroll down on input, page up, page down,home,end , changed scroll to scroll by text height 
;v 0.53a 
; Redid drawing was taking ~30ms on right panel running marquee down to ~11ms should aim for around 6-8ms 
;v 0.52a+   
; Added AltGtr key support international keyboards
;v 0.51a 
;  fixed return bug traped non print keys 
;v 0.5a 
;  added Auto resize , scaling and font zoom 
;v 0.41b 
;  added cursor navigation With arrow keys   
;v 0.4b
; added input cursor, return & backspace, clear 
;v 0.4a
;Added basic Editing, needs better handling of messages, and a cursor
;need to trap the gadget clicks probably need to use a container gadget?
;to get events.
;V 0.3
;Added Marquees
;Added Gradients
;Changed render method
;v 0.2
;added margins
;fixed word wrap
;fixed clear

EnableExplicit

;-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
    
    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
    
    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\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

;************************************************************************************
; 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


;************************************************************************************
;Interface Name AddText()
;purpose Add a word to the Document
; params
;    word: the text to add
;    font:  font number
;    size:  Font size 
;    color:  Color of the font
;    style: font style #TGEX_REGULAR,#TGEX_ITALICS,#TGEX_BOLD,#TGEX_BOLDITALICS
;************************************************************************************
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
    
      Continue  
    EndIf 
    CopyStructure(@*this\cfont,@*this\ltype()\font,font)
    If word <> "" 
      *this\ltype()\word = word 
     
      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
    
  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    
      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,32,#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()


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(2,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()
Last edited by idle on Sat May 28, 2011 2:53 am, edited 53 times in total.
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: TextGadgetEx

Post by c4s »

Looks interesting but the word wrapping doesn't seem to work.
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: TextGadgetEx

Post by IdeasVacuum »

Very nice work Idle. The mouse wheel scroll works well in WinXP. Word Wrap not playing ball - the string is simply truncated. Would be interesting to see a X-platform gadget library, is that where this is headed?
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2139
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:
Contact Andre

Re: TextGadgetEx

Post by Andre »

idle, I assume this one is very good work :)

But I can't test it on Windows at the moment, and on my MacBook it doesn't run because of the WindowsAPI / Callback code.... any chance to have a MacOS-compatible version?
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
Top
User avatar
idle
Always Here
Always Here
Posts: 5886
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: TextGadgetEx

Post by idle »

When you say it's truncating do you mean it's not wrapping at all or is it wrapping the whole phrase?
If you want it to wrap by word you need to add a word individually otherwise It'll wrap by phrase.

Yes it is cross platform, though I don't have a mac so have no idea how to get the mousewheel to work for that.
I'm still not happy with the callback methods but will see if I can find a better solution.
the problem is that it can't use the objects pointer in the callback so currently it's using the global vars and checking in the main event loop.


@Andre
I changed the compiler checks, so the callback won't get compiled on mac.
I wouldn't know where to start to look for mousewheel support on osx, is it using x11 for it's windows?
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: TextGadgetEx

Post by IdeasVacuum »

...it literally truncates - the string displayed is only as much as will fit up to the right-hand edge of the window, the remaining portion of the string just disappears.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
Zach
Addict
Addict
Posts: 1676
Joined: Sun Dec 12, 2010 12:36 am
Location: Somewhere in the midwest
Contact:
Contact Zach

Re: TextGadgetEx

Post by Zach »

I am not having any problems with the code posted above?

I am not seeing any truncating or anything odd going on.. It seems to word wrap normally as well, even without adding only 1 word at a time.. The break point seems to correctly insert between words only and not in the middle of a word, etc..

My system is:
Windows 7 x64 (No service pack)
Core 2 Duo @ 3Ghz
Sapphire HD5850
Last edited by Zach on Sat Mar 05, 2011 12:41 am, edited 1 time in total.
Top
User avatar
Demivec
Addict
Addict
Posts: 4267
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: TextGadgetEx

Post by Demivec »

Zach wrote:I am not seeing any truncating or anything odd going on.. It seems to word wrap normally as well, even without adding only 1 word at a time.. The break point seems to correctly insert between words only and not in the middle of a word, etc..
Are you using a long text sample, or the default short one?
Top
Zach
Addict
Addict
Posts: 1676
Joined: Sun Dec 12, 2010 12:36 am
Location: Somewhere in the midwest
Contact:
Contact Zach

Re: TextGadgetEx

Post by Zach »

I typed my own in.. But not long enough to span the entire width. I will test this now

edit:
Here is a screen image

Image


I do get one error when I try to close the program however. It seems to be in the cleanup routine that Free's the fonts during shutdown.

Code: Select all

173: Procedure  TextGadgetEx_Clear(*this.TextGadgetEX)
174:     ForEach *this\ltype()
175:       FreeFont(*this\ltype()\font)
176:     Next
177:     ClearList(*this\ltype())
178:   EndProcedure
PB 4.51 Compiler wrote: [ERROR] Line: 175
[ERROR] The specified #Font is not initialized
The debugged executable quit unexpectedly
Last edited by Zach on Sat Mar 05, 2011 1:10 am, edited 1 time in total.
Top
User avatar
idle
Always Here
Always Here
Posts: 5886
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: TextGadgetEx

Post by idle »

I edited the code this morning, so it's adding the text word by word so it will wrap properly, before it was wrapping the phrases only.
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: TextGadgetEx

Post by c4s »

@Zach
Uhh, why is the "g" and "p" cut on your screenshot?
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
Top
Zach
Addict
Addict
Posts: 1676
Joined: Sun Dec 12, 2010 12:36 am
Location: Somewhere in the midwest
Contact:
Contact Zach

Re: TextGadgetEx

Post by Zach »

This is drawing text to images (Or "A" image, you know what I mean... its not text like a text box) , so that kind of bug is expected to show up depending on the font used. This can be solved by adding in a simple line height test, after initializing each of the chosen fonts, and setting the line height to the appropriate value.


Either that, or its some issue with the font and the way the screen is being drawn. I haven't looked at the code that deeply, but you'll notice the same letters in other fonts are fine.
Top
User avatar
idle
Always Here
Always Here
Posts: 5886
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: TextGadgetEx

Post by idle »

Thanks Zach for that bug report, that's a consequence of changing it to add single words and reusing the font.


@c4s
It's not cutting off the "g" or "p" it's just the font being used!
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
User avatar
idle
Always Here
Always Here
Posts: 5886
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: TextGadgetEx marquee

Post by idle »

Added Marquee modes (will generalize it later for direction)
Added Gradients circular elliptic linear
Haven't tested the new version on windows
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
User avatar
idle
Always Here
Always Here
Posts: 5886
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: TextEditGadgetEx edit mode added

Post by idle »

Added user Edit mode
still need to add a cursor to it
left click on gadget to toggle user input set insertion point, word boundaries only

V 0.4a+ Drawing mode redone, thanks djes
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
Post Reply

Return to “Tricks 'n' Tips”