It is currently Sun Aug 18, 2019 4:37 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 8 posts ] 
Author Message
 Post subject: module_text
PostPosted: Sun May 06, 2018 10:52 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Nov 25, 2013 6:41 am
Posts: 769
module_text.pbi

Code:
;-
DeclareModule Gadget
  EnableExplicit
 
  EnumerationBinary
    #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 Color
    Front.l[4]
    Fore.l[4]
    Back.l[4]
    Line.l[4]
    Frame.l[4]
    Arrows.l[4]
  EndStructure
 
  Structure Text Extends Coordinate
    ;     Char.c
    Len.l
    String.s[3]
    Change.b
   
    Align.l
   
    XAlign.b
    YAlign.b
    Lower.b
    Upper.b
    Pass.b
    Editable.b
    Numeric.b
    WordWrap.b
    MultiLine.b
   
    CaretPos.l[2] ; 0 = Pos ; 1 = PosFixed
   
    Mode.l
  EndStructure
 
  Structure Struct Extends Coordinate
    Canvas.Canvas
    Color.Color[4]
   
    FontID.l
    Text.Text[4]
   
    fSize.l
    bSize.l
    Hide.b[2]
    Disable.b[2]
   
    Type.l
  EndStructure
 
 
  ;- DECLARE
  Declare.s GetText(Gadget.l)
  Declare SetText(Gadget.l, Text.s)
  Declare SetFont(Gadget.l, FontID.l)
  Declare.l GetColor(Gadget.l, ColorType.l)
  Declare.b SetColor(Gadget.l, ColorType.l, Color.l)
  Declare Text(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
 
EndDeclareModule

Module Gadget
 
  ;- PROCEDURE
 
  Procedure.s MakeMultiText(Text.s, Width)
    Protected String.s, String1.s, String2.s, String3.s, IT, Start, Length, CountString
   
    ; Перевести разрывы строк
    Text = ReplaceString(Text, #LFCR$, #LF$)
    Text = ReplaceString(Text, #CRLF$, #LF$)
    Text = ReplaceString(Text, #CR$, #LF$)
    Text + #LF$
    ;
    CountString = CountString(Text, #LF$)
   
    If CountString
      ; make multi text
      For IT = 1 To CountString : Start = 1
        String = StringField(Text, IT, #LF$)
        Length = CountString(String, " ") + Start
       
        Repeat : String1 = StringField(String, Start, " ")
          Repeat : Start+1 : String2 = StringField(String, Start, " ")
           
            If (TextWidth(Trim(String1+" "+String2)) < (Width-Len(Mid(String2,Len(String2)))))
              String1 = Trim(String1+" "+String2)
            Else
              Break
            EndIf
           
          Until (Start>Length)
         
          String3+String1+#LF$
        Until (Start>Length)
      Next
    EndIf
   
    ProcedureReturn String3
   
  EndProcedure
 
  Procedure.s MakeWrapText(Text.s, Width)
    Protected String.s, String1.s, String2.s, String3.s, String4.s, String5.s, String6.s, IT, Start, Count, CountString
   
    ;     ; Перевести разрывы строк
    ;     Text = ReplaceString(Text, #LFCR$, #LF$)
    ;     Text = ReplaceString(Text, #CRLF$, #LF$)
    ;     Text = ReplaceString(Text, #CR$, #LF$)
    ;     Text + #LF$
    ;     ;
    Text = MakeMultiText(Text, Width)
    CountString = CountString(Text, #LF$)
   
    Protected StringLength, NewStringLength, Length=Len(Text)
   
    If CountString
     
      For IT = 1 To CountString : Start = 1
        String = StringField(Text, IT, #LF$)
       
        Repeat : StringLength=0
          Repeat : StringLength+1 : String2=Mid(String, Start, StringLength)
           
            If TextWidth(String2)<Width
              NewStringLength=StringLength
              String1=String2
            Else
              Break
            EndIf
           
          Until (Start+StringLength)>Length
         
          String3+String1+#LF$
          Start+NewStringLength
        Until (Start>Length)
      Next
     
    EndIf
   
    ProcedureReturn String3
   
  EndProcedure
 
  Procedure Draw(*This.Struct)
    Protected String.s, String1.s, String2.s, String3.s, String4.s, StringWidth, CountString
    Protected IT,Text_Y,Text_X,TxtHeight,Width,Height
   
    With *This
      If StartDrawing(CanvasOutput(\Canvas\Gadget))
        If \FontID : DrawingFont(\FontID) : EndIf
        Box(\X[1],\Y[1],\Width[1],\Height[1],\Color\Back)
       
        If \fSize
          DrawingMode(#PB_2DDrawing_Outlined)
          Box(\X[1],\Y[1],\Width[1],\Height[1],\Color\Frame)
        EndIf
       
        If \Text\String.s
          \Text\Height = TextHeight("A")
          \Text\Width = TextWidth(\Text\String.s)
          TxtHeight=\Text\Height
          Width = \Width[2]
          Height = \Height[2]
         
          If \Text\MultiLine
            String.s = MakeMultiText(\Text\String.s, \Width[1]) : \Text\String.s[2] = String.s
            CountString = CountString(String, #LF$)
          ElseIf \Text\WordWrap
            String.s = MakeWrapText(\Text\String.s, \Width[1]) : \Text\String.s[2] = String.s
            CountString = CountString(String, #LF$)
          Else
            String.s = \Text\String.s
            CountString = 1
          EndIf
         
          If CountString
            If Bool((\Text\Align & #PB_Text_Bottom) = #PB_Text_Bottom)
              Text_Y=(Height-(TxtHeight * CountString))
            ElseIf Bool((\Text\Align & #PB_Text_Middle) = #PB_Text_Middle)
              Text_Y=((Height-(TxtHeight * CountString))/2)
            EndIf
           
            For IT = 1 To CountString
              String4 = StringField(String, IT, #LF$)
              StringWidth = TextWidth(String4)
             
              If Bool((\Text\Align & #PB_Text_Right) = #PB_Text_Right)
                Text_X=(Width-StringWidth)
              ElseIf Bool((\Text\Align & #PB_Text_Center) = #PB_Text_Center)
                Text_X=(Width-StringWidth)/2
              EndIf
             
              If Text_X<\fSize : Text_X=\fSize : EndIf
             
              DrawingMode(#PB_2DDrawing_Transparent)
              DrawText(\Text\X+Text_X, \Text\Y+Text_Y, String4.s, \Color\Front)
             
              Text_Y+TxtHeight : If Text_Y > (Height-TxtHeight) : Break : EndIf
            Next
          EndIf
         
        EndIf
       
        StopDrawing()
      EndIf
    EndWith 
  EndProcedure
 
  Procedure CallBack()
    Static LastX, LastY
    Protected *This.Struct = 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)
          \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
         
          Draw(*This)
      EndSelect
    EndWith
   
  EndProcedure
 
  ;- PUBLIC
  Procedure.s GetText(Gadget.l)
    Protected ScrollPos, *This.Struct = GetGadgetData(Gadget)
    ProcedureReturn *This\Text\String.s
  EndProcedure
 
  Procedure SetText(Gadget.l, Text.s)
    Protected *This.Struct = GetGadgetData(Gadget)
    *This\Text\String.s = Text.s
    Draw(*This)
  EndProcedure
 
  Procedure SetFont(Gadget.l, FontID.l)
    Protected *This.Struct = GetGadgetData(Gadget)
    *This\FontID = FontID
    Draw(*This)
  EndProcedure
 
  Procedure.b SetColor(Gadget.l, ColorType.l, Color.l)
    Protected *This.Struct = GetGadgetData(Gadget)
   
    With *This
      Select ColorType
        Case #PB_Gadget_LineColor
          \Color\Line = Color
         
        Case #PB_Gadget_BackColor
          \Color\Back = Color
         
        Case #PB_Gadget_FrontColor
          \Color\Front = Color
         
        Default ; Case #PB_Gadget_FrameColor
          \Color\Frame = Color
         
      EndSelect
    EndWith
   
    Draw(*This)
    ProcedureReturn Bool(Color)
  EndProcedure
 
  Procedure.l GetColor(Gadget.l, ColorType.l)
    Protected Color.l, *This.Struct = GetGadgetData(Gadget)
   
    With *This
      Select ColorType
        Case #PB_Gadget_LineColor
          Color = \Color\Line
         
        Case #PB_Gadget_BackColor
          Color = \Color\Back
         
        Case #PB_Gadget_FrontColor
          Color = \Color\Front
         
        Default ; Case #PB_Gadget_FrameColor
          Color = \Color\Frame
         
      EndSelect
    EndWith
   
    ProcedureReturn Color
  EndProcedure
 
  Procedure Text(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
    Protected *This.Struct=AllocateStructure(Struct)
    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
        \Width = Width
        \Height = Height
        \Canvas\Gadget = Gadget
        \Type = #PB_GadgetType_Text
        \FontID = GetGadgetFont(#PB_Default)
       
        \fSize = Bool(Flag&#PB_Text_Border)
        \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\Frame = $C0C0C0
        \Color\Back = $F0F0F0
       
        \Text\Editable = Bool(Not Flag&#PB_Text_ReadOnly)
        \Text\WordWrap = Bool(Flag&#PB_Text_WordWrap)
        If Not \Text\WordWrap
          \Text\MultiLine = 1;Bool(Flag&#PB_Text_MultiLine)
        EndIf
       
        \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\String.s = Text.s
       
        Draw(*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
      Debug GetGadgetText(6)
      Debug Gadget::GetText(16)
     
  EndSelect
EndProcedure


Procedure ResizeCallBack()
  ResizeGadget(0, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow(), #PB_Window_InnerCoordinate)-16, #PB_Ignore)
  ResizeGadget(16, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow(), #PB_Window_InnerCoordinate)-16, #PB_Ignore)
EndProcedure

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

If OpenWindow(0, 0, 0, 160, 690, "StringGadget Centered Text", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  ;EditorGadget(0, 10, 10, 380, 330, #PB_Editor_WordWrap) : SetGadgetText(0, Text.s)
  TextGadget(0, 10, 10, 380, 330, Text.s)
  SetGadgetColor(0, #PB_Gadget_BackColor, $FFFFFF)
  SetGadgetColor(0, #PB_Gadget_FrontColor, $6666D6)
  SetGadgetFont(0,FontID(0) )
 
  g=16
  Gadget::Text(g, 10, 350, 380, 330, Text.s);, Gadget::#PB_Text_WordWrap);
  Gadget::SetColor(g, #PB_Gadget_BackColor, $FFFFFF)
  Gadget::SetColor(g, #PB_Gadget_FrontColor, $6666D6)
  Gadget::SetFont(g, FontID(0))
 
  PostEvent(#PB_Event_SizeWindow, 0, #PB_Ignore)
  BindEvent(#PB_Event_SizeWindow, @ResizeCallBack(), 0)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 11:45 am 
Offline
Addict
Addict

Joined: Sat Mar 02, 2013 9:17 am
Posts: 931
Hi,
a quick test, it looks not centered

_________________
http://www.nachtoptik.de


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 11:55 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Nov 25, 2013 6:41 am
Posts: 769
Is it? Have you tried the flags?

Code:
Gadget::Text(g, 10, 350, 380, 330, Text.s, Gadget::#PB_Text_Center|Gadget::#PB_Text_Middle);
 


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 12:07 pm 
Offline
Addict
Addict

Joined: Sat Mar 02, 2013 9:17 am
Posts: 931
Hi,
i have start the code without changes, because description is centered

_________________
http://www.nachtoptik.de


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 1:01 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1832
Location: Germany
#PB_Text_Center and #PB_Text_Right always exists...

With macOS there is an error that the constant ones already exist.
This error message is missing in window and is a bug of PB

It is not good that the constants are reassigned.
In your case it goes however exceptionally well, since the values of the constant windows are equal.

BUT not with MacOS

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 1:14 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Nov 25, 2013 6:41 am
Posts: 769
mk-soft wrote:
#PB_Text_Center and #PB_Text_Right always exists...

With macOS there is an error that the constant ones already exist.
This error message is missing in window and is a bug of PB

It is not good that the constants are reassigned.
In your case it goes however exceptionally well, since the values of the constant windows are equal.

BUT not with MacOS

I agree, but it was convenient for me. I only have windows. :)


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 1:17 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1832
Location: Germany
I reported it as a bug...

viewtopic.php?f=4&t=70667

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: module_text
PostPosted: Sun May 06, 2018 7:22 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4486
Location: Lyon - France
walbus wrote:
Hi,
a quick test, it looks not centered
+1 :wink:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 8 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye