module_string

Share your advanced PureBasic knowledge/code with the community.
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

module_string

Post by mestnyi »

Code: Select all

;-
DeclareModule String
  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 
  
  
  
  ;- 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
    
    Align.l
    
    XAlign.b
    YAlign.b
    Lower.b
    Upper.b
    Pass.b
    Editable.b
    Numeric.b
    Wrap.b
    MultiLine.b
    
    CaretPos.l[2] ; 0 = Pos ; 1 = PosFixed
    
    Mode.l
  EndStructure
  
  Structure Gadget Extends Coordinate
    FontID.l
    Canvas.Canvas
    
    Text.Text[4]
    ImageID.l[3]
    Color.l[3]
    CaretLength.l
    
    Image.Coordinate
    
    fSize.l
    bSize.l
    Hide.b[2]
    Disable.b[2]
    
    Scroll.Coordinate
    
    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 Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
  
  Declare SetFont(Gadget, FontID.l)
EndDeclareModule

Module String
  
  ;- PROCEDURE
  
  Procedure CaretPos(*This.Gadget)
    Protected Repaint.l =- 1, i.l, CursorX.l, Distance.f, MinDistance.f = Infinity()
    
    With *This
      If StartDrawing(CanvasOutput(\Canvas\Gadget)) 
        If \FontID : DrawingFont(\FontID) : EndIf
        
        For i=0 To \Text\Len
          \CaretLength = TextWidth(Left(\Text\String.s, i))
          CursorX = \Text\x + \CaretLength + 1
          Distance = (\Canvas\Mouse\X-CursorX)*(\Canvas\Mouse\X-CursorX)
          
          ; Получаем позицию коpректора
          If MinDistance > Distance 
            MinDistance = Distance
            Repaint = i
          EndIf
        Next
        
        StopDrawing()
      EndIf
    EndWith
    
    ProcedureReturn Repaint
  EndProcedure
  
  Procedure SelectionText(*This.Gadget)
    Protected CaretPos
    
    With *This
      ; Если выделяем с право на лево
      If \Text\CaretPos[1] > \Text\CaretPos : CaretPos = \Text\CaretPos
        \Text[2]\Len = (\Text\CaretPos[1]-\Text\CaretPos)
      Else : CaretPos = \Text\CaretPos[1]
        \Text[2]\Len = \Text\CaretPos-\Text\CaretPos[1]
      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
      If \Text\CaretPos > \Text\CaretPos[1] : \Text\CaretPos = \Text\CaretPos[1] : EndIf
      \Text\String.s = RemoveString(\Text\String.s, \Text[2]\String.s, #PB_String_CaseSensitive, \Text\CaretPos, 1)
      \Text\String.s[1] = RemoveString(\Text\String.s[1], \Text[2]\String.s, #PB_String_CaseSensitive, \Text\CaretPos, 1)
      \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 SelectionLimits(*This.Gadget)
    With *This
      Protected i, char = Asc(Mid(\Text\String.s, \Text\CaretPos + 1, 1))
      
      If (char > =  ' ' And char < =  '/') Or 
         (char > =  ':' And char < =  '@') Or 
         (char > =  '[' And char < =  96) Or 
         (char > =  '{' And char < =  '~')
        
        \Text\CaretPos[1] = \Text\CaretPos : \Text\CaretPos + 1
        \Text[2]\Len = \Text\CaretPos[1] - \Text\CaretPos
      Else
        For i = \Text\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 : \Text\CaretPos[1] = 0 : Else : \Text\CaretPos[1] = i : EndIf
        
        For i = \Text\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
        
        \Text\CaretPos = i - 1
        \Text[2]\Len = \Text\CaretPos[1] - \Text\CaretPos
        
        If \Text[2]\Len < 0 : \Text[2]\Len = 0 : EndIf
      EndIf
    EndWith           
  EndProcedure
  
  Procedure EditableCallBack(*This.Gadget, EventType.l)
    Static Text$, DoubleClickCaretPos =- 1
    Protected Repaint, StartDrawing, Update_Text_Selected
    
    
    If *This
      With *This
        If Not \Disable
          Select EventType
            Case #PB_EventType_MouseEnter
              SetGadgetAttribute(*This\Canvas\Gadget, #PB_Canvas_Cursor, #PB_Cursor_IBeam)
              
            Case #PB_EventType_LostFocus : Repaint = #True
              \Text[2]\Len = 0 ; Убыраем выделение
              \Text\CaretPos[1] =- 1 ; Прячем коректор
              
            Case #PB_EventType_Focus : Repaint = #True
              \Text\CaretPos[1] = \Text\CaretPos ; Показываем коректор
              
            Case #PB_EventType_Input
              If \Text\Editable
                Protected Input, Input_2
                
                Select #True
                  Case \Text\Lower : Input = Asc(LCase(Chr(\Canvas\Input))) : Input_2 = Input
                  Case \Text\Upper : Input = Asc(UCase(Chr(\Canvas\Input))) : Input_2 = Input
                  Case \Text\Pass  : Input = 9679 : Input_2 = \Canvas\Input ; "●"
                  Case \Text\Numeric                                        ; : Debug Chr(\Canvas\Input)
                    Static Dot
                    
                    Select \Canvas\Input 
                      Case '.','0' To '9' : Input = \Canvas\Input : Input_2 = Input
                      Case 'Ю','ю','Б','б',44,47,60,62,63 : Input = '.' : Input_2 = Input
                      Default
                        Input_2 = \Canvas\Input
                    EndSelect
                    
                    If Not Dot And Input = '.'
                      Dot = 1
                    ElseIf Input <> '.'
                      Dot = 0
                    Else
                      Input = 0
                    EndIf
                    
                  Default
                    Input = \Canvas\Input : Input_2 = Input
                EndSelect
                
                If Input_2
                  If Input
                    If \Text[2]\Len : RemoveText(*This) : EndIf
                    \Text\CaretPos + 1 : \Text\CaretPos[1] = \Text\CaretPos
                  EndIf
                  
                  ;\Text\String.s = Left(\Text\String.s, \Text\CaretPos-1) + Chr(Input) + Mid(\Text\String.s, \Text\CaretPos)
                  \Text\String.s = InsertString(\Text\String.s, Chr(Input), \Text\CaretPos)
                  \Text\String.s[1] = InsertString(\Text\String.s[1], Chr(Input_2), \Text\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 : \Text\CaretPos = 0 : \Text\CaretPos[1] = \Text\CaretPos : Repaint = #True 
                Case #PB_Shortcut_End : \Text[2]\String.s = "" : \Text[2]\Len = 0 : \Text\CaretPos = \Text\Len : \Text\CaretPos[1] = \Text\CaretPos : Repaint = #True 
                  
                Case #PB_Shortcut_Left, #PB_Shortcut_Up : \Text[2]\String.s = ""
                  If \Text\CaretPos > 0 : \Text\CaretPos - 1 
                    If \Text\CaretPos[1] <> \Text\CaretPos
                      If \Text[2]\Len 
                        If \Text\CaretPos > \Text\CaretPos[1] 
                          \Text\CaretPos = \Text\CaretPos[1] 
                          \Text\CaretPos[1] = \Text\CaretPos 
                        Else
                          \Text\CaretPos[1] = \Text\CaretPos + 1 
                          \Text\CaretPos = \Text\CaretPos[1] 
                        EndIf
                        \Text[2]\Len = 0
                      Else
                        \Text\CaretPos[1] = \Text\CaretPos 
                      EndIf
                    EndIf
                    Repaint = #True 
                  EndIf
                  
                Case #PB_Shortcut_Right, #PB_Shortcut_Down : \Text[2]\String.s = ""
                  If \Text\CaretPos[1] < \Text\Len : \Text\CaretPos[1] + 1 
                    If \Text\CaretPos <> \Text\CaretPos[1]
                      If \Text[2]\Len 
                        If \Text\CaretPos > \Text\CaretPos[1] 
                          \Text\CaretPos = \Text\CaretPos[1]+\Text[2]\Len - 1 
                          \Text\CaretPos[1] = \Text\CaretPos
                        Else
                          \Text\CaretPos = \Text\CaretPos[1] - 1
                          \Text\CaretPos[1] = \Text\CaretPos
                        EndIf
                        \Text[2]\Len = 0
                      Else
                        \Text\CaretPos = \Text\CaretPos[1] 
                      EndIf
                    EndIf
                    Repaint = #True 
                  EndIf
                  
                Case #PB_Shortcut_X
                  If \Text[2]\String.s And (*This\Canvas\Key[1] & #PB_Canvas_Control) 
                    SetClipboardText(\Text[2]\String.s)
                    RemoveText(*This)
                    \Text\CaretPos[1] = \Text\CaretPos
                    \Text\Len = Len(\Text\String.s)
                    Repaint = #True 
                  EndIf
                  
                Case #PB_Shortcut_C
                  If \Text[2]\String.s And (*This\Canvas\Key[1] & #PB_Canvas_Control) 
                    SetClipboardText(\Text[2]\String.s)
                  EndIf
                  
                Case #PB_Shortcut_Back 
                  If \Text\CaretPos > 0
                    If \Text[2]\Len
                      RemoveText(*This)
                    Else
                      \Text[2]\String.s[1] = Mid(\Text\String.s, \Text\CaretPos, 1)
                      \Text\String.s = Left(\Text\String.s, \Text\CaretPos - 1) + Right(\Text\String.s, \Text\Len-\Text\CaretPos)
                      \Text\String.s[1] = Left(\Text\String.s[1], \Text\CaretPos - 1) + Right(\Text\String.s[1], Len(\Text\String.s[1])-\Text\CaretPos)
                      \Text\CaretPos - 1 
                    EndIf
                    
                    \Text\CaretPos[1] = \Text\CaretPos
                    \Text\Len = Len(\Text\String.s)
                    Repaint = #True
                  EndIf
                  
                Case #PB_Shortcut_Delete 
                  If \Text\CaretPos < \Text\Len
                    If \Text[2]\String.s
                      RemoveText(*This)
                    Else
                      \Text[2]\String.s[1] = Mid(\Text\String.s, (\Text\CaretPos+1), 1)
                      \Text\String.s = Left(\Text\String.s, \Text\CaretPos) + Right(\Text\String.s, \Text\Len-(\Text\CaretPos+1))
                      \Text\String.s[1] = Left(\Text\String.s[1], \Text\CaretPos) + Right(\Text\String.s[1], Len(\Text\String.s[1])-(\Text\CaretPos+1))
                    EndIf
                    
                    \Text\CaretPos[1] = \Text\CaretPos
                    \Text\Len = Len(\Text\String.s)
                    Repaint = #True
                  EndIf
                  
                Case #PB_Shortcut_V
                  If \Text\Editable And (*This\Canvas\Key[1] & #PB_Canvas_Control)
                    Protected ClipboardText.s = GetClipboardText()
                    
                    If ClipboardText.s
                      If \Text[2]\String.s
                        RemoveText(*This)
                      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, \Text\CaretPos + 1)
                      \Text\CaretPos + Len(ClipboardText.s)
                      \Text\CaretPos[1] = \Text\CaretPos
                      \Text\Len = Len(\Text\String.s)
                      Repaint = #True
                    EndIf
                  EndIf
                  
              EndSelect 
              
            Case #PB_EventType_LeftDoubleClick 
              DoubleClickCaretPos = \Text\CaretPos
              
              If \Text\Pass
                \Text\CaretPos = Len(\Text\String.s)
                \Text[2]\Len = \Text\CaretPos
                \Text\CaretPos[1] = 0
              Else
                SelectionLimits(*This)
              EndIf
              
              SelectionText(*This) 
              Repaint = #True
              
            Case #PB_EventType_LeftButtonDown
              \Text\CaretPos = CaretPos(*This)
              
              If \Text\CaretPos = DoubleClickCaretPos
                \Text\CaretPos = Len(\Text\String.s)
                \Text\CaretPos[1] = 0
              Else
                \Text\CaretPos[1] = \Text\CaretPos
              EndIf 
              
              If \Text\Numeric
                \Text\String.s[1] = \Text\String.s
              EndIf
              
              SelectionText(*This)
              DoubleClickCaretPos =- 1
              Repaint = #True
              
            Case #PB_EventType_MouseMove
              If \Canvas\Mouse\Buttons & #PB_Canvas_LeftButton
                \Text\CaretPos = CaretPos(*This)
                SelectionText(*This)
                Repaint = #True
              EndIf
              
          EndSelect
          
        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
    With *This
      If \Repaint And StartDrawing(CanvasOutput(\Canvas\Gadget))
        If \FontID : DrawingFont(\FontID) : EndIf
        Box(\X[1],\Y[1],\Width[1],\Height[1],\Color[0])
        
        If \fSize
          DrawingMode(#PB_2DDrawing_Outlined)
          If (\Text[2]\Len Or \Text\CaretPos=\Text\CaretPos[1])
            Box(\X[1],\Y[1],\Width[1],\Height[1],$FF8E00)
          Else
            Box(\X[1],\Y[1],\Width[1],\Height[1],\Color[1])
          EndIf
        EndIf
        
        If \ImageID : DrawImage(\ImageID, \x,\y+(\height-\Image\Height)/2) : EndIf
        
        \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)
        \CaretLength = TextWidth(Left(\Text\String.s, \Text\CaretPos))
        
        ; Перемещаем корректор
        If \Text\Editable
          If \Text[2]\String.s[1] And \Scroll\X < 0
            \Scroll\X + TextWidth(\Text[2]\String.s[1]) 
            \Text[2]\String.s[1] = ""
          EndIf
        EndIf
                
        If Bool((\Text\Align & #PB_Text_Bottom) = #PB_Text_Bottom) 
          \Scroll\Y = (\Height-\Text\Height)
        ElseIf Bool((\Text\Align & #PB_Text_Middle) = #PB_Text_Middle) 
          \Scroll\Y = (\Height-\Text\Height)/2
        EndIf
            
        If Bool((\Text\Align & #PB_Text_Right) = #PB_Text_Right) 
          \Scroll\X = (\Width-\Text\Width-\fSize*2) - r
        ElseIf Bool((\Text\Align & #PB_Text_Center) = #PB_Text_Center) 
          If (\Width-\Text\Width)/2>\fSize*2 + r 
            \Scroll\X=(\Width-\Text\Width)/2 
            If \Text\CaretPos[1] =- 1
              \CaretLength =- \Scroll\X + \fSize*2 + r
              \Text\CaretPos = \CaretLength
            EndIf
          EndIf
        EndIf
        
        Left =- (\CaretLength-\fSize*2) + r
        Right = (\Width-\CaretLength-\fSize*2) - r
        
        If \Scroll\X < Left
          \Scroll\X = Left
        ElseIf \Scroll\X > Right
          \Scroll\X = Right
        EndIf
        
        \Text\X = \Scroll\X 
        \Text\Y = \Scroll\Y 
        
        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
        
        If \Text\CaretPos=\Text\CaretPos[1] ; And Property_GadgetTimer( 300 )
          DrawingMode(#PB_2DDrawing_XOr)             
          Line(\Text\X + \CaretLength - Bool(\Scroll\X = Right), \Text\Y, 1, \Text\Height, $FFFFFF)
        EndIf
        
        ; 
        If \Text\Numeric
          If \Text\String.s[1]<>\Text\String.s
            DrawingMode(#PB_2DDrawing_Default)
            Box(\X[1],\Y[1],\Width[1],\Height[1],\Color[0])
            DrawingMode(#PB_2DDrawing_Transparent)
            DrawText((\Width[1]-TextWidth("!!! Недопустимый символ"))/2, \Text\Y, "!!! Недопустимый символ", $0000FF)
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(\X[1],\Y[1],\Width[1],\Height[1],$0000FF)
          EndIf
        EndIf
        
        \Repaint = #False
        StopDrawing()
      EndIf
    EndWith  
  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)
      
      Select EventType()
        Case #PB_EventType_Resize : ResizeGadget(\Canvas\Gadget, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore) ; Bug (562)
          Re(*This)
          
      EndSelect
      
      
      If EditableCallBack(*This, EventType())
        ReDraw(*This)
      EndIf
      
      ;       *This\Repaint = Scroll::CallBack(*This\Scroll, EventType(), \Canvas\Mouse\X, \Canvas\Mouse\Y)
      ;       If *This\Repaint 
      ;         ReDraw(*This)
      ;         PostEvent(#PB_Event_Gadget, \Canvas\Window, \Canvas\Gadget, #PB_EventType_Change)
      ;       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 SetFont(Gadget, FontID.l)
    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
    
    If *This
      With *This
        \Canvas\Gadget = Gadget
        \Width = Width
        \Height = Height
        \Type = #PB_GadgetType_String
        \FontID = GetGadgetFont(#PB_Default)
        
        Flag|#PB_Text_Middle
        
        \fSize = Bool(Not Flag&#PB_String_BorderLess)
        \bSize = \fSize
        
        ; 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\Numeric = Bool(Flag&#PB_Text_Numeric)
        \Text\Editable = Bool(Not Flag&#PB_Text_ReadOnly)
        \Text\Lower = Bool(Flag&#PB_Text_LowerCase)
        \Text\Upper = Bool(Flag&#PB_Text_UpperCase)
        \Text\Pass = Bool(Flag&#PB_Text_Password)
        \Text\MultiLine = Bool(Flag&#PB_Text_MultiLine)
        
        ;         \Text\X = \fSize
        ;         \Text\y = \fSize
        
        If Bool(Flag&#PB_Text_Center) : \Text\Align | #PB_Text_Center : EndIf
        If Bool(Flag&#PB_Text_Middle) : \Text\Align | #PB_Text_Middle : EndIf
        If Bool(Flag&#PB_Text_Right)  : \Text\Align | #PB_Text_Right : EndIf
        If Bool(Flag&#PB_Text_Bottom) : \Text\Align | #PB_Text_Bottom : EndIf
        
;         \Text\YAlign = Bool(Flag&#PB_Text_Center)
;         
;         \Text\Align = Flag
; ;         If Bool(Flag&#PB_Text_Center)
; ;           \Text\Align | #PB_Text_Center
; ;         EndIf
; ;         If Bool(Flag&#PB_Text_Middle)
; ;           \Text\Align | #PB_Text_Middle
; ;         EndIf
; ;         
;         If Not \Text\MultiLine
;           \Text\YAlign = 9 
;           If Bool(Flag&#PB_Text_Right) : \Text\XAlign = 2 : EndIf
;           If Bool(Flag&#PB_Text_Center) : \Text\XAlign = 9 : EndIf
;         EndIf
        
        If \Text\Editable
          \Color[0] = $FFFFFF
        Else
          \Color[0] = $F0F0F0
        EndIf
        
        \Text\String.s[1] = Text.s
        
        If \Text\Pass
          Protected i,Len = Len(Text.s)
          Text.s = "" : For i=0 To Len : Text.s + "●" : Next
        EndIf
        
        Select #True
          Case \Text\Lower : \Text\String.s = LCase(Text.s)
          Case \Text\Upper : \Text\String.s = UCase(Text.s)
          Default
            \Text\String.s = Text.s
        EndSelect
        
        \Text\CaretPos[1] =- 1
        \Text\Len = Len(\Text\String.s)
        
        ReDraw(*This)
        SetGadgetData(Gadget, *This)
        BindGadgetEvent(Gadget, @CallBack())
      EndIf
    EndWith
    
    ProcedureReturn Gadget
  EndProcedure
EndModule


;- EXAMPLE
If LoadImage(0, #PB_Compiler_Home+"Examples\Sources\Data\File.bmp")     ; Измените путь/имя файла на собственное изображение 32x32 пикселя
EndIf
Define a,i


Procedure CallBack()
  Select EventType()
    Case #PB_EventType_Change
      If GadgetType(EventGadget()) = #PB_GadgetType_String
        Debug GetGadgetText(EventGadget())
      Else
        Debug String::GetText(EventGadget())
      EndIf
      
  EndSelect
EndProcedure


LoadFont(0, "Courier", 20)
Text.s = "Vertical and Horizontal" + #CRLF$ + "Centered Text in" + #CRLF$ + "Multiline StringGadget"

If OpenWindow(0, 0, 0, 605, 235, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  StringGadget(0, 8,  10, 290, 20, "Normal StringGadget...  ggggggggggggg dddddddddddd wwwwwwwwwww aaaaaaaaaaaaaa")
  StringGadget(1, 8,  35, 290, 20, "1234567", #PB_String_Numeric|#PB_Text_Center)
  StringGadget(2, 8,  60, 290, 20, "Read-only StringGadget", #PB_String_ReadOnly|#PB_Text_Right)
  StringGadget(3, 8,  85, 290, 20, "LOWERCASE...", #PB_String_LowerCase)
  StringGadget(4, 8, 110, 290, 20, "uppercase...", #PB_String_UpperCase)
  StringGadget(5, 8, 140, 290, 20, "Borderless StringGadget", #PB_String_BorderLess)
  StringGadget(6, 8, 170, 290, 20, "Password", #PB_String_Password)
  
  StringGadget(7, 8,  200, 290, 20, "aaaaaaa bbbbbbb ccccccc ddddddd eeeeeee fffffff ggggggg hhhhhhh", #PB_String_Numeric|#PB_Text_Center)
  
  String::Gadget(10, 300+8,  10, 290, 20, "Normal StringGadget...  ggggggggggggg dddddddddddd wwwwwwwwwww aaaaaaaaaaaaaa")
  String::Gadget(11, 300+8,  35, 290, 20, "1234567", #PB_String_Numeric|#PB_Text_Center)
  String::Gadget(12, 300+8,  60, 290, 20, "Read-only StringGadget", #PB_String_ReadOnly|#PB_Text_Right)
  String::Gadget(13, 300+8,  85, 290, 20, "LOWERCASE...", #PB_String_LowerCase)
  String::Gadget(14, 300+8, 110, 290, 20, "uppercase...", #PB_String_UpperCase)
  String::Gadget(15, 300+8, 140, 290, 20, "Borderless StringGadget", #PB_String_BorderLess)
  String::Gadget(16, 300+8, 170, 290, 20, "Password", #PB_String_Password)
  
  String::Gadget(17, 300+8,  200, 290, 20, "aaaaaaa bbbbbbb ccccccc ddddddd eeeeeee fffffff ggggggg hhhhhhh", #PB_String_Numeric|#PB_Text_Center)
  
  BindEvent(#PB_Event_Gadget, @CallBack())
  
  Repeat 
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_LeftClick  
        SetActiveGadget(0)
      Case #PB_Event_RightClick 
        SetActiveGadget(10)
    EndSelect
  Until Event = #PB_Event_CloseWindow
EndIf


Last edited by mestnyi on Thu Sep 20, 2018 12:53 pm, edited 1 time in total.
Cyllceaux
Enthusiast
Enthusiast
Posts: 510
Joined: Mon Jun 23, 2014 1:18 pm

Re: module_string

Post by Cyllceaux »

This is really cool!
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: module_string

Post by davido »

@mestnyi,
Very nice. Thank you for sharing.
DE AA EB
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: module_string

Post by Kwai chang caine »

Works fine another time.
Thanks for all your montruous job 8)
ImageThe happiness is a road...
Not a destination
Post Reply