TextBoxGadget Update v1.05.1Code:
;-TOP
; Comment : Object TextBoxGadget No 42 ;)
; Author : mk-soft
; Version : v1.05.1
; Create : 26.12.2019
; Update : 12.01.2020 (DPI)
; OS : All
; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305
IncludeFile "Modul_BaseClassSmall.pb"
EnableExplicit
; *****************************************************************************
;- Global
EnumerationBinary TextBox
#TEXT_Right
#TEXT_HCenter
#TEXT_VCenter
#TEXT_Bottom
EndEnumeration
;- Module Public
DeclareModule TextBoxGadget
UseModule BaseClass
EnumerationBinary TextBox
#TEXT_Right
#TEXT_HCenter
#TEXT_VCenter
#TEXT_Bottom
EndEnumeration
Interface iTextBoxGadget Extends iBaseClass
Resize(x, y, Width, Height)
Redraw(State = #True)
GetID()
AddText(Index, Text.s)
RemoveText(Index)
ClearText()
SetIndex(Index)
GetIndex()
SetText(Text.s)
GetText.s()
SetColor(ColorType, Color)
GetColor(ColorType)
SetFont(FontID)
GetFont()
SetFlags(Flags)
GetFlags()
SetUserData(UserData)
GetUserData()
EndInterface
UnuseModule BaseClass
Declare Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $DCDCDC, Flags = 0)
EndDeclareModule
;- Module Private
Module TextBoxGadget
EnableExplicit
UseModule BaseClass
NewClass(iTextBoxGadget)
Structure sTextBoxGadget Extends sBaseClass
Gadget.i
UserData.i
; Params
x.i
y.i
Width.i
Height.i
Text.s
FontID.i
LineColor.i
FrontColor.i
BackColor.i
Flags.i
; Data
Redraw.i
Event.i
Index.i
Map TextList.s()
EndStructure
; ********************************
; Kommentar : DrawTextBox
; Author : mk-soft
; Second Author :
; Orginal : DrawTextBox.pbi
; Version : 1.05
; Erstellt : 20.04.2014
; Geändert : 29.09.2018
Procedure DrawTextBox(x, y, dx, dy, text.s, flags = 0)
Protected is_right, is_hcenter, is_vcenter, is_bottom
Protected text_width, text_height, rows_height
Protected text_x, text_y, break_y
Protected text2.s, rows, row, row_text.s, row_text1.s, out_text.s, start, count
; Flags
is_right = flags & #TEXT_Right
is_hcenter = flags & #TEXT_HCenter
is_vcenter = flags & #TEXT_VCenter
is_bottom = flags & #TEXT_Bottom
; Übersetze Zeilenumbrüche
text = ReplaceString(text, #LFCR$, #LF$)
text = ReplaceString(text, #CRLF$, #LF$)
text = ReplaceString(text, #CR$, #LF$)
; Erforderliche Zeilenumbrüche setzen
rows = CountString(text, #LF$)
For row = 1 To rows + 1
text2 = StringField(text, row, #LF$)
If text2 = ""
out_text + #LF$
Continue
EndIf
start = 1
count = CountString(text2, " ") + 1
Repeat
row_text = StringField(text2, start, " ") + " "
Repeat
start + 1
row_text1 = StringField(text2, start, " ")
If TextWidth(row_text + row_text1) < dx - 12
row_text + row_text1 + " "
Else
Break
EndIf
Until start > count
out_text + RTrim(row_text) + #LF$
Until start > count
Next
; Berechne Y-Position
text_height = TextHeight("X")
rows = CountString(out_text, #LF$)
If is_vcenter
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1)) - 2
CompilerElse
text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1))
CompilerEndIf
ElseIf is_bottom
text_y = dy - (text_height * rows) - 2
Else
text_y = 2
EndIf
; Korrigiere Y-Position
While text_y < 2
text_y = 2;+ text_height
Wend
break_y = dy - text_height / 2
; Text ausgeben
For row = 1 To rows
row_text = StringField(out_text, row, #LF$)
If is_hcenter
text_x = dx / 2 - TextWidth(row_text) / 2
ElseIf is_right
text_x = dx - TextWidth(row_text) - 4
Else
text_x = 4
EndIf
DrawText(x + text_x, y + text_y, row_text)
text_y + text_height
If text_y > break_y
Break
EndIf
Next
ProcedureReturn rows
EndProcedure
; ********
Declare DrawGadget(*this)
;-- Public Object Function
Procedure Resize(*this.sTextBoxGadget, x, y, Width, Height)
With *this
If x <> #PB_Ignore
\x = x
EndIf
If y <> #PB_Ignore
\y = y
EndIf
If Width <> #PB_Ignore
\Width = Width
EndIf
If Height <> #PB_Ignore
\Height = Height
EndIf
ResizeGadget(\Gadget, \x, \y, \Width, \Height)
EndWith
EndProcedure : AsMethode(Resize)
; ----
Procedure Redraw(*this.sTextBoxGadget, State)
With *this
\Redraw = State
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(Redraw)
; ----
Procedure GetID(*this.sTextBoxGadget)
ProcedureReturn *this\Gadget
EndProcedure : AsMethode(GetID)
; ----
Procedure SetText(*this.sTextBoxGadget, Text.s)
With *this
\Text = Text
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetText)
Procedure.s GetText(*this.sTextBoxGadget)
ProcedureReturn *this\Text
EndProcedure : AsMethode(GetText)
; ----
Procedure AddText(*this.sTextBoxGadget, Index, Text.s)
With *this
\TextList(Str(Index)) = Text
EndWith
EndProcedure : AsMethode(AddText)
Procedure RemoveText(*this.sTextBoxGadget, Index)
With *this
DeleteMapElement(\TextList(), Str(Index))
EndWith
EndProcedure : AsMethode(RemoveText)
Procedure ClearText(*this.sTextBoxGadget)
With *this
ClearMap(\TextList())
EndWith
EndProcedure : AsMethode(ClearText)
; ----
Procedure SetIndex(*this.sTextBoxGadget, Index)
With *this
\Index = Index
If FindMapElement(\TextList(), Str(index))
\Text = \TextList()
Else
\Text = ""
EndIf
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetIndex)
Procedure GetIndex(*this.sTextBoxGadget)
ProcedureReturn *this\Index
EndProcedure : AsMethode(GetIndex)
; ----
Procedure SetColor(*this.sTextBoxGadget, ColorType, Color)
With *this
Select ColorType
Case #PB_Gadget_FrontColor
\FrontColor = Color
Case #PB_Gadget_BackColor
\BackColor = Color
Case #PB_Gadget_LineColor
\LineColor = Color
EndSelect
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetColor)
Procedure GetColor(*this.sTextBoxGadget, ColorType)
Protected color
With *this
Select ColorType
Case #PB_Gadget_FrontColor
color = \FrontColor
Case #PB_Gadget_BackColor
color = \BackColor
Case #PB_Gadget_LineColor
color = \LineColor
EndSelect
ProcedureReturn color
EndWith
EndProcedure : AsMethode(GetColor)
; ----
Procedure SetFont(*this.sTextBoxGadget, FontID)
With *this
If FontID
\FontID = FontID
Else
\FontID = #PB_Default
EndIf
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetFont)
Procedure GetFont(*this.sTextBoxGadget)
With *this
ProcedureReturn \FontID
EndWith
EndProcedure : AsMethode(GetFont)
; ----
Procedure SetFlags(*this.sTextBoxGadget, Flags)
With *this
\Flags = Flags
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetFlags)
Procedure GetFlags(*this.sTextBoxGadget)
With *this
ProcedureReturn \Flags
EndWith
EndProcedure : AsMethode(GetFlags)
; ----
Procedure SetUserData(*this.sTextBoxGadget, UserData)
With *this
\UserData = UserData
EndWith
EndProcedure : AsMethode(SetUserData)
Procedure GetUserData(*this.sTextBoxGadget)
With *this
ProcedureReturn \UserData
EndWith
EndProcedure : AsMethode(GetUserData)
;-- Drawing and Events Functions
Procedure.i BlendColor(Color1.i, Color2.i, Scale.i = 50) ; Thanks to Thorsten
Protected.i R1, G1, B1, R2, G2, B2
Protected.f Blend = Scale / 100
R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1)
R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2)
ProcedureReturn RGB((R1*Blend) + (R2 * (1 - Blend)), (G1*Blend) + (G2 * (1 - Blend)), (B1*Blend) + (B2 * (1 - Blend)))
EndProcedure
; ----
Procedure DrawGadget(*this.sTextBoxGadget)
Protected LineColor, FrontColor, BackColor
Protected Width, Height
With *this
Select \Event
Case #Null
LineColor = \LineColor
FrontColor = \FrontColor
BackColor = \BackColor
Case #PB_EventType_LeftButtonDown
LineColor = \LineColor
FrontColor = BlendColor(\FrontColor, $000000, 95)
BackColor = BlendColor(\BackColor, $000000, 95)
Case #PB_EventType_LeftButtonUp
LineColor = \LineColor
FrontColor = \FrontColor
BackColor = \BackColor
Case #PB_EventType_Resize
LineColor = \LineColor
FrontColor = \FrontColor
BackColor = \BackColor
EndSelect
Width = DesktopScaledX(\Width)
Height = DesktopScaledY(\Height)
If StartDrawing(CanvasOutput(\Gadget))
Box(0, 0, Width, Height, LineColor)
Box(1, 1, Width - 2, Height - 2, BackColor)
DrawingFont(\FontID)
FrontColor(FrontColor)
BackColor(BackColor)
DrawTextBox(1, 1, Width - 2, Height - 2, \Text, \Flags)
StopDrawing()
EndIf
EndWith
EndProcedure
; ----
Procedure DoEvents()
Protected *this.sTextBoxGadget = GetGadgetData(EventGadget())
Protected event, update
With *this
If *this
event = EventType()
Select event
Case #PB_EventType_MouseEnter
Case #PB_EventType_MouseLeave
Case #PB_EventType_MouseMove
Case #PB_EventType_MouseWheel
Case #PB_EventType_LeftButtonDown : update = #True
Case #PB_EventType_LeftButtonUp : update = #True
Case #PB_EventType_LeftClick
Case #PB_EventType_LeftDoubleClick
Case #PB_EventType_RightButtonDown
Case #PB_EventType_RightButtonUp
Case #PB_EventType_RightClick
Case #PB_EventType_RightDoubleClick
Case #PB_EventType_MiddleButtonDown
Case #PB_EventType_MiddleButtonUp
Case #PB_EventType_Focus
Case #PB_EventType_LostFocus
Case #PB_EventType_KeyDown
Case #PB_EventType_KeyUp
Case #PB_EventType_Input
Case #PB_EventType_Resize : update = #True
\x = GadgetX(\Gadget)
\y = GadgetY(\Gadget)
\Width = GadgetWidth(\Gadget)
\Height = GadgetHeight(\Gadget)
EndSelect
If update
\Event = event
DrawGadget(*this)
EndIf
EndIf
EndWith
EndProcedure
;-- Object Functions
Procedure Initialize(*this.sTextBoxGadget)
Protected result
With *this
result = CanvasGadget(\Gadget, \x, \y, \Width, \Height, \Flags)
If result
If \Gadget = #PB_Any
\Gadget = result
EndIf
\Redraw = #True
\Event = #Null
\FontID = #PB_Default
\LineColor = #Gray
DrawGadget(*this)
SetGadgetData(\Gadget, *this)
BindGadgetEvent(\Gadget, @DoEvents())
EndIf
EndWith
EndProcedure : AsInitializeObject(Initialize)
; ----
Procedure Dispose(*this.sTextBoxGadget)
With *this
If IsGadget(\Gadget)
FreeGadget(\Gadget)
EndIf
EndWith
EndProcedure : AsDisposeObject(Dispose)
; ----
Procedure Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $DCDCDC, Flags = 0)
Protected *object.sTextBoxGadget
With *object
AllocateObject(*object, sTextBoxGadget)
If *object
\Gadget = Gadget
\x = x
\y = y
\Width = Width
\Height = Height
\Text = Text
\FrontColor = FrontColor
\BackColor = BackColor
\Flags = Flags
EndIf
InitializeObject(*object)
ProcedureReturn *object
EndWith
EndProcedure
; ----
CheckInterface()
EndModule
; *****************************************************************************
;- Example
CompilerIf #PB_Compiler_IsMainFile
Enumeration Windows
#Main
EndEnumeration
Enumeration Gadgets
#Text1
#Button1
#Button2
#Button3
#Button4
EndEnumeration
Enumeration Status
#MainStatusBar
EndEnumeration
LoadFont(0, "Courier New", 16, #PB_Font_Bold)
LoadFont(1, "Courier New", 20, #PB_Font_Bold | #PB_Font_Italic)
Procedure.s GetDataSectionText(Addr)
Protected result.s, temp.s
While PeekC(Addr)
temp = PeekS(Addr)
Addr + StringByteLength(temp) + SizeOf(Character)
result + temp
Wend
ProcedureReturn result
EndProcedure
Procedure Main()
; Define Object
Protected.TextBoxGadget::iTextBoxGadget TextBox
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object TextBoxGadget No 42 ;)", #PB_Window_SystemMenu)
TextBox = TextBoxGadget::Create(#Text1, 10, 10, 460, 240, "My TextBoxGadget", #Black, #White, #TEXT_VCenter | #TEXT_HCenter)
TextBox\AddText(10, "Index 10: " + #LF$ + "Flags Left/Top - Background Red")
TextBox\AddText(20, "Index 20: " + #LF$ + "Flags Right - Background Yellow")
TextBox\AddText(9990, "Index 9990: " + #LF$ + "Flags Right/Bottom - Background Green")
ButtonGadget(#Button1, 10, 260, 100, 25, "Button 1")
ButtonGadget(#Button2, 120, 260, 100, 25, "Button 2")
ButtonGadget(#Button3, 230, 260, 100, 25, "Button 3")
ButtonGadget(#Button4, 340, 260, 100, 25, "Button 4")
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #Text1
If EventType() = #PB_EventType_LeftClick
EndIf
Case #Button1
TextBox\Redraw(#False)
TextBox\SetIndex(10)
TextBox\SetFlags(0)
TextBox\SetColor(#PB_Gadget_BackColor, #Red)
TextBox\SetFont(FontID(0))
TextBox\Redraw()
Case #Button2
TextBox\Redraw(#False)
TextBox\SetIndex(20)
TextBox\SetFlags(#TEXT_Right)
TextBox\SetColor(#PB_Gadget_BackColor, #Yellow)
TextBox\SetFont(FontID(1))
TextBox\Redraw()
Case #Button3
TextBox\Redraw(#False)
TextBox\SetIndex(9990)
TextBox\SetFlags(#TEXT_Right | #TEXT_Bottom)
TextBox\SetColor(#PB_Gadget_BackColor, #Green)
TextBox\SetFont(#PB_Default)
TextBox\Redraw()
Case #Button4
TextBox\Redraw(#False)
TextBox\SetText(GetDataSectionText(?Text2))
TextBox\SetFlags(#TEXT_HCenter | #TEXT_VCenter)
TextBox\SetColor(#PB_Gadget_BackColor, #White)
TextBox\SetFont(#PB_Default)
TextBox\Redraw()
EndSelect
EndSelect
ForEver
TextBox\Release()
EndIf
EndProcedure : Main()
DataSection
Text2:
Data.s "PureBasic is a native 32-bit and 64-bit programming language based on established BASIC rules."
Data.s "The key features of PureBasic are portability (Windows, Linux And MacOS X are currently supported),"
Data.s "the production of very fast And highly optimized executables And, of course, the very simple BASIC syntax."
Data.s "PureBasic has been created For the beginner And expert alike."
Data.s "We have put a lot of effort into its realization To produce a fast, reliable system friendly language."
Data.s "In spite of its beginner-friendly syntax, the possibilities are endless With PureBasic's advanced "
Data.s "features such As pointers, structures, procedures, dynamically linked lists And much more."
Data.s "Experienced coders will have no problem gaining access To any of the legal OS structures"
Data.s "Or API objects And PureBasic even allows inline ASM."
Data.i 0
EndDataSection
CompilerEndIf