module_editor

mestnyi · Post by **mestnyi** » Thu May 03, 2018 6:06 pm

It still needs a scrolling module
http://www.purebasic.fr/english/viewtop ... 12&t=70628
Update v0004

 ; IncludePath "C:\Users\as\Documents\GitHub\"
XIncludeFile "module_scroll.pbi"

; Module name   : Editor
; Author        : mestnyi
; Last updated  : Aug 7, 2018
; Forum link    : https://www.purebasic.fr/english/viewtopic.php?f=12&t=70650
;

EnableExplicit
;-
DeclareModule Editor
  EnableExplicit
 
  EnumerationBinary 4
  ;  #PB_Text_Center
  ;  #PB_Text_Right
    #PB_Text_Bottom
   
    #PB_Text_UpperCase
    #PB_Text_LowerCase
    #PB_Text_Password
   
    #PB_Text_Middle
    #PB_Text_MultiLine
  EndEnumeration
 
  #PB_Text_ReadOnly = #PB_String_ReadOnly
  #PB_Text_Numeric = #PB_String_Numeric
  #PB_Text_WordWrap = #PB_Editor_WordWrap
 
  ;   Debug #PB_Text_Center
  ;   Debug #PB_Text_Right
  ;   Debug #PB_Text_Bottom
  ;   
  ;   Debug #PB_Text_UpperCase
  ;   Debug #PB_Text_LowerCase
  ;   Debug #PB_Text_Password
  ;   
  ;   Debug #PB_Text_Middle
  ;   Debug #PB_Text_MultiLine
  ;   
  ;   Debug #PB_Text_ReadOnly
  ;   Debug #PB_Text_Numeric
  ;   
  ;   Debug #PB_Text_WordWrap
 
 
  ;- STRUCTURE
  Structure Coordinate
    y.l[3]
    x.l[3]
    Height.l[3]
    Width.l[3]
  EndStructure
 
  Structure Mouse
    X.l
    Y.l
    Buttons.l
  EndStructure
 
  Structure Canvas
    Mouse.Mouse
    Gadget.l
    Window.l
   
    Input.c
    Key.l[2]
   
  EndStructure
 
  Structure Text Extends Coordinate
    ;     Char.c
    Len.l
    String.s[2]
    Change.b
   
    XAlign.b
    YAlign.b
    Lower.b
    Upper.b
    Pass.b
    Editable.b
    Numeric.b
    WordWrap.b
    MultiLine.b
   
   
    Mode.l
  EndStructure
 
  Structure Gadget Extends Coordinate
    FontID.i
    Canvas.Canvas
   
    Pos.l[2] ; 0 = Pos ; 1 = PosFixed
    CaretPos.l[2] ; 0 = Pos ; 1 = PosFixed
    CaretLength.l
   
    Text.Text[4]
    ImageID.l[3]
    Color.l[3]
   
    Image.Coordinate
   
    fSize.l
    bSize.l
    Hide.b[2]
    Disable.b[2]
   
    Scroll.Scroll::_S_scroll
    
    Type.l
    InnerCoordinate.Coordinate
   
    Repaint.l
   
    List Items.Gadget()
    List Columns.Gadget()
  EndStructure
 
 
  ;- DECLARE
  Declare GetState(Gadget.l)
  Declare.s GetText(Gadget.l)
  Declare SetState(Gadget.l, State.l)
  Declare GetAttribute(Gadget.l, Attribute.l)
  Declare SetAttribute(Gadget.l, Attribute.l, Value.l)
  Declare SetText(Gadget, Text.s, Item.l=0)
  Declare SetFont(Gadget, FontID.i)
  Declare AddItem(Gadget,Item,Text.s,Image.l=-1,Flag.l=0)
  Declare Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
 
EndDeclareModule

