Code: Select all
;-
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