Module Editor
 
  ;- PROCEDURE
 
  Procedure.s DrawMultiText(X, Y, Text.s, FontColor = $FFFFFF, BackColor = 0, Flags = 0, Width = 0, Height = 0)
    Protected Text_X, Text_Y
    Protected TxtHeight = TextHeight("A")
    Protected Is_Vcenter.b, Is_Hcenter.b, Is_Right.b, Is_Bottom.b
    Protected String.s, String1.s, String2.s, String3.s, CountString, IT, Start, Count, Break_Y
    ;Protected Time = ElapsedMilliseconds()
    If Width = 0 : Width = OutputWidth() : EndIf
    If Height = 0 : Height = OutputHeight() : EndIf
   
    ; Перевести разрывы строк
    Text = ReplaceString(Text, #LFCR$, #LF$)
    Text = ReplaceString(Text, #CRLF$, #LF$)
    Text = ReplaceString(Text, #CR$, #LF$)
    Text + #LF$
    ;
    CountString = CountString(Text, #LF$)
   
    Is_Right = Bool((Flags & #PB_Text_Right) = #PB_Text_Right)
    Is_Bottom = Bool((Flags & #PB_Text_Bottom) = #PB_Text_Bottom) 
   
    If Is_Right
      Is_Hcenter = Bool((Flags & #PB_Text_Center) = #PB_Text_Center)
    Else
      Is_Vcenter = Bool((Flags & #PB_Text_Center) = #PB_Text_Center)
    EndIf
   
    Is_Hcenter = Bool((Flags & #PB_Text_Middle) = #PB_Text_Middle) 
   
    If CountString
      ; make multi text
      For IT = 1 To CountString : Start = 1
        String = StringField(Text, IT, #LF$)
        Count = CountString(String, " ") + Start
       
        Repeat
          String1 = StringField(String, Start, " ")
         
          While (Count>=Start) : Start+1
            String2 = StringField(String, Start, " ")
           
            If (TextWidth(Trim(String1+" "+String2)) < (Width-Len(Mid(String2,Len(String2)))))
              String1 = Trim(String1+" "+String2)
            Else
              Break
            EndIf
          Wend
         
          String3+String1+#LF$
        Until (Start>Count)
      Next
     
      CountString = CountString(String3, #LF$)
     
      If CountString
        If Is_Hcenter : Text_Y=((Height-(TxtHeight*CountString))/2)
          ElseIf Is_Bottom : Text_Y=(Height-(TxtHeight*CountString)) : EndIf
       
        ; Text тратить
        For IT = 1 To CountString
          String1 = StringField(String3, IT, #LF$)
         
          If Is_Vcenter : Text_X = ((Width-TextWidth(String1))/2)
            ElseIf Is_Right : Text_X=(Width-TextWidth(String1)) : EndIf
          DrawText(X+Text_X, Y+Text_Y, String1, FontColor, BackColor)
         
          Text_Y+TxtHeight
          If Text_Y > (Height-TxtHeight)
            Break
          EndIf
        Next
      EndIf
     
    Else
      If Is_Hcenter : Text_Y=((Height-TxtHeight)/2)
        ElseIf Is_Bottom : Text_Y=(Height-TxtHeight) : EndIf
      If Is_Vcenter : Text_X = ((Width-TextWidth(Text))/2)
        ElseIf Is_Right : Text_X=(Width-TextWidth(Text)) : EndIf
      DrawText(X+Text_X, Y+Text_Y, Text, FontColor, BackColor)
    EndIf
   
    ;Debug "Time "+Str(Time-ElapsedMilliseconds())
   
    ProcedureReturn String3
   
  EndProcedure
 
  Procedure CaretPos(*This.Gadget)
    Protected Result.l =- 1, i.l, Len.l, Text_X.l, String.s,
              CursorX.l, Distance.f, MinDistance.f = Infinity()
   
    With *This
      If ListSize(\Items())
        String.s = \Items()\Text\String.s
        Text_X = \Items()\Text\x
        Len = \Items()\Text\Len
      Else
        String.s = \Text\String.s
        Text_X = \Text\x
        Len = \Text\Len
      EndIf
     
      If StartDrawing(CanvasOutput(\Canvas\Gadget))
        If \FontID : DrawingFont(\FontID) : EndIf
       
        For i=0 To Len
          \CaretLength = TextWidth(Left(String.s, i))
          CursorX = Text_X+\CaretLength+1
          Distance = (\Canvas\Mouse\X-CursorX)*(\Canvas\Mouse\X-CursorX)
         
          ; Получаем позицию коpректора
          If MinDistance > Distance
            MinDistance = Distance
            Result = i
          EndIf
        Next
       
        StopDrawing()
      EndIf
    EndWith
   
    ProcedureReturn Result
  EndProcedure
 
  Procedure SelectionText(*This.Gadget)
    Protected CaretPos
   
    With *This\Items()
      If *This\Pos[1]>*This\Pos
        PushListPosition(*This\Items())
        While PreviousElement(*This\Items()) : \Text[2]\Len = 0 : Wend
        PopListPosition(*This\Items())
      Else
        PushListPosition(*This\Items())
        While NextElement(*This\Items()) : \Text[2]\Len = 0 : Wend
        PopListPosition(*This\Items())
      EndIf
     
      ; Если выделяем с верху вниз
      If *This\Pos > *This\Pos[1]
        \Text[2]\Len = *This\CaretPos
      ElseIf *This\Pos[1] > *This\Pos
        CaretPos = *This\CaretPos
        \Text[2]\Len = \Text\Len-CaretPos
      Else
        ; Если выделяем с право на лево
        If *This\CaretPos[1] > *This\CaretPos
          CaretPos = *This\CaretPos
          \Text[2]\Len = (*This\CaretPos[1]-CaretPos)
        Else
          CaretPos = *This\CaretPos[1]
          \Text[2]\Len = (*This\CaretPos-CaretPos)
        EndIf
      EndIf
     
      If \Text[2]\Len
        \Text[1]\String.s = Left(\Text\String.s, CaretPos)
        \Text[2]\String.s = Mid(\Text\String.s, 1 + CaretPos, \Text[2]\Len)
        ; \Text[3]\String.s = Mid(\Text\String.s, 1 + CaretPos + \Text[2]\Len)
        \Text[3]\String.s = Right(\Text\String.s, \Text\Len-(CaretPos + \Text[2]\Len))
      Else
        \Text[2]\String.s = ""
      EndIf
    EndWith
   
    ProcedureReturn CaretPos
  EndProcedure
 
  Procedure RemoveText(*This.Gadget)
    With *This\Items()
      ;*This\CaretPos = 0
      If *This\CaretPos > *This\CaretPos[1] : *This\CaretPos = *This\CaretPos[1] : EndIf
      ; Debug "  "+*This\CaretPos +" "+ *This\CaretPos[1]
      ;\Text\String.s = RemoveString(\Text\String.s, Trim(\Text[2]\String.s, #LF$), #PB_String_CaseSensitive, 0, 1) ; *This\CaretPos
      \Text\String.s = RemoveString(\Text\String.s, \Text[2]\String.s, #PB_String_CaseSensitive, 0, 1) ; *This\CaretPos
      \Text\String.s[1] = RemoveString(\Text\String.s[1], \Text[2]\String.s, #PB_String_CaseSensitive, 0, 1) ; *This\CaretPos
      \Text[2]\String.s[1] = \Text[2]\String.s
      \Text\Len = Len(\Text\String.s)
      \Text[2]\String.s = ""
      \Text[2]\Len = 0
    EndWith
  EndProcedure
 
  Procedure Cut(*This.Gadget)
    Protected String.s
    ;;;ProcedureReturn Remove(*This)
   
    With *This\Items()
      If ListSize(*This\Items())
        ;If \Text[2]\Len
        If *This\Pos[1] = *This\Pos
          Debug "Cut Black"
          If \Text[2]\Len
            RemoveText(*This)
          Else
            \Text[2]\String.s[1] = Mid(\Text\String.s, *This\CaretPos, 1)
            \Text\String.s = Left(\Text\String.s, *This\CaretPos - 1) + Right(\Text\String.s, \Text\Len-*This\CaretPos)
            \Text\String.s[1] = Left(\Text\String.s[1], *This\CaretPos - 1) + Right(\Text\String.s[1], Len(\Text\String.s[1])-*This\CaretPos)
            *This\CaretPos - 1
          EndIf
        Else
          Debug " Cut " +*This\CaretPos +" "+ *This\CaretPos[1]+" "+\Text[2]\Len
         
          If \Text[2]\Len
            ;If *This\Pos > *This\Pos[1]
            RemoveText(*This)
            ;EndIf
           
            If \Text[2]\Len = \Text\Len
              SelectElement(*This\Items(), *This\Pos)
            EndIf
          EndIf
         
          ; Выделили сверх вниз
          If *This\Pos > *This\Pos[1]
            Debug "  Cut_1_ForEach"
           
            PushListPosition(*This\Items())
            ForEach *This\Items()
              If \Text[2]\Len
                If \Text[2]\Len = \Text\Len
                  DeleteElement(*This\Items(), 1)
                Else
                  RemoveText(*This)
                EndIf
              EndIf
            Next
            PopListPosition(*This\Items())
           
            *This\CaretPos = *This\CaretPos[1]
            ; Выделили снизу верх
          ElseIf *This\Pos[1] > *This\Pos
            *This\Pos[1] = *This\Pos
           
            *This\CaretPos[1] = *This\CaretPos  ; Выделили пос = 0 фикс = 1
           
            ;             Debug "  Cut_21_ForEach"
            ;               
            ;             PushListPosition(*This\Items())
            ;             ForEach *This\Items()
            ;               If \Text[2]\Len
            ;                 If \Text[2]\Len = \Text\Len
            ;                   DeleteElement(*This\Items(), 1)
            ;                 Else
            ;                   RemoveText(*This)
            ;                 EndIf
            ;               EndIf
            ;             Next
            ;             PopListPosition(*This\Items())
           
          EndIf
         
         
          If *This\Pos[1]>=0 And *This\Pos[1]<ListSize(*This\Items())
            ;If *This\Pos > *This\Pos[1]
            String.s = \Text\String.s
            DeleteElement(*This\Items(), 1)
            ;EndIf
            SelectElement(*This\Items(), *This\Pos[1])
           
            If Not *This\CaretPos
              *This\CaretPos = \Text\Len-Len(#LF$)
            EndIf
           
            ; Выделили сверху вниз
            If *This\Pos > *This\Pos[1]
              *This\Pos = *This\Pos[1]
              *This\CaretPos = *This\CaretPos[1] ; Выделили пос = 0 фикс = 0
              \Text\String.s = String.s + \Text\String.s
            Else
              ;;*This\CaretPos[1] = *This\CaretPos  ; Выделили пос = 0 фикс = 1
              \Text\String.s = \Text\String.s + String.s
            EndIf
           
            \Text\Len = Len(\Text\String.s)
          EndIf
         
          PushListPosition(*This\Items())
          ForEach *This\Items()
            If \Text[2]\Len
              Debug "  Cut_2_ForEach"
              If \Text[2]\Len = \Text\Len
                DeleteElement(*This\Items(), 1)
              Else
                RemoveText(*This)
              EndIf
            EndIf
          Next
          PopListPosition(*This\Items())
         
        EndIf
        ;EndIf 
      EndIf
    EndWith
  EndProcedure
 
  Procedure.s Copy(*This.Gadget)
    Protected String.s
   
    With *This
      PushListPosition(\Items())
      ForEach \Items()
        If \Items()\Text[2]\Len
          String.s+\Items()\Text[2]\String.s+#LF$
        EndIf
      Next
      PopListPosition(\Items())
     
      String.s = Trim(String.s, #LF$)
      ; Для совместимости с виндовсовским
      If String.s And Not \CaretPos
        String.s+#LF$+#CR$
      EndIf
    EndWith
   
    ProcedureReturn String.s
  EndProcedure
 
  Procedure.b Back(*This.Gadget)
    Protected Repaint.b, String.s
   
    With *This\Items()
      If ListSize(*This\Items()) And (*This\CaretPos = 0 And *This\CaretPos = *This\CaretPos[1]) And ListIndex(*This\Items()) 
        Debug "Back"
       
        If Not \Text[2]\Len
          If *This\Pos[1] > *This\Pos : *This\Pos[1] = *This\Pos : Else : *This\Pos[1] - 1 : EndIf
          If (*This\Pos[1]>=0 And *This\Pos[1]<ListSize(*This\Items()))
            String.s = \Text\String.s
            DeleteElement(*This\Items(), 1)
            SelectElement(*This\Items(), *This\Pos[1])
           
            If *This\CaretPos = *This\CaretPos[1]
              *This\CaretPos = \Text\Len-Len(#LF$)
            EndIf
            If *This\Pos > *This\Pos[1]
              *This\CaretPos[1] = *This\CaretPos
            EndIf
           
            \Text\String.s + String.s
            \Text\Len = Len(\Text\String.s)
          EndIf
        EndIf
       
        ForEach *This\Items()
          If \Text[2]\Len
            If \Text[2]\Len = \Text\Len
              DeleteElement(*This\Items(), 1)
            Else
              RemoveText(*This)
            EndIf
          EndIf
        Next
       
        SelectElement(*This\Items(), *This\Pos[1])
       
        *This\Pos = *This\Pos[1]
        Repaint = #True
      EndIf
    EndWith
   
    ProcedureReturn Repaint
  EndProcedure
 
  Procedure SelectionLimits(*This.Gadget)
    Protected i, char
   
    With *This\Items()
      If \Text\Pass
        *This\CaretPos = \Text\Len
        \Text[2]\Len = *This\CaretPos
        *This\CaretPos[1] = 0
      Else
        char = Asc(Mid(\Text\String.s, *This\CaretPos + 1, 1))
       
        If (char > =  ' ' And char < =  '/') Or
           (char > =  ':' And char < =  '@') Or
           (char > =  '[' And char < =  96) Or
           (char > =  '{' And char < =  '~')
         
          *This\CaretPos[1] = *This\CaretPos : *This\CaretPos + 1
          \Text[2]\Len = *This\CaretPos[1] - *This\CaretPos
        Else
          For i = *This\CaretPos To 0 Step - 1
            char = Asc(Mid(\Text\String.s, i, 1))
            If (char > =  ' ' And char < =  '/') Or
               (char > =  ':' And char < =  '@') Or
               (char > =  '[' And char < =  96) Or
               (char > =  '{' And char < =  '~')
              Break
            EndIf
          Next
         
          If i =- 1 : *This\CaretPos[1] = 0 : Else : *This\CaretPos[1] = i : EndIf
         
          For i = *This\CaretPos + 1 To \Text\Len
            char = Asc(Mid(\Text\String.s, i, 1))
            If (char > =  ' ' And char < =  '/') Or
               (char > =  ':' And char < =  '@') Or
               (char > =  '[' And char < =  96) Or
               (char > =  '{' And char < =  '~')
              Break
            EndIf
          Next
         
          *This\CaretPos = i - 1
          \Text[2]\Len = *This\CaretPos[1] - *This\CaretPos
          If \Text[2]\Len < 0 : \Text[2]\Len = 0 : EndIf
        EndIf
      EndIf
    EndWith           
  EndProcedure
 
  Procedure EditableCallBack(*This.Gadget, EventType.l)
    Static Text$, DoubleClickCaretPos =- 1
    Protected Repaint.b, String.s, StartDrawing, Update_Text_Selected
   
   
    If *This
      With *This\Items()
        If Not *This\Disable
          Protected Item = (*This\Canvas\Mouse\Y-*This\Scroll\Y)/*This\Text\Height
         
          If EventType = #PB_EventType_LeftButtonDown
            *This\Pos[1] = Item : *This\Pos = *This\Pos[1]
           
            PushListPosition(*This\Items())
            ForEach *This\Items() : \Text[2]\Len = 0 : Next
            PopListPosition(*This\Items())
          EndIf
         
          If EventType = #PB_EventType_MouseMove
            If *This\Canvas\Mouse\Buttons
              If *This\Pos>=0 And *This\Pos < ListSize(*This\Items())
                SelectElement(*This\Items(), *This\Pos)
               
                If *This\Pos[1]>Item
                  *This\CaretPos = 0
                Else
                  *This\CaretPos = \Text\Len
                EndIf
               
                SelectionText(*This)
              EndIf
             
              *This\Pos = Item
              If *This\Pos>=0 And *This\Pos < ListSize(*This\Items())
                SelectElement(*This\Items(), *This\Pos)
              EndIf
            EndIf
          Else
            If *This\Pos[1]>=0 And *This\Pos[1] < ListSize(*This\Items())
              SelectElement(*This\Items(), *This\Pos[1])
            EndIf
          EndIf
         
         
          Select EventType
            Case #PB_EventType_MouseEnter
              SetGadgetAttribute(*This\Canvas\Gadget, #PB_Canvas_Cursor, #PB_Cursor_IBeam)
             
            Case #PB_EventType_LostFocus : Repaint = #True
              If Not Bool(*This\Type = #PB_GadgetType_Editor)
                ; StringGadget
                \Text[2]\Len = 0 ; Убыраем выделение
              EndIf
              *This\CaretPos[1] =- 1 ; Прячем коректор
             
            Case #PB_EventType_Focus : Repaint = #True
              *This\CaretPos[1] = *This\CaretPos ; Показываем коректор
             
            Case #PB_EventType_Input
              If *This\Text\Editable
                Protected Input, Input_2
               
                Select #True
                  Case \Text\Lower : Input = Asc(LCase(Chr(*This\Canvas\Input))) : Input_2 = Input
                  Case \Text\Upper : Input = Asc(UCase(Chr(*This\Canvas\Input))) : Input_2 = Input
                  Case \Text\Pass  : Input = 9679 : Input_2 = *This\Canvas\Input ; "●"
                  Case \Text\Numeric
                    ;                     Debug *This\Canvas\Input
                    Static Dot
                   
                    Select *This\Canvas\Input
                      Case '.','0' To '9' : Input = *This\Canvas\Input : Input_2 = Input
                      Case 'Ю','ю','Б','б',44,47,60,62,63 : Input = '.' : Input_2 = Input
                      Default
                        Input_2 = *This\Canvas\Input
                    EndSelect
                   
                    If Not Dot And Input = '.'
                      Dot = 1
                    ElseIf Input <> '.'
                      Dot = 0
                    Else
                      Input = 0
                    EndIf
                   
                  Default
                    Input = *This\Canvas\Input : Input_2 = Input
                EndSelect
               
                If Input_2
                  If Input
                    If \Text[2]\String.s
                      RemoveText(*This)
                    EndIf
                    *This\CaretPos + 1
                    *This\CaretPos[1] = *This\CaretPos
                  EndIf
                 
                  If \Text\Numeric And Input = Input_2
                    \Text\String.s[1] = \Text\String.s
                  EndIf
                 
                  ;\Text\String.s = Left(\Text\String.s, *This\CaretPos-1) + Chr(Input) + Mid(\Text\String.s, *This\CaretPos)
                  \Text\String.s = InsertString(\Text\String.s, Chr(Input), *This\CaretPos)
                  \Text\String.s[1] = InsertString(\Text\String.s[1], Chr(Input_2), *This\CaretPos)
                 
                  If Input
                    \Text\Len = Len(\Text\String.s)
                    PostEvent(#PB_Event_Gadget, EventWindow(), EventGadget(), #PB_EventType_Change)
                  EndIf
                 
                  Repaint = #True
                EndIf
              EndIf
             
            Case #PB_EventType_KeyUp
              If \Text\Numeric
                \Text\String.s[1]=\Text\String.s
              EndIf
              Repaint = #True
             
            Case #PB_EventType_KeyDown
              Select *This\Canvas\Key
                Case #PB_Shortcut_Home : \Text[2]\String.s = "" : \Text[2]\Len = 0 : *This\CaretPos = 0 : *This\CaretPos[1] = *This\CaretPos : Repaint = #True
                Case #PB_Shortcut_End : \Text[2]\String.s = "" : \Text[2]\Len = 0 : *This\CaretPos = \Text\Len : *This\CaretPos[1] = *This\CaretPos : Repaint = #True
                 
                Case #PB_Shortcut_Left : \Text[2]\String.s = ""
                  If *This\CaretPos > 0 Or ListIndex(*This\Items()) : *This\CaretPos - 1
                   
                    ; Если дошли до начала строки то переходим в конец предыдущего итема
                    If *This\CaretPos =- 1 And *This\Pos[1] : *This\Pos[1]-1
                      SelectElement(*This\Items(), *This\Pos[1])
                      *This\CaretPos = \Text\Len-Len(#LF$)
                    EndIf
                   
                    If *This\CaretPos[1] <> *This\CaretPos
                      If \Text[2]\Len
                        If *This\CaretPos > *This\CaretPos[1]
                          *This\CaretPos = *This\CaretPos[1]
                          *This\CaretPos[1] = *This\CaretPos
                        Else
                          *This\CaretPos[1] = *This\CaretPos + 1
                          *This\CaretPos = *This\CaretPos[1]
                        EndIf
                        \Text[2]\Len = 0
                      Else
                        *This\CaretPos[1] = *This\CaretPos
                      EndIf
                    EndIf
                   
                    Repaint = #True
                  EndIf
                 
                Case #PB_Shortcut_Right : \Text[2]\String.s = ""
                  If *This\CaretPos[1] < \Text\Len : *This\CaretPos[1] + 1
                   
                    ; Если дошли в конец строки то переходим на начало следующего итема
                    If *This\CaretPos[1] = \Text\Len And *This\Pos[1] < ListSize(*This\Items()) - 1 : *This\Pos[1] + 1
                      SelectElement(*This\Items(), *This\Pos[1]) : *This\CaretPos[1] = 0
                    EndIf
                   
                    If *This\CaretPos <> *This\CaretPos[1]
                      If \Text[2]\Len
                        If *This\CaretPos > *This\CaretPos[1]
                          *This\CaretPos = *This\CaretPos[1]+\Text[2]\Len - 1
                          *This\CaretPos[1] = *This\CaretPos
                        Else
                          *This\CaretPos = *This\CaretPos[1] - 1
                          *This\CaretPos[1] = *This\CaretPos
                        EndIf
                        \Text[2]\Len = 0
                      Else
                        *This\CaretPos = *This\CaretPos[1]
                      EndIf
                    EndIf
                   
                    Repaint = #True
                  EndIf
                 
                Case #PB_Shortcut_Up : \Text[2]\String.s = ""
                  If *This\Pos[1] : *This\Pos[1]-1
                    SelectElement(*This\Items(), *This\Pos[1])
                    Repaint = #True
                  EndIf
                 
                Case #PB_Shortcut_Down : \Text[2]\String.s = ""
                  If *This\Pos[1] < ListSize(*This\Items()) - 1 : *This\Pos[1] + 1
                    SelectElement(*This\Items(), *This\Pos[1])
                    Repaint = #True
                  EndIf
                 
                Case #PB_Shortcut_Return
                  Debug "Return "+ListIndex(*This\Items())
                  If *This\CaretPos ;: *This\Pos[1]+1
                    *This\CaretPos[1] = \Text\Len
                    SelectionText(*This)
                    String.s = \Text[2]\String.s
                  EndIf
                 
                  If String.s
                    RemoveText(*This)
                  Else
                    String.s = ""
                  EndIf
                  Debug String
                 
                  *This\Pos[1] = AddItem(*This\Canvas\Gadget, *This\Pos[1]+1, String.s+#LF$)
                  *This\CaretPos = 0
                  *This\Text\Len = Len(\Text\String.s)
                  *This\CaretPos[1] = *This\CaretPos
                 
                  ;                   If Not *This\CaretPos
                  ;                     SelectElement(*This\Items(), *This\Pos[1])
                  ;                   ; *This\Pos[1] + 1 
                  ;                   EndIf
                 
                  Scroll::SetState(*This\scroll\v, *This\scroll\v\Max)
                  Repaint = #True
                 
                Case #PB_Shortcut_Back
                  Repaint = Back(*This)
                  If Not Repaint
                    Cut(*This)
                   
                    *This\CaretPos[1] = *This\CaretPos
                    \Text\Len = Len(\Text\String.s)
                   
                    Repaint = #True
                  EndIf
                 
                Case #PB_Shortcut_Delete
                  If *This\CaretPos < \Text\Len
                    If \Text[2]\String.s
                      RemoveText(*This)
                    Else
                      \Text[2]\String.s[1] = Mid(\Text\String.s, (*This\CaretPos+1), 1)
                      \Text\String.s = Left(\Text\String.s, *This\CaretPos) + Right(\Text\String.s, \Text\Len-(*This\CaretPos+1))
                      \Text\String.s[1] = Left(\Text\String.s[1], *This\CaretPos) + Right(\Text\String.s[1], Len(\Text\String.s[1])-(*This\CaretPos+1))
                    EndIf
                   
                    If ListSize(*This\Items())
                      PushListPosition(*This\Items())
                      ForEach *This\Items()
                        If \Text[2]\Len = \Text\Len
                          DeleteElement(*This\Items(), 1)
                        EndIf
                      Next
                      PopListPosition(*This\Items())
                     
                      If *This\CaretPos = Len(\Text\String.s) : *This\Pos[1]+1
                        If *This\Pos[1]>=0 And *This\Pos[1]<ListSize(*This\Items())
                          PushListPosition(*This\Items())
                          SelectElement(*This\Items(), *This\Pos[1])
                          String.s = \Text\String.s
                          DeleteElement(*This\Items(), 1)
                          PopListPosition(*This\Items())
                          \Text\String.s + String.s
                          *This\Pos[1] - 1
                        EndIf
                      EndIf
                    EndIf
                   
                    *This\CaretPos[1] = *This\CaretPos
                    \Text\Len = Len(\Text\String.s)
                   
                    Repaint = #True
                  EndIf
                 
                 
                Case #PB_Shortcut_X
                  If (*This\Canvas\Key[1] & #PB_Canvas_Control)
                    SetClipboardText(Copy(*This))
                   
                    Cut(*This)
                   
                    *This\CaretPos[1] = *This\CaretPos
                    Repaint = #True
                  EndIf
                 
                Case #PB_Shortcut_C ; Ok
                  If (*This\Canvas\Key[1] & #PB_Canvas_Control)
                    SetClipboardText(Copy(*This))
                  EndIf
                 
                Case #PB_Shortcut_V
                  If *This\Text\Editable And (*This\Canvas\Key[1] & #PB_Canvas_Control)
                    Protected CaretPos, ClipboardText.s = Trim(GetClipboardText(), #CR$)
                   
                    If ClipboardText.s
                      If \Text[2]\Len
                        RemoveText(*This)
                       
                        If \Text[2]\Len = \Text\Len
                          ;*This\Pos[1] = *This\Pos
                          ClipboardText.s = Trim(ClipboardText.s, #LF$)
                        EndIf
                        ;                         
                        PushListPosition(*This\Items())
                        ForEach *This\Items()
                          If \Text[2]\Len
                            If \Text[2]\Len = \Text\Len
                              DeleteElement(*This\Items(), 1)
                            Else
                              RemoveText(*This)
                            EndIf
                          EndIf
                        Next
                        PopListPosition(*This\Items())
                      EndIf
                     
                      Select #True
                        Case \Text\Lower : ClipboardText.s = LCase(ClipboardText.s)
                        Case \Text\Upper : ClipboardText.s = UCase(ClipboardText.s)
                        Case \Text\Numeric
                          If Val(ClipboardText.s)
                            ClipboardText.s = Str(Val(ClipboardText.s))
                          EndIf
                      EndSelect
                     
                      \Text\String.s = InsertString( \Text\String.s, ClipboardText.s, *This\CaretPos + 1)
                     
                      If CountString(\Text\String.s, #LF$)
                        CaretPos = \Text\Len-*This\CaretPos
                        String.s = \Text\String.s
                        DeleteElement(*This\Items(), 1)
                        SetText(*This\Canvas\Gadget, String.s, *This\Pos[1])
                        *This\CaretPos = Len(\Text\String.s)-CaretPos
                        ;                         SelectElement(*This\Items(), *This\Pos)
                        ;                        *This\CaretPos = 0
                      Else
                        *This\CaretPos + Len(ClipboardText.s)
                      EndIf
                     
                      *This\CaretPos[1] = *This\CaretPos
                      \Text\Len = Len(\Text\String.s)
                     
                      Repaint = #True
                    EndIf
                  EndIf
                 
              EndSelect
             
            Case #PB_EventType_LeftDoubleClick
              DoubleClickCaretPos = *This\CaretPos
              SelectionLimits(*This)
              SelectionText(*This)
              Repaint = #True
             
            Case #PB_EventType_LeftButtonDown
              If \Text\Numeric : \Text\String.s[1] = \Text\String.s : EndIf
              *This\CaretPos = CaretPos(*This) : *This\CaretPos[1] = *This\CaretPos
             
              If *This\CaretPos = DoubleClickCaretPos
                DoubleClickCaretPos =- 1
                *This\CaretPos[1] = \Text\Len
                *This\CaretPos = 0
              EndIf
             
              SelectionText(*This)
              Repaint = #True
             
            Case #PB_EventType_MouseMove
              If *This\Canvas\Mouse\Buttons & #PB_Canvas_LeftButton
                *This\CaretPos = CaretPos(*This)
                SelectionText(*This)
                Repaint = #True
              EndIf
             
          EndSelect
         
        EndIf
       
        ;         If Repaint
        ;          ; *This\CaretLength = \CaretLength
        ;           *This\Text[2]\String.s[1] = \Text[2]\String.s[1]
        ;         EndIf
      EndWith
    EndIf
   
    ProcedureReturn Repaint
  EndProcedure
 
  Procedure Re(*This.Gadget)
    With *This
      If Not *This\Repaint : *This\Repaint = #True : EndIf
    EndWith   
  EndProcedure
 
  Procedure Draw(*This.Gadget)
    Protected Left, Right, r=1
   
    If *This\Repaint And StartDrawing(CanvasOutput(*This\Canvas\Gadget))
      If *This\FontID : DrawingFont(*This\FontID) : EndIf
      Box(*This\X[1],*This\Y[1],*This\Width[1],*This\Height[1],*This\Color[0])
     
     
      If *This\fSize
        DrawingMode(#PB_2DDrawing_Outlined)
        ;             If \Active
        ;               Box(*This\X[1],*This\Y[1],*This\Width[1],*This\Height[1],$FF8E00)
        ;             Else
        Box(*This\X[1],*This\Y[1],*This\Width[1],*This\Height[1],*This\Color[1])
        ;             EndIf
      EndIf
     
     
     
      *This\Text\Height = TextHeight("A")
     
      *This\Scroll\Height = *This\Text\Y
      ;       *This\Scroll\X =- *This\scroll\h\Page\Pos
      *This\Scroll\Y =- *This\scroll\v\Page\Pos
     
      If ListSize(*This\Items())
        *This\CaretLength = TextWidth(Left(*This\Items()\Text\String.s, *This\CaretPos))
      EndIf
     
     
      With *This\Items()
        PushListPosition(*This\Items())
       
        ForEach *This\Items()
          \Text\Height = TextHeight("A")
          \Text\Width = TextWidth(\Text\String.s)
          \Text[1]\Width = TextWidth(\Text[1]\String.s)
          \Text[2]\Width = TextWidth(\Text[2]\String.s)
          \Text[3]\Width = TextWidth(\Text[3]\String.s)
         
          ; Перемещаем корректор
          Select *This\Text\XAlign
            Case 9 : *This\Scroll\X = (*This\Width-*This\Items()\Text\Width)/2
              If *This\Scroll\X<*This\fSize*2 + r : *This\Scroll\X=*This\fSize*2 + r : EndIf
              If *This\CaretPos[1] =- 1
                *This\CaretLength =- *This\Scroll\X + *This\fSize*2 + r
                *This\CaretPos = *This\CaretLength
              EndIf
            Case 2 : *This\Scroll\X = (*This\Width-\Text\Width-*This\fSize*2) - r
          EndSelect
          Select *This\Text\YAlign
            Case 9 : *This\Scroll\Y = (*This\Height-*This\Text\Height)/2
            Case 2 : *This\Scroll\Y = (*This\Height-*This\Text\Height)
          EndSelect
         
          If *This\Text\Editable
            If \Text[2]\String.s[1] And *This\Scroll\X < 0
              *This\Scroll\X + TextWidth(\Text[2]\String.s[1])
              \Text[2]\String.s[1] = ""
            EndIf
           
            Left =- (*This\CaretLength-*This\fSize*2) + r
            Right = (*This\Width-*This\CaretLength-*This\fSize*2) - r
           
            If *This\Scroll\X < Left
              *This\Scroll\X = Left
            ElseIf *This\Scroll\X > Right
              *This\Scroll\X = Right
            EndIf
           
          EndIf
         
          \Text\Y = *This\Scroll\Height+*This\Scroll\Y
          \Text\X = *This\Scroll\X - *This\scroll\h\Page\Pos
         
         
          If *This\Scroll\Width<\Text\Width
            *This\Scroll\Width=\Text\Width
          EndIf
         
          *This\Scroll\Height + \Text\Height
        Next
        PopListPosition(*This\Items())
       
        ; Draw
        ClipOutput(0,0, Scroll::X(*This\scroll\v), Scroll::Y(*This\scroll\h))
       
        PushListPosition(*This\Items())
        ForEach *This\Items()
          If \Text\String.s
            If \Text[2]\Len
              If \Text[1]\String.s
                DrawingMode(#PB_2DDrawing_Transparent)
                DrawText(\Text\X, \Text\Y, \Text[1]\String.s, $0B0B0B)
              EndIf
             
              If \Text[2]\String.s
                DrawingMode(#PB_2DDrawing_Default)
                \Text[2]\X = \Text\X+\Text[1]\Width
                \Text[3]\X = \Text[2]\X+\Text[2]\Width
                DrawText(\Text[2]\X, \Text\Y, \Text[2]\String.s, $FFFFFF, $D77800)
              EndIf
             
              If \Text[3]\String.s
                DrawingMode(#PB_2DDrawing_Transparent)
                DrawText(\Text[3]\X, \Text\Y, \Text[3]\String.s, $0B0B0B)
              EndIf
            Else
              DrawingMode(#PB_2DDrawing_Transparent)
              DrawText(\Text\X, \Text\Y, \Text\String.s, $0B0B0B)
            EndIf
          EndIf
        Next
        PopListPosition(*This\Items())
       
        If ListSize(*This\Items()) And *This\CaretPos=*This\CaretPos[1] ; And Property_GadgetTimer( 300 )
          DrawingMode(#PB_2DDrawing_XOr) 
          Line(*This\Items()\Text\X + *This\CaretLength - Bool(*This\Scroll\X = Right), *This\Items()\Text\y, 1, *This\Text\Height, $FFFFFF)
        EndIf
       
      EndWith 
     
     
      If *This\scroll\v\Page\len And *This\scroll\v\Max<>*This\Scroll\Height
        If Scroll::SetAttribute(*This\scroll\v, #PB_ScrollBar_Maximum, *This\Scroll\Height)
          Scroll::Resizes(*This\Scroll, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore)
        EndIf
      EndIf
      If *This\scroll\h\Page\len And *This\scroll\h\Max<>*This\Scroll\Width
        If Scroll::SetAttribute(*This\scroll\h, #PB_ScrollBar_Maximum, *This\Scroll\Width)
          Scroll::Resizes(*This\Scroll, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore)
        EndIf
      EndIf
     
      UnclipOutput()
         
      Scroll::Draw(*This\scroll\v)
      Scroll::Draw(*This\scroll\h)
     
      *This\Repaint = #False
      StopDrawing()
    EndIf
  EndProcedure
 
  Procedure ReDraw(*This.Gadget)
    Re(*This)
    Draw(*This)
  EndProcedure
 
  Procedure CallBack()
    Static LastX, LastY
    Protected *This.Gadget = GetGadgetData(EventGadget())
   
    With *This
      \Canvas\Window = EventWindow()
      \Canvas\Input = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_Input)
      \Canvas\Key = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_Key)
      \Canvas\Key[1] = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_Modifiers)
      \Canvas\Mouse\X = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_MouseX)
      \Canvas\Mouse\Y = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_MouseY)
      \Canvas\Mouse\Buttons = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_Buttons)
      Protected iHeight = \Height-Scroll::Height(*This\scroll\h)
      Protected iWidth = \Width-Scroll::Width(*This\scroll\v)
     
      Select EventType()
        Case #PB_EventType_Resize : ResizeGadget(\Canvas\Gadget, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore) ; Bug (562)
          \Width = GadgetWidth(\Canvas\Gadget)
          \Height = GadgetHeight(\Canvas\Gadget)
         
          ; Inner coordinae
          \X[2]=\bSize
          \Y[2]=\bSize
          \Width[2] = \Width-\bSize*2
          \Height[2] = \Height-\bSize*2
         
          ; Frame coordinae
          \X[1]=\X[2]-\fSize
          \Y[1]=\Y[2]-\fSize
          \Width[1] = \Width[2]+\fSize*2
          \Height[1] = \Height[2]+\fSize*2
         
          Scroll::Resizes(*This\Scroll, *This\x[2]+1,*This\Y[2]+1,*This\Width[2]-2,*This\Height[2]-2)
          ReDraw(*This)
         
      EndSelect
     
      *This\Repaint = Scroll::CallBack(*This\scroll\v, EventType(), \Canvas\Mouse\X, \Canvas\Mouse\Y)
      If *This\Repaint
        ReDraw(*This)
        PostEvent(#PB_Event_Gadget, \Canvas\Window, \Canvas\Gadget, #PB_EventType_Change)
      EndIf
     
      *This\Repaint = Scroll::CallBack(*This\scroll\h, EventType(), \Canvas\Mouse\X, \Canvas\Mouse\Y)
      If *This\Repaint
        ReDraw(*This)
        PostEvent(#PB_Event_Gadget, \Canvas\Window, \Canvas\Gadget, #PB_EventType_Change)
      EndIf
     
      ;Debug *This\scroll\h\at
     
      If Not *This\scroll\v\from And Not *This\scroll\h\from
        ;Or (\Canvas\Mouse\X<*This\Width[2]-Scroll::Width(*This\scroll\v) And \Canvas\Mouse\Y<*This\Height[2]-Scroll::Height(*This\scroll\h))
        *This\Repaint = EditableCallBack(*This, EventType())
        If *This\Repaint
          ReDraw(*This)
        EndIf
      EndIf
     
    EndWith
   
    ; Draw(*This)
  EndProcedure
 
  ;- PUBLIC
  Procedure SetAttribute(Gadget.l, Attribute.l, Value.l)
    Protected *This.Gadget = GetGadgetData(Gadget)
   
    With *This
     
    EndWith
  EndProcedure
 
  Procedure GetAttribute(Gadget.l, Attribute.l)
    Protected Result, *This.Gadget = GetGadgetData(Gadget)
   
    With *This
      ;       Select Attribute
      ;         Case #PB_ScrollBar_Minimum    : Result = \Scroll\Min
      ;         Case #PB_ScrollBar_Maximum    : Result = \Scroll\Max
      ;         Case #PB_ScrollBar_PageLength : Result = \Scroll\PageLength
      ;       EndSelect
    EndWith
   
    ProcedureReturn Result
  EndProcedure
 
  Procedure SetState(Gadget.l, State.l)
    Protected *This.Gadget = GetGadgetData(Gadget)
   
    With *This
     
    EndWith
  EndProcedure
 
  Procedure GetState(Gadget.l)
    Protected ScrollPos, *This.Gadget = GetGadgetData(Gadget)
   
    With *This
     
    EndWith
  EndProcedure
 
  Procedure.s GetText(Gadget.l)
    Protected ScrollPos, *This.Gadget = GetGadgetData(Gadget)
   
    With *This
      If \Text\Pass
        ProcedureReturn \Text\String.s[1]
      Else
        ProcedureReturn \Text\String
      EndIf
    EndWith
  EndProcedure
 
  Procedure AddItem(Gadget, Item,Text.s,Image.l=-1,Flag.l=0)
    Protected *This.Gadget = GetGadgetData(Gadget)
   
    With *This\Items()
      If Item = #PB_Any
        LastElement(*This\Items())
        AddElement(*This\Items())
      Else
        If (Item > (ListSize(*This\Items()) - 1))
          LastElement(*This\Items())
          AddElement(*This\Items())
        Else
          SelectElement(*This\Items(), Item)
          InsertElement(*This\Items())
        EndIf
      EndIf
     
      \Text\String.s = Text.s
     
      \Text\X = *This\Text\X
      \Text\Y = *This\Text\Y
     
      \Text\Editable = 1
      \Text\XAlign = *This\Text\XAlign
      \Text\YAlign = *This\Text\YAlign
     
      *This\CaretPos[1] =- 1
      \Text\Len = Len(\Text\String.s)
     
    EndWith
   
    *This\Repaint=1
   
    If *This\Scroll\Height<*This\Height
      Draw(*This)
      ; Scroll::SetState(*This\scroll\v, *This\scroll\v\Max)
    EndIf
   
    ProcedureReturn Item
  EndProcedure
 
  Procedure SetText(Gadget, Text.s, Item.l=0)
    Protected *This.Gadget = GetGadgetData(Gadget)
   
    With *This\Items()
      Protected i,c = CountString(Text.s, #LF$)
     
      For i=0 To c
        Debug "String len - "+Len(StringField(Text.s, i + 1, #LF$))
        AddItem( Gadget, Item+i, StringField(Text.s, i + 1, #LF$))
      Next
    EndWith
  EndProcedure
 
  Procedure SetFont(Gadget, FontID.i)
    Protected *This.Gadget = GetGadgetData(Gadget)
   
    With *This
      \FontID = FontID
      ReDraw(*This)
    EndWith
  EndProcedure
 
  Procedure Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
    Protected *This.Gadget=AllocateStructure(Gadget)
    Protected g = CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) : If Gadget=-1 : Gadget=g : EndIf
    Protected Min.l, Max.l, PageLength.l
   
     With *This
     If *This
        \Canvas\Gadget = Gadget
        \Type = #PB_GadgetType_Editor
        \FontID = GetGadgetFont(#PB_Default)
        ;\FontID = GetGadgetFont(Gadget)
       
        \fSize = Bool(Not Flag&#PB_String_BorderLess)
        \bSize = \fSize
       
        \Width = Width
        \Height = Height
       
        ; Inner coordinae
        \X[2]=\bSize
        \Y[2]=\bSize
        \Width[2] = \Width-\bSize*2
        \Height[2] = \Height-\bSize*2
       
        ; Frame coordinae
        \X[1]=\X[2]-\fSize
        \Y[1]=\Y[2]-\fSize
        \Width[1] = \Width[2]+\fSize*2
        \Height[1] = \Height[2]+\fSize*2
       
        \Color[1] = $C0C0C0
        \Color[2] = $F0F0F0
       
        ;\Scroll\ButtonLength = 7
        \Text\WordWrap = Bool(Flag&#PB_Editor_WordWrap)
        \Text\Editable = Bool(Not Flag&#PB_Editor_ReadOnly)
        If \Text\Editable
          \Color[0] = $FFFFFF
        Else
          \Color[0] = $F0F0F0
        EndIf
       
        \Text\X = 2
        \Text\y = \fSize
       
        \Text\YAlign = 0
        If Bool(Flag&#PB_Text_Right) : \Text\XAlign = 2 : EndIf
        If Bool(Flag&#PB_Text_Center) : \Text\XAlign = 9 : EndIf
       
       
       *This\scroll\v = Scroll::Gadget(#PB_Ignore, #PB_Ignore, 16, #PB_Ignore, 0,0,0, #PB_ScrollBar_Vertical, 8)
        *This\scroll\h = Scroll::Gadget(#PB_Ignore, #PB_Ignore, #PB_Ignore, 16, 0,0,0, 0, 8)
       
       
        ReDraw(*This)
        SetGadgetData(Gadget, *This)
       
        If Text.s
          SetText(Gadget, Text.s)
        EndIf
       
        PostEvent(#PB_Event_Gadget, GetActiveWindow(), Gadget, #PB_EventType_Resize)
        BindGadgetEvent(Gadget, @CallBack())
      EndIf
    EndWith
   
    ProcedureReturn Gadget
  EndProcedure
EndModule


;- EXAMPLE
CompilerIf #PB_Compiler_IsMainFile
 
  Define a,i
  Define g, Text.s
  ; Define m.s=#CRLF$
  Define m.s=#LF$
 
  Text.s = "This is a long line" + m.s +
           "Who should show," + m.s +
           "I have to write the text in the box or not." + m.s +
           "The string must be very long" + m.s +
           "Otherwise it will not work."
 
  Procedure ResizeCallBack()
    ResizeGadget(10, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow(), #PB_Window_InnerCoordinate)-16, WindowHeight(EventWindow(), #PB_Window_InnerCoordinate)-16)
  EndProcedure
 
  LoadFont(0, "Courier", 14)
  If OpenWindow(0, 0, 0, 522, 490, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
   
    EditorGadget(0, 8, 8, 306, 133) : SetGadgetText(0, Text.s)
    For a = 0 To 5
      AddGadgetItem(0, a, "Line "+Str(a))
    Next
    SetGadgetFont(0, FontID(0))
   
   
    g=16
    Editor::Gadget(g, 8, 133+5+8, 306, 133, "") : Editor::SetText(g, Text.s)
    For a = 0 To 5
      Editor::AddItem(g, a, "Line "+Str(a))
    Next
    Editor::SetFont(g, FontID(0))
   
    SplitterGadget(10,8, 8, 306, 276, 0,g)
    PostEvent(#PB_Event_SizeWindow, 0, #PB_Ignore) ; Bug
    BindEvent(#PB_Event_SizeWindow, @ResizeCallBack(), 0)
   
    Repeat
      Define Event = WaitWindowEvent()
     
      Select Event
        Case #PB_Event_LeftClick 
          SetActiveGadget(0)
        Case #PB_Event_RightClick
          SetActiveGadget(10)
      EndSelect
    Until Event = #PB_Event_CloseWindow
  EndIf
CompilerEndIf

Kwai chang caine · Post by **Kwai chang caine** » Sun May 06, 2018 8:03 pm

The text is a also hard to understand than your splendid code

Thanks for sharing

mestnyi · Post by **mestnyi** » Wed May 09, 2018 9:18 am

I would like to see here the capabilities of EditorGadget, and then to implement them on canvas.
That is, I somewhere saw that at the unit it is possible to put a font of words different color of words, etc.
I hope you understand what I mean.

#example-1

Code: Select all

;- EXAMPLE
XIncludeFile "module_editor.pbi"
CompilerIf #PB_Compiler_IsMainFile
  Structure CHARFORMAT2_ 
    cbSize.l 
    dwMask.l  
    dwEffects.l  
    yHeight.l  
    yOffset.l  
    crTextColor.l  
    bCharSet.b  
    bPitchAndFamily.b  
    szFaceName.b[#LF_FACESIZE]  
    _wPad2.w  
    wWeight.w  
    sSpacing.w  
    crBackColor.l  
    lcid.l  
    dwReserved.l  
    sStyle.w  
    wKerning.w  
    bUnderlineType.b  
    bAnimation.b  
    bRevAuthor.b  
    bReserved1.b 
  EndStructure 
  
  Procedure EditorBackColor(Gadget, Color.l) 
    Protected format.CHARFORMAT2_ 
    format\cbSize = SizeOf(CHARFORMAT2_) 
    format\dwMask = $4000000  ; = #CFM_BACKCOLOR 
    format\crBackColor = Color 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure
  
  Procedure EditorSelect(Gadget, LineStart.l, LineEnd.l, CharStart.l, CharEnd.l)    
    Protected sel.CHARRANGE 
    sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1 
    
    If LineEnd = -1 
      LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1 
    EndIf 
    sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0) 
    
    If CharEnd = -1 
      sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0) 
    Else 
      sel\cpMax + CharEnd - 1 
    EndIf 
    SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel) 
  EndProcedure 
  
  ; Set the Text color for the Selection 
  ; in RGB format 
  Procedure EditorColor(Gadget, Color.l) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_COLOR 
    format\crTextColor = Color 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  ; Set Font Size for the Selection 
  ; in pt 
  Procedure EditorFontSize(Gadget, Fontsize.l) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_SIZE 
    format\yHeight = FontSize*20 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  ; Set Font for the Selection 
  ; You must specify a font name, the font doesn't need 
  ; to be loaded 
  Procedure EditorFont(Gadget, FontName.s) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_FACE 
    PokeS(@format\szFaceName, FontName) 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  ; Set Format of the Selection. This can be a combination of 
  ; the following values: 
  ; #CFM_BOLD 
  ; #CFM_ITALIC 
  ; #CFM_UNDERLINE 
  ; #CFM_STRIKEOUT 
  Procedure EditorFormat(Gadget, Flags.l) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE 
    format\dwEffects = Flags 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  Procedure EditorLocate(Gadget, Line, Pos, length, Color)
    ; Gadget - id EditorGadget
    ; Line - line number (номер строки)
    ; Pos - the position of the first character from the beginning of the line (позиция первого символа от начала строки)
    ; length - number of characters (selection length) (число символов (длина выделения))
    ; Color - color of letters (цвет букв)
    
    
    Protected REG = GadgetID(Gadget) 
    Protected CharIdx = SendMessage_(REG,#EM_LINEINDEX,Line-1,0) 
    Protected LLength = SendMessage_(REG,#EM_LINELENGTH,CharIdx,0) 
    
    If LLength >= Pos-1 
      CharIdx + Pos-1 
    EndIf 
    
    Protected Range.CHARRANGE 
    Range\cpMin = CharIdx 
    Range\cpMax = CharIdx+length
    SendMessage_(REG,#EM_EXSETSEL,0,Range)
    
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_COLOR 
    format\crTextColor = Color 
    SendMessage_(REG, #EM_SETCHARFORMAT, #SCF_SELECTION, format)
    
    SendMessage_(REG,#EM_SETSEL,0,0)
  EndProcedure 
  
  Define a,i
  Define g, Text.s, m.s=#CRLF$
  
  Text.s = "This is a long line" + m.s +
           "Who should show," + m.s +
           "I have to write the text in the box or not." + m.s +
           "The string must be very long" + m.s +
           "Otherwise it will not work."
  
  Procedure ResizeCallBack()
    ResizeGadget(10, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow(), #PB_Window_InnerCoordinate)-16, WindowHeight(EventWindow(), #PB_Window_InnerCoordinate)-16)
  EndProcedure
  
  LoadFont(0, "Courier", 20)
  If OpenWindow(0, 0, 0, 522, 490, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
    
    EditorGadget(0, 8, 8, 306, 133, #PB_Text_Center) : SetGadgetText(0, Text.s) 
    For a = 0 To 5
      AddGadgetItem(0, a, "Line "+Str(a))
    Next
    SetGadgetFont(0, FontID(0))
    
    EditorSelect(0, 0, 0, 1, -1)  ; select line 1 
    EditorColor(0, RGB(0,0,255)) 
    EditorFontSize(0, 18) 
    EditorFormat(0, #CFM_UNDERLINE) 
    
    EditorSelect(0, 1, 1, 1, -1)  ; select line 2 
    EditorColor(0, RGB(255,0,0)) 
    EditorFont(0, "Times New Roman") 
    EditorFormat(0, #CFM_ITALIC|#CFM_STRIKEOUT) 
    
    EditorSelect(0, 2, 2, 0, -1)  ; select line 2 
    EditorBackColor(0, RGB(255,200,100)) 
    
    Define pos,i,c = CountGadgetItems(0)
    
    For i=1 To c
      pos = FindString(StringField(GetGadgetText(0), i, #LF$), "should")
      If pos
        Break
      EndIf
    Next
    
    EditorLocate(0, i, Pos, Len("should"), $774AFC)
    
    
    g=16
    Editor::Gadget(g, 8, 133+5+8, 306, 133, "", #PB_Text_Center) : Editor::SetText(g, Text.s) 
    For a = 0 To 5
      Editor::AddItem(g, a, "Line "+Str(a))
    Next
    Editor::SetFont(g, FontID(0))
    
    SplitterGadget(10,8, 8, 306, 276, 0,g)
    PostEvent(#PB_Event_SizeWindow, 0, #PB_Ignore) ; Bug
    BindEvent(#PB_Event_SizeWindow, @ResizeCallBack(), 0)
    
    Repeat 
      Define Event = WaitWindowEvent()
      
      Select Event
        Case #PB_Event_LeftClick  
          SetActiveGadget(0)
        Case #PB_Event_RightClick 
          SetActiveGadget(10)
      EndSelect
    Until Event = #PB_Event_CloseWindow
  EndIf
CompilerEndIf

#example-2

Code: Select all

;- EXAMPLE
XIncludeFile "module_editor.pbi"
CompilerIf #PB_Compiler_IsMainFile
  Structure CHARFORMAT2_ 
    cbSize.l 
    dwMask.l  
    dwEffects.l  
    yHeight.l  
    yOffset.l  
    crTextColor.l  
    bCharSet.b  
    bPitchAndFamily.b  
    szFaceName.b[#LF_FACESIZE]  
    _wPad2.w  
    wWeight.w  
    sSpacing.w  
    crBackColor.l  
    lcid.l  
    dwReserved.l  
    sStyle.w  
    wKerning.w  
    bUnderlineType.b  
    bAnimation.b  
    bRevAuthor.b  
    bReserved1.b 
  EndStructure 
  
  Procedure EditorBackColor(Gadget, Color.l) 
    Protected format.CHARFORMAT2_ 
    format\cbSize = SizeOf(CHARFORMAT2_) 
    format\dwMask = $4000000  ; = #CFM_BACKCOLOR 
    format\crBackColor = Color 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure
  
  Procedure EditorSelect(Gadget, LineStart.l, LineEnd.l, CharStart.l, CharEnd.l)    
    Protected sel.CHARRANGE 
    sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1 
    
    If LineEnd = -1 
      LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1 
    EndIf 
    sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0) 
    
    If CharEnd = -1 
      sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0) 
    Else 
      sel\cpMax + CharEnd - 1 
    EndIf 
    SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel) 
  EndProcedure 
  
  ; Set the Text color for the Selection 
  ; in RGB format 
  Procedure EditorColor(Gadget, Color.l) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_COLOR 
    format\crTextColor = Color 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  ; Set Font Size for the Selection 
  ; in pt 
  Procedure EditorFontSize(Gadget, Fontsize.l) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_SIZE 
    format\yHeight = FontSize*20 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  ; Set Font for the Selection 
  ; You must specify a font name, the font doesn't need 
  ; to be loaded 
  Procedure EditorFont(Gadget, FontName.s) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_FACE 
    PokeS(@format\szFaceName, FontName) 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  ; Set Format of the Selection. This can be a combination of 
  ; the following values: 
  ; #CFM_BOLD 
  ; #CFM_ITALIC 
  ; #CFM_UNDERLINE 
  ; #CFM_STRIKEOUT 
  Procedure EditorFormat(Gadget, Flags.l) 
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE 
    format\dwEffects = Flags 
    SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
  EndProcedure 
  
  Procedure EditorLocate(Gadget, Line, Pos, length, Color)
    ; Gadget - id EditorGadget
    ; Line - line number (номер строки)
    ; Pos - the position of the first character from the beginning of the line (позиция первого символа от начала строки)
    ; length - number of characters (selection length) (число символов (длина выделения))
    ; Color - color of letters (цвет букв)
    
    
    Protected REG = GadgetID(Gadget) 
    Protected CharIdx = SendMessage_(REG,#EM_LINEINDEX,Line-1,0) 
    Protected LLength = SendMessage_(REG,#EM_LINELENGTH,CharIdx,0) 
    
    If LLength >= Pos-1 
      CharIdx + Pos-1 
    EndIf 
    
    Protected Range.CHARRANGE 
    Range\cpMin = CharIdx 
    Range\cpMax = CharIdx+length
    SendMessage_(REG,#EM_EXSETSEL,0,Range)
    
    Protected format.CHARFORMAT 
    format\cbSize = SizeOf(CHARFORMAT) 
    format\dwMask = #CFM_COLOR 
    format\crTextColor = Color 
    SendMessage_(REG, #EM_SETCHARFORMAT, #SCF_SELECTION, format)
    
    SendMessage_(REG,#EM_SETSEL,0,0)
  EndProcedure 
  
  Define a,i
  Define g, Text.s, m.s=#CRLF$
  
  Text.s = "This is a long line" + m.s +
           "Who should show," + m.s +
           "I have to write the text in the box or not." + m.s +
           "The string must be very long" + m.s +
           "Otherwise it will not work."
  
  Procedure ResizeCallBack()
    ResizeGadget(10, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow(), #PB_Window_InnerCoordinate)-16, WindowHeight(EventWindow(), #PB_Window_InnerCoordinate)-16)
  EndProcedure
  
  LoadFont(0, "Courier", 20)
  If OpenWindow(0, 0, 0, 522, 490, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
    
    EditorGadget(0, 8, 8, 306, 133, #PB_Text_Center) : SetGadgetText(0, Text.s) 
    For a = 0 To 5
      AddGadgetItem(0, a, "Line "+Str(a))
    Next
    SetGadgetFont(0, FontID(0))
    
    EditorSelect(0, 0, 0, 1, -1)  ; select line 1 
    EditorColor(0, RGB(0,0,255)) 
    EditorFontSize(0, 18) 
    EditorFormat(0, #CFM_UNDERLINE) 
    
    EditorSelect(0, 1, 1, 1, -1)  ; select line 2 
    EditorColor(0, RGB(255,0,0)) 
    EditorFont(0, "Times New Roman") 
    EditorFormat(0, #CFM_ITALIC|#CFM_STRIKEOUT) 
    
    EditorSelect(0, 2, 2, 0, -1)  ; select line 2 
    EditorBackColor(0, RGB(255,200,100)) 
    
    Define pos,i,c = CountGadgetItems(0)
    
    For i=1 To c
      pos = FindString(StringField(GetGadgetText(0), i, #LF$), "should")
      If pos
        Break
      EndIf
    Next
    
    EditorLocate(0, i, Pos, Len("should"), $774AFC)
    
    
    g=16
    Editor::Gadget(g, 8, 133+5+8, 306, 133, "", #PB_Text_Center) : Editor::SetText(g, Text.s) 
    For a = 0 To 5
      Editor::AddItem(g, a, "Line "+Str(a))
    Next
    Editor::SetFont(g, FontID(0))
    
    SplitterGadget(10,8, 8, 306, 276, 0,g)
    PostEvent(#PB_Event_SizeWindow, 0, #PB_Ignore) ; Bug
    BindEvent(#PB_Event_SizeWindow, @ResizeCallBack(), 0)
    
    Repeat 
      Define Event = WaitWindowEvent()
      
      Select Event
        Case #PB_Event_LeftClick  
          SetActiveGadget(0)
        Case #PB_Event_RightClick 
          SetActiveGadget(10)
      EndSelect
    Until Event = #PB_Event_CloseWindow
  EndIf
CompilerEndIf

Something I found.

mestnyi · Post by **mestnyi** » Wed Sep 19, 2018 12:53 pm

Updated the first post
Now it works equally on windows and mac os and linux

Kwai chang caine · Post by **Kwai chang caine** » Thu Sep 20, 2018 1:32 pm

Waouuuuh splendid !!!!

Works perfectly here w7 x86 / v5.62 x86
Thanks for sharing

PureBasic Forums - English

module_editor

module_editor

Re: module_editor

Re: module_editor

Re: module_editor

Re: module_editor