I made some more improvements on Windows. DrawText_() API applies some font kerning that PB's TextWidth() does not take into account, which was causing some visual bugs in highlighting and cursor position.
This update uses API for width calculations, so it matches perfectly.
Code: Select all
;- START OF MODULE
DeclareModule StringGadgetEx
; Flags
CompilerIf #PB_Compiler_Version >= 540
EnumerationBinary
#SGEx_BorderLess
#SGEx_ColoredBorder
#SGEx_Numeric
#SGEx_LowerCase
#SGEx_UpperCase
#SGEx_Password
EndEnumeration
CompilerElse
Enumeration
#SGEx_BorderLess = 1
#SGEx_ColoredBorder = 2
#SGEx_Numeric = 4
#SGEx_LowerCase = 8
#SGEx_UpperCase = 16
#SGEx_Password = 32
EndEnumeration
CompilerEndIf
; Buttons
Enumeration
#SGEx_Left_Button
#SGEx_Right_Button
EndEnumeration
; Events
CompilerIf #PB_Compiler_Version >= 540
EnumerationBinary
#SGEx_Event_ButtonClick
#SGEx_Event_RightClick
#SGEx_Event_Input
#SGEx_Event_Key
#SGEx_Event_Focus
#SGEx_Event_LostFocus
EndEnumeration
CompilerElse
Enumeration
#SGEx_Event_ButtonClick = 1
#SGEx_Event_RightClick = 2
#SGEx_Event_Input = 4
#SGEx_Event_Key = 8
#SGEx_Event_Focus = 16
#SGEx_Event_LostFocus = 32
EndEnumeration
CompilerEndIf
; Commands
Enumeration 1
#SGEx_Command_ClearSelection
#SGEx_Command_SetSelection
#SGEx_Command_DeleteSelection
#SGEx_Command_GetSelectionStart
#SGEx_Command_GetSelectionEnd
#SGEx_Command_SelectionLength
#SGEx_Command_Length
#SGEx_Command_Copy
#SGEx_Command_Cut
#SGEx_Command_Paste
#SGEx_Command_ActiveColor
#SGEx_Command_InActiveColor
#SGEx_Command_BorderSize
#SGEx_Command_BackColor
#SGEx_Command_FrontColor
#SGEx_Command_DefaultTextColor
#SGEx_Command_HilightColor
#SGEx_Command_AutoCompleteColor
#SGEx_Command_CursorColor
#SGEx_Command_CursorBlinkingTime
#SGEx_Command_Font
#SGEx_Command_GapX
#SGEx_Command_GapY
#SGEx_Command_UserData
EndEnumeration
Structure SGEx_EventHelper
Event.b
Gadget.i
Button.i
Input.s
key.i
EndStructure
;- Public
Declare SGEx_Create(Gadget, X, Y, Width, Height, Content$, DefaultString$ = #Null$, Flags.w = #Null)
Declare SGEx_Free(Gadget)
Declare SGEx_AddButton(Gadget, ButtonID, Image, Flag.b)
Declare SGEx_RemoveButton(Gadget, ButtonID)
Declare SGEx_SetText(Gadget, Text$)
Declare.s SGEx_GetText(Gadget, StartPos = #PB_Ignore, EndPos = #PB_Ignore)
Declare SGEx_InsertText(Gadget, Text$)
Declare SGEx_BindEvent(Gadget, *Callback, EventType = #PB_All)
Declare SGEx_UnbindEvent(Gadget, *Callback, EventType = #PB_All)
Declare SGEx_Resize(Gadget, X = #PB_Ignore, Y = #PB_Ignore, Width = #PB_Ignore, Height = #PB_Ignore)
Declare SGEx_Command(Gadget, Command, Param = #PB_Ignore, lParam = #PB_Ignore)
Declare SGEx_AddACText(Gadget, Text$, NoCase.b = #False, Seprator$ = " ")
Declare SGEx_RemoveACText(Gadget, Text$, Seprator$ = " ")
EndDeclareModule
Module StringGadgetEx
EnableExplicit
CompilerIf #PB_Compiler_Thread = #False
CompilerError "ThreadSafe option must be enabled in Compiler Option"
CompilerEndIf
CompilerIf Not Defined(White, #PB_Constant)
#White = $FFFFFF
CompilerEndIf
CompilerIf Not Defined(SGEx_UseDrawTextAPI, #PB_Constant)
#SGEx_UseDrawTextAPI = #True
CompilerEndIf
CompilerIf Not Defined(Black, #PB_Constant)
#Black = 0
CompilerEndIf
CompilerIf Not Defined(Blue, #PB_Constant)
#Blue = $FF0000
CompilerEndIf
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
#SGEx_Control_Key = #PB_Canvas_Command
CompilerElse
#SGEx_Control_Key = #PB_Canvas_Control
CompilerEndIf
CompilerIf #PB_Compiler_Unicode
#Password_Char$ = Chr($25CF)
CompilerElse
#Password_Char$ = "*"
CompilerEndIf
Enumeration #PB_EventType_FirstCustomValue
#SGEx_EventType_Blink
EndEnumeration
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows And Defined(AGF, #PB_Module)
#Use_Internal_Tab = #True
CompilerElse
#Use_Internal_Tab = #False
CompilerEndIf
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
#TabKey_While_Shift_Pressed = 65056
CompilerElseIf #PB_Compiler_OS = #PB_OS_MacOS
#TabKey_While_Shift_Pressed = 25
CompilerEndIf
Prototype Callback(*Event)
Structure Buttons_desc
Image.l
Button.l
Flag.b
EndStructure
Structure Callback_desc
*Callback
CEvents.b
EndStructure
Structure ACTexts_desc
Text.s
NoCase.b
EndStructure
Structure StringGadgetEx_desc
Gadget.l
*_Data
List Buttons.Buttons_desc()
LButtonsWidth.l
RButtonsWidth.l
List Callbacks.Callback_desc()
Event.SGEx_EventHelper
List ACTexts.ACTexts_desc()
ACColor.l
Flags.w
hasFocus.b
String.s
DefaultString.s
TextPos.i
hTread.i
BlinkingTime.w
Blink.b
GapX.b
GapY.b
CursorPosition.i
FixCursorPosition.i
CursorLength.i
Selected.b
TripleTime.i
Fontid.i
Border_Size.b
Back_Color.l
Front_Color.l
DefaultTextColor.l
HilightColor.l
CursorColor.l
Active_Color.l
InActive_Color.l
EndStructure
;- Internal Procedures
Procedure ContrastColor(iColor)
CompilerIf (#PB_Compiler_OS = #PB_OS_Windows)
If (iColor = GetSysColor_(#COLOR_HIGHLIGHT))
ProcedureReturn (GetSysColor_(#COLOR_HIGHLIGHTTEXT))
EndIf
CompilerEndIf
Protected luma.d
; Counting the perceptive luminance (aka luma) - human eye favors green color...
luma = (0.299 * Red(iColor) + 0.587 * Green(iColor) + 0.114 * Blue(iColor)) / 255
; Return black For bright colors, white For dark colors
If luma > 0.5
ProcedureReturn #Black
Else
ProcedureReturn #White
EndIf
EndProcedure
Procedure IsInRegion(x, y, width, height, xcur, ycur)
If xcur >= x And xcur <= x + width
If ycur >= y And ycur <= y + height
ProcedureReturn #True
EndIf
EndIf
EndProcedure
Procedure DispatchEvents(*buff.StringGadgetEx_desc, Event)
Protected Callback.Callback
With *buff
ForEach \Callbacks()
If \Callbacks()\CEvents & Event
Callback = \Callbacks()\Callback
\Event\Event = Event
Callback(\Event)
EndIf
Next
EndWith
EndProcedure
Procedure CalcButonsWidth(*buff.StringGadgetEx_desc, Left = #True)
Protected width
With *buff
ForEach \Buttons()
If Left
If \Buttons()\Flag = #SGEx_Left_Button
width + ImageWidth(\Buttons()\Image)
EndIf
Else
If \Buttons()\Flag = #SGEx_Right_Button
width + ImageWidth(\Buttons()\Image)
EndIf
EndIf
Next
EndWith
ProcedureReturn width
EndProcedure
Procedure CheckButtonClick(*buff.StringGadgetEx_desc)
Protected Button = -1, X, Y, LX, RX, TmpX
With *buff
X = GetGadgetAttribute(\Gadget, #PB_Canvas_MouseX)
Y = GetGadgetAttribute(\Gadget, #PB_Canvas_MouseY)
RX = GadgetWidth(\Gadget)
ForEach \Buttons()
If \Buttons()\Flag = #SGEx_Right_Button
RX - ImageWidth(\Buttons()\Image)
If IsInRegion(RX, 0, ImageWidth(\Buttons()\Image), ImageHeight(\Buttons()\Image), X, Y)
Button = \Buttons()\Button
Break
EndIf
Else
If IsInRegion(LX, 0, ImageWidth(\Buttons()\Image), ImageHeight(\Buttons()\Image), X, Y)
Button = \Buttons()\Button
Break
EndIf
LX + ImageWidth(\Buttons()\Image)
EndIf
Next
EndWith
ProcedureReturn Button
EndProcedure
Procedure ChangeMouseCursor(*buff.StringGadgetEx_desc)
Protected GapX, GapY, X, Y
With *buff
GapX = \GapX + \Border_Size + \LButtonsWidth
GapY = \Border_Size
If \GapY > -1
GapY + \GapY
EndIf
X = GetGadgetAttribute(\Gadget, #PB_Canvas_MouseX)
Y = GetGadgetAttribute(\Gadget, #PB_Canvas_MouseY)
If IsInRegion(GapX, GapY, GadgetWidth(\Gadget) - GapX - \RButtonsWidth - \Border_Size, GadgetHeight(\Gadget) - \Border_Size * 2, X, Y)
SetGadgetAttribute(\Gadget, #PB_Canvas_Cursor, #PB_Cursor_IBeam)
Else
SetGadgetAttribute(\Gadget, #PB_Canvas_Cursor, #PB_Cursor_Default)
EndIf
EndWith
EndProcedure
Procedure SetDrawingFont(FontID.i, hDC.i)
DrawingFont(FontID)
CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#SGEx_UseDrawTextAPI))
If ((FontID = #PB_Default) Or (FontID = #Null))
FontID = GetGadgetFont(#PB_Default)
EndIf
SelectObject_(hDC, FontID)
CompilerEndIf
EndProcedure
Procedure.i GetTextWidth(Text$, hDC)
CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#SGEx_UseDrawTextAPI))
Protected WinRect.RECT
With WinRect
\left = 0
\top = 0
EndWith
If (Text$)
DrawText_(hDC, Text$, -1, @WinRect, #DT_SINGLELINE | #DT_NOPREFIX | #DT_CALCRECT)
EndIf
ProcedureReturn (WinRect\right)
CompilerElse
ProcedureReturn (TextWidth(Text$))
CompilerEndIf
EndProcedure
Procedure.i GetTextHeight(Text$, hDC)
CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#SGEx_UseDrawTextAPI))
Protected WinRect.RECT
With WinRect
\left = 0
\top = 0
EndWith
If (Text$)
DrawText_(hDC, Text$, -1, @WinRect, #DT_SINGLELINE | #DT_NOPREFIX | #DT_CALCRECT)
EndIf
ProcedureReturn (WinRect\bottom)
CompilerElse
ProcedureReturn (TextHeight(Text$))
CompilerEndIf
EndProcedure
Procedure.i GetSubstringOffset(Text$, SubStart.i, hDC.i)
If (SubStart <= 1)
ProcedureReturn (0)
EndIf
ProcedureReturn (GetTextWidth(Text$, hDC) - GetTextWidth(Mid(Text$, SubStart), hDC))
EndProcedure
Procedure DrawingText(X, Y, Text$, FrontColor, BackColor, hDC, FontID)
CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#SGEx_UseDrawTextAPI))
Protected WinRect.RECT
With WinRect
\left = X
\top = Y
\right = OutputWidth()
\bottom = OutputHeight()
EndWith
SetTextColor_(hDC, FrontColor)
SetBkColor_(hDC, BackColor)
DrawText_(hDC, Text$, -1, @WinRect, #DT_SINGLELINE | #DT_NOPREFIX)
CompilerElse
DrawText(X, Y, Text$, FrontColor, BackColor)
CompilerEndIf
EndProcedure
Procedure UpdateStringGadgetEx(*buff.StringGadgetEx_desc, On = #PB_Ignore)
Protected index, color, String$, HilightString$, HilightPosition
Protected GapX, GapY, Area, LeftImgwidth, RightImgwidth, hDC
Protected NewList Buttons.Buttons_desc()
With *buff
If On = #True
\Blink = #True
ElseIf On = #False
\Blink = #False
Else
If \hasFocus
\Blink = #True - \Blink
EndIf
EndIf
hDC = StartDrawing(CanvasOutput(\Gadget))
Box(0, 0, OutputWidth(), OutputHeight(), \Back_Color)
If \Fontid
SetDrawingFont(\Fontid, hDC)
Else
SetDrawingFont(#PB_Default, hDC)
EndIf
GapX = \Border_Size + \GapX + \LButtonsWidth
If \GapY > -1
GapY = \GapY + \Border_Size
Else
GapY = Round((OutputHeight() - \Border_Size * 2 - GetTextHeight("A", hDC)) / 2, #PB_Round_Nearest)
EndIf
If \String
If \Flags & #SGEx_Password
For index = 1 To Len(\String)
String$ + #Password_Char$
Next
Else
String$ = \String
EndIf
Else
DrawingText(GapX, GapY, \DefaultString, \DefaultTextColor, \Back_Color, hDC, \Fontid)
EndIf
If \CursorPosition = 0
\TextPos = 0
Else
Area = OutputWidth() - GapX - \RButtonsWidth - \Border_Size - 2
If GetTextWidth(Left(String$, \CursorPosition), hDC) >= Area
If GetTextWidth(Left(String$, \CursorPosition), hDC) - Area > \TextPos
\TextPos = GetTextWidth(Left(String$, \CursorPosition), hDC) - Area
EndIf
EndIf
If GapX - \TextPos + GetTextWidth(Left(String$, \CursorPosition), hDC) < GapX
\TextPos - GetTextWidth(Mid(String$, \CursorPosition - 10, 10), hDC)
If \TextPos < 0
\TextPos = 0
EndIf
EndIf
EndIf
If ListIndex(\ACTexts()) = -1 Or \Flags & #SGEx_Password
If \CursorLength <> 0 And \hasFocus
If \CursorLength < 0
HilightString$ = Mid(String$, \FixCursorPosition + 1, Abs(\CursorLength))
HilightPosition = \FixCursorPosition + 1
Else
HilightString$ = Mid(String$, \CursorPosition + 1, \CursorLength)
HilightPosition = \CursorPosition + 1
EndIf
DrawingText(GapX - \TextPos, GapY, Left(String$, HilightPosition - 1), \Front_Color, \Back_Color, hDC, \Fontid)
DrawingText(GapX - \TextPos + GetSubstringOffset(String$, HilightPosition, hDC), GapY, HilightString$, ContrastColor(\HilightColor), \HilightColor, hDC, \Fontid)
DrawingText(GapX - \TextPos + GetSubstringOffset(String$, HilightPosition + Len(HilightString$), hDC), GapY, Mid(String$, HilightPosition + Len(HilightString$)), \Front_Color, \Back_Color, hDC, \Fontid)
Else
DrawingText(GapX - \TextPos, GapY, String$, \Front_Color, \Back_Color, hDC, \Fontid)
EndIf
Else
HilightString$ = Mid(\ACTexts()\Text, Len(String$) + 1)
DrawingText(GapX - \TextPos, GapY, String$, \Front_Color, \Back_Color, hDC, \Fontid)
DrawingText(GapX - \TextPos + GetTextWidth(String$, hDC), GapY, HilightString$, ContrastColor(\ACColor), \ACColor, hDC, \Fontid)
EndIf
If \Blink
Protected BlinkPos.i = GapX - \TextPos + GetSubstringOffset(String$, \CursorPosition + 1, hDC)
;If \CursorPosition = 0
; BlinkPos + 1
;ElseIf \CursorPosition = Len(\String)
; BlinkPos - 1
;EndIf
Line(BlinkPos, GapY, 1, GetTextHeight("A", hDC), \CursorColor)
EndIf
DrawingMode(#PB_2DDrawing_Default)
Box(\LButtonsWidth + \Border_Size, \Border_Size, \GapX, OutputHeight() - \Border_Size * 2, \Back_Color)
CopyList(\Buttons(), Buttons())
ForEach Buttons()
If Buttons()\Flag = #SGEx_Left_Button
DrawImage(ImageID(Buttons()\Image), LeftImgwidth + \Border_Size , \Border_Size)
LeftImgwidth + ImageWidth(Buttons()\Image)
Else
RightImgwidth + ImageWidth(Buttons()\Image)
DrawImage(ImageID(Buttons()\Image), OutputWidth() - \Border_Size - RightImgwidth, \Border_Size)
EndIf
Next
FreeList(Buttons())
If \Flags & #SGEx_ColoredBorder
If \hasFocus
color = \Active_Color
Else
color = \InActive_Color
EndIf
DrawingMode(#PB_2DDrawing_Outlined)
For index = 0 To \Border_Size - 1
Box(index, index, OutputWidth() - index * 2, OutputHeight() - index * 2, color)
Next
EndIf
StopDrawing()
EndWith
EndProcedure
Procedure CursorThread(*buff.StringGadgetEx_desc)
With *buff
Repeat
If \hasFocus
PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #SGEx_EventType_Blink)
EndIf
Delay(\BlinkingTime)
ForEver
EndWith
EndProcedure
Procedure GetMousePosition(gadget)
Protected CurentPosition, X, Y
Protected *buff.StringGadgetEx_desc
Protected Length, index, GapX, IsIn.b
Protected MinDistance.f = Infinity(), CursorPosition.i, Distance.f, CursorX.i
Protected String$
*buff = GetGadgetData(gadget)
With *buff
GapX = \Border_Size + \GapX + \LButtonsWidth
X = GetGadgetAttribute(Gadget, #PB_Canvas_MouseX)
IsIn = IsInRegion(GapX, 0, GadgetWidth(\Gadget) - \RButtonsWidth - \Border_Size - GapX, GadgetHeight(\Gadget), X, 0)
If (Not IsIn And \Selected) Or (IsIn And Not \Selected) Or (IsIn And \Selected)
If \Flags & #SGEx_Password
For index = 1 To Len(\String)
String$ + #Password_Char$
Next
Else
String$ = \String
EndIf
Length = Len(String$)
Protected hDC = StartDrawing(CanvasOutput(Gadget))
If \Fontid
SetDrawingFont(\Fontid, hDC)
Else
SetDrawingFont(#PB_Default, hDC)
EndIf
For Index = 0 To Length
CursorX = GapX + GetSubstringOffset(String$, Index+1, hDC) - \TextPos
Distance = (X-CursorX)*(X-CursorX)
If Distance < MinDistance
MinDistance = Distance
CursorPosition = Index
EndIf
Next
StopDrawing()
If Not IsInfinity(MinDistance)
ProcedureReturn CursorPosition
Else
ProcedureReturn -1
EndIf
Else
ProcedureReturn -1
EndIf
EndWith
EndProcedure
Procedure DeleteSelection(*buff.StringGadgetEx_desc)
With *buff
If \CursorLength < 0
\String = Left(\String, \FixCursorPosition) + Mid(\String, \CursorPosition + 1)
\CursorPosition = \FixCursorPosition
\CursorLength = 0
ProcedureReturn #True
ElseIf \CursorLength > 0
\String = Left(\String, \CursorPosition) + Mid(\String, \FixCursorPosition + 1)
\FixCursorPosition = \CursorPosition
\CursorLength = 0
ProcedureReturn #True
EndIf
EndWith
EndProcedure
Procedure SelectWord(*buff.StringGadgetEx_desc)
Protected GapX, GapY, X, Y, index, char.c
With *buff
GapX = \LButtonsWidth + \Border_Size + \GapX
GapY = \Border_Size
If \GapY > -1
GapY + \GapY
EndIf
X = GetGadgetAttribute(\Gadget, #PB_Canvas_MouseX)
Y = GetGadgetAttribute(\Gadget, #PB_Canvas_MouseY)
If IsInRegion(GapX, GapY, GadgetWidth(\Gadget) - \RButtonsWidth - \Border_Size - GapX, GadgetHeight(\Gadget) - GapY - \Border_Size, X, Y)
If \Flags & #SGEx_Password
\FixCursorPosition = 0
\CursorPosition = Len(\String)
\CursorLength = \FixCursorPosition - \CursorPosition
Else
char = Asc(Mid(\String, \CursorPosition + 1, 1))
If (char >= ' ' And char <= '/') Or (char >= ':' And char <= '@') Or (char >= '[' And char <= 96) Or (char >= '{' And char <= '~')
\FixCursorPosition = \CursorPosition
\CursorPosition + 1
\CursorLength = \FixCursorPosition - \CursorPosition
Else
For index = \CursorPosition To 0 Step -1
char = Asc(Mid(\String, index, 1))
If (char >= ' ' And char <= '/') Or (char >= ':' And char <= '@') Or (char >= '[' And char <= 96) Or (char >= '{' And char <= '~')
Break
EndIf
Next
If index = -1
\FixCursorPosition = 0
Else
\FixCursorPosition = index
EndIf
For index = \CursorPosition + 1 To Len(\String)
char = Asc(Mid(\String, index, 1))
If (char >= ' ' And char <= '/') Or (char >= ':' And char <= '@') Or (char >= '[' And char <= 96) Or (char >= '{' And char <= '~')
Break
EndIf
Next
\CursorPosition = index - 1
\CursorLength = \FixCursorPosition - \CursorPosition
If \CursorLength = 0
\CursorLength = -1
EndIf
EndIf
EndIf
ProcedureReturn #True
EndIf
EndWith
EndProcedure
Procedure CutClipboard(*buff.StringGadgetEx_desc)
Protected ClipboardText.s
With *buff
If \CursorLength <> 0
If \CursorLength < 0
ClipboardText = Mid(\String, \FixCursorPosition + 1, Abs(\CursorLength))
Else
ClipboardText = Mid(\String, \CursorPosition + 1, \CursorLength)
EndIf
SetClipboardText(ClipboardText)
DeleteSelection(*buff)
UpdateStringGadgetEx(*buff)
EndIf
EndWith
EndProcedure
Procedure CopyClipboard(*buff.StringGadgetEx_desc)
Protected ClipboardText.s
With *buff
If \CursorLength <> 0
If \CursorLength < 0
ClipboardText = Mid(\String, \FixCursorPosition + 1, Abs(\CursorLength))
Else
ClipboardText = Mid(\String, \CursorPosition + 1, \CursorLength)
EndIf
SetClipboardText(ClipboardText)
EndIf
EndWith
EndProcedure
Procedure PasteClipboard(*buff.StringGadgetEx_desc)
Protected ClipboardText.s, index, char.c
With *buff
ClipboardText = GetClipboardText()
If \Flags & #SGEx_LowerCase
ClipboardText = LCase(ClipboardText)
ElseIf \Flags & #SGEx_UpperCase
ClipboardText = UCase(ClipboardText)
ElseIf \Flags & #SGEx_Numeric
For index = 1 To Len(ClipboardText)
char = Asc(Mid(ClipboardText, index, 1))
If char <= '0' Or char >= '9'
ClipboardText = #Null$
Break
EndIf
Next
EndIf
If ClipboardText
DeleteSelection(*buff)
\String = Left(\String, \CursorPosition) + ClipboardText + Mid(\String, \CursorPosition + 1)
\CursorPosition + Len(ClipboardText)
UpdateStringGadgetEx(*buff)
EndIf
EndWith
EndProcedure
Procedure SelectACText(*buff.StringGadgetEx_desc, Text$)
Protected finded.b, ACText$, tmpText$
With *buff
ForEach \ACTexts()
ACText$ = Left(\ACTexts()\Text, Len(Text$))
; tmpText$ = Text$
; If \ACTexts()\NoCase
; ACText$ = LCase(ACText$)
; tmpText$ = LCase(tmpText$)
; EndIf
; If ACText$ = tmpText$
; finded = #True
; Break
; EndIf
If \ACTexts()\NoCase
If LCase(ACText$) = LCase(Text$)
finded = #True
Break
EndIf
Else
If ACText$ = Text$
finded = #True
Break
EndIf
EndIf
Next
If Not finded
ResetList(\ACTexts())
EndIf
EndWith
EndProcedure
Procedure FixACText(*buff.StringGadgetEx_desc)
With *buff
If ListIndex(\ACTexts()) <> -1
\String = \ACTexts()\Text
ResetList(\ACTexts())
EndIf
EndWith
EndProcedure
Procedure StringGadgetExCallback()
Protected *buff.StringGadgetEx_desc
Protected CursorPosition
Protected Update.b
*buff = GetGadgetData(EventGadget())
With *buff
Select EventType()
Case #SGEx_EventType_Blink
UpdateStringGadgetEx(*buff)
Case #PB_EventType_Focus
DispatchEvents(*buff, #SGEx_Event_Focus)
\hasFocus = #True
Update = #True
Case #PB_EventType_LostFocus
ResetList(\ACTexts())
\hasFocus = #False
DispatchEvents(*buff, #SGEx_Event_LostFocus)
UpdateStringGadgetEx(*buff, #False)
Case #PB_EventType_MouseEnter
ChangeMouseCursor(*buff)
Case #PB_EventType_LeftDoubleClick
If SelectWord(*buff)
Update = #True
EndIf
\TripleTime = ElapsedMilliseconds()
Case #PB_EventType_RightClick
If IsInRegion(\GapX + \Border_Size + \LButtonsWidth, \Border_Size, GadgetWidth(\Gadget) - \GapX - \Border_Size * 2 - \LButtonsWidth - \RButtonsWidth, GadgetHeight(\Gadget) - \Border_Size * 2, GetGadgetAttribute(\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(\Gadget, #PB_Canvas_MouseY))
DispatchEvents(*buff, #SGEx_Event_RightClick)
EndIf
Case #PB_EventType_LeftButtonDown
FixACText(*buff)
If \TripleTime
\TripleTime = ElapsedMilliseconds() - \TripleTime
If \TripleTime < 200
\FixCursorPosition = 0
\CursorPosition = Len(\String)
\CursorLength = -\CursorPosition
Update = #True
EndIf
\TripleTime = #Null
EndIf
CursorPosition = GetMousePosition(\Gadget)
If CursorPosition <> -1 And Not Update
\CursorPosition = CursorPosition
\FixCursorPosition = CursorPosition
\CursorLength = 0
\Selected = #True
Update = #True
EndIf
Case #PB_EventType_LeftButtonUp
If Not \Selected
\Event\Button = CheckButtonClick(*buff)
If \Event\Button <> -1
DispatchEvents(*buff, #SGEx_Event_ButtonClick)
EndIf
Else
\Selected = #False
EndIf
Case #PB_EventType_MouseMove
If \Selected
CursorPosition = GetMousePosition(\Gadget)
If CursorPosition <> -1 And \CursorPosition <> CursorPosition
\CursorPosition = CursorPosition
\CursorLength = \FixCursorPosition - CursorPosition
Update = #True
EndIf
EndIf
ChangeMouseCursor(*buff)
Case #PB_EventType_Input
If Not GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #SGEx_Control_Key
\Event\Input = Chr(GetGadgetAttribute(\Gadget, #PB_Canvas_Input))
If \Flags & #SGEx_Numeric
If Asc(\Event\Input) < '0' Or Asc(\Event\Input) > '9'
\Event\Input = #Null$
EndIf
Else
If \Flags & #SGEx_LowerCase
\Event\Input = LCase(\Event\Input)
ElseIf \Flags & #SGEx_UpperCase
\Event\Input = UCase(\Event\Input)
EndIf
EndIf
If \Event\Input
DeleteSelection(*buff)
\String = Left(\String, \CursorPosition) + \Event\Input + Mid(\String, \CursorPosition + 1)
\CursorPosition + 1
SelectACText(*buff, \String)
DispatchEvents(*buff, #SGEx_Event_Input)
Update = #True
EndIf
EndIf
Case #PB_EventType_KeyDown
\Event\key = GetGadgetAttribute(\Gadget, #PB_Canvas_Key)
Select \Event\key
Case #PB_Shortcut_A
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #SGEx_Control_Key
FixACText(*buff)
\FixCursorPosition = 0
\CursorPosition = Len(\String)
\CursorLength = -\CursorPosition
Update = #True
EndIf
Case #PB_Shortcut_X
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #SGEx_Control_Key And Not (\Flags & #SGEx_Password)
CutClipboard(*buff)
EndIf
Case #PB_Shortcut_C
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #SGEx_Control_Key And Not (\Flags & #SGEx_Password)
CopyClipboard(*buff)
EndIf
Case #PB_Shortcut_V
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #SGEx_Control_Key
PasteClipboard(*buff.StringGadgetEx_desc)
SelectACText(*buff, \String)
EndIf
Case #PB_Shortcut_Back
If ListIndex(\ACTexts()) = -1
Update = DeleteSelection(*buff)
If Not Update
If \CursorPosition > 0
\String = Left(\String, \CursorPosition - 1) + Mid(\String, \CursorPosition + 1)
\CursorPosition - 1
Update = #True
EndIf
EndIf
Else
ResetList(\ACTexts())
Update = #True
EndIf
Case #PB_Shortcut_Delete
If ListIndex(\ACTexts()) = -1
Update = DeleteSelection(*buff)
If Not Update
If \CursorPosition < Len(\String)
\String = Left(\String, \CursorPosition) + Mid(\String, \CursorPosition + 2)
Update = #True
EndIf
EndIf
Else
ResetList(\ACTexts())
Update = #True
EndIf
Case #PB_Shortcut_Left
FixACText(*buff)
If \CursorPosition > 0
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift
If \CursorLength = 0
\FixCursorPosition = \CursorPosition
EndIf
\CursorLength + 1
\CursorPosition - 1
Else
If \CursorLength < 0
\CursorPosition = \FixCursorPosition
ElseIf \CursorLength = 0
\CursorPosition - 1
EndIf
\CursorLength = 0
EndIf
Update = #True
ElseIf \CursorLength And Not (GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift)
\CursorLength = 0
Update = #True
EndIf
Case #PB_Shortcut_Right
FixACText(*buff)
If \CursorPosition < Len(\String)
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift
If \CursorLength = 0
\FixCursorPosition = \CursorPosition
EndIf
\CursorLength - 1
\CursorPosition + 1
Else
If \CursorLength > 0
\CursorPosition = \FixCursorPosition
ElseIf \CursorLength = 0
\CursorPosition + 1
EndIf
\CursorLength = 0
EndIf
Update = #True
ElseIf \CursorLength And Not (GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift)
\CursorLength = 0
Update = #True
EndIf
Case #PB_Shortcut_Home
FixACText(*buff)
\CursorLength = 0
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift
\FixCursorPosition = \CursorPosition
\CursorLength = \FixCursorPosition
EndIf
\CursorPosition = 0
Update = #True
Case #PB_Shortcut_End
FixACText(*buff)
\CursorLength = 0
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift
\FixCursorPosition = \CursorPosition
\CursorLength = \FixCursorPosition - Len(\String)
EndIf
\CursorPosition = Len(\String)
Update = #True
CompilerIf #Use_Internal_Tab
Case #PB_Shortcut_Tab
SetActiveGadget(AGF::GetNextGadget(\Gadget, WindowID(EventWindow())))
Case #TabKey_While_Shift_Pressed
If GetGadgetAttribute(\Gadget, #PB_Canvas_Modifiers) & #PB_Canvas_Shift
SetActiveGadget(AGF::GetPreviousGadget(\Gadget, WindowID(EventWindow())))
EndIf
CompilerEndIf
EndSelect
DispatchEvents(*buff, #SGEx_Event_Key)
EndSelect
If Update
UpdateStringGadgetEx(*buff, #True)
EndIf
EndWith
EndProcedure
;- External Procedures
Procedure SGEx_Create(Gadget, X, Y, Width, Height, Content$, DefaultString$ = #Null$, Flags.w = #Null)
Protected Result
Protected *buff.StringGadgetEx_desc
If Not (Flags & #SGEx_BorderLess) And Not (Flags & #SGEx_ColoredBorder)
Result = CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Border | #PB_Canvas_Keyboard)
Else
Result = CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard)
EndIf
If Result
If Gadget = #PB_Any
Gadget = Result
EndIf
*buff = AllocateMemory(SizeOf(StringGadgetEx_desc))
InitializeStructure(*buff, StringGadgetEx_desc)
SetGadgetData(Gadget, *buff)
With *buff
\Event\Gadget = Gadget
\Flags = Flags
\DefaultString = DefaultString$
\String = Content$
\Back_Color = #White
\Front_Color = #Black
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
\HilightColor = GetSysColor_(#COLOR_HIGHLIGHT)
CompilerElse
\HilightColor = $D77800
CompilerEndIf
\ACColor = \HilightColor
\CursorColor = #Black
\DefaultTextColor = $999999
\Gadget = Gadget
\BlinkingTime = 500 ; MiliSeconds
\GapX = 8
\GapY = -1
If Flags & #SGEx_ColoredBorder
\Border_Size = 1
\Active_Color = #Blue
\InActive_Color = #Black
EndIf
BindGadgetEvent(Gadget, @StringGadgetExCallback())
\hTread = CreateThread(@CursorThread(), *buff)
EndWith
UpdateStringGadgetEx(*buff)
EndIf
ProcedureReturn Result
EndProcedure
Procedure SGEx_Free(Gadget)
Protected *buff.StringGadgetEx_desc
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
With *buff
\hasFocus = #False
KillThread(\hTread)
EndWith
FreeGadget(Gadget)
ClearStructure(*buff, StringGadgetEx_desc)
ProcedureReturn #True
EndIf
EndProcedure
Procedure SGEx_Command(Gadget, Command, Param = #PB_Ignore, lParam = #PB_Ignore)
Protected *buff.StringGadgetEx_desc
Protected Update.b
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
With *buff
Select Command
Case #SGEx_Command_ClearSelection
\CursorLength = #Null
Update = #True
Case #SGEx_Command_SetSelection
If lParam < 0
lParam = Len(\String)
EndIf
If Param < 0
Param = 0
EndIf
If Param <= Len(\String) And lParam <= Len(\String) And Param <> lParam
\FixCursorPosition = Param
\CursorPosition = lParam
\CursorLength = \FixCursorPosition - \CursorPosition
If \hasFocus
Update = #True
EndIf
EndIf
Case #SGEx_Command_DeleteSelection
DeleteSelection(*buff)
Update = #True
Case #SGEx_Command_GetSelectionStart
If \CursorLength < 0
ProcedureReturn \FixCursorPosition
ElseIf \CursorLength > 0
ProcedureReturn \CursorPosition
EndIf
ProcedureReturn -1
Case #SGEx_Command_GetSelectionEnd
If \CursorLength < 0
ProcedureReturn \CursorPosition
ElseIf \CursorLength > 0
ProcedureReturn \FixCursorPosition
EndIf
ProcedureReturn -1
Case #SGEx_Command_SelectionLength
ProcedureReturn Abs(\CursorLength)
Case #SGEx_Command_Length
ProcedureReturn Len(\String)
Case #SGEx_Command_Copy
CopyClipboard(*buff)
Case #SGEx_Command_Cut
CutClipboard(*buff)
Case #SGEx_Command_Paste
PasteClipboard(*buff)
Case #SGEx_Command_ActiveColor
If Param >= 0
\Active_Color = Param
Update = #True
Else
ProcedureReturn \Active_Color
EndIf
Case #SGEx_Command_AutoCompleteColor
If Param >= 0
\ACColor = Param
Update = #True
Else
ProcedureReturn \ACColor
EndIf
Case #SGEx_Command_InActiveColor
If Param >= 0
\InActive_Color = Param
Update = #True
Else
ProcedureReturn \InActive_Color
EndIf
Case #SGEx_Command_BackColor
If Param >= 0
\Back_Color = Param
Update = #True
Else
ProcedureReturn \Back_Color
EndIf
Case #SGEx_Command_FrontColor
If Param >= 0
\Front_Color = Param
Update = #True
Else
ProcedureReturn \Front_Color
EndIf
Case #SGEx_Command_DefaultTextColor
If Param >= 0
\DefaultTextColor = Param
Update = #True
Else
ProcedureReturn \DefaultTextColor
EndIf
Case #SGEx_Command_CursorColor
If Param >= 0
\CursorColor = Param
Update = #True
Else
ProcedureReturn \CursorColor
EndIf
Case #SGEx_Command_BorderSize
If Param >= 0
If \Flags & #SGEx_ColoredBorder
\Border_Size = Param
EndIf
Update = #True
Else
ProcedureReturn \Border_Size
EndIf
Case #SGEx_Command_Font
If IsFont(Param)
\Fontid = FontID(Param)
Update = #True
EndIf
Case #SGEx_Command_HilightColor
If Param >= 0
\HilightColor = Param
Update = #True
Else
ProcedureReturn \HilightColor
EndIf
Case #SGEx_Command_GapX
If Param = #PB_Ignore
ProcedureReturn \GapX
Else
\GapX = Param
Update = #True
EndIf
Case #SGEx_Command_GapY
If Param = #PB_Ignore
ProcedureReturn \GapY
Else
\GapY = Param
Update = #True
EndIf
Case #SGEx_Command_UserData
If Param = #PB_Ignore
ProcedureReturn \_Data
Else
\_Data = Param
EndIf
Case #SGEx_Command_CursorBlinkingTime
If Param > 0
\BlinkingTime = Param
EndIf
EndSelect
If Update
UpdateStringGadgetEx(*buff)
EndIf
EndWith
EndIf
EndProcedure
Procedure SGEx_SetText(Gadget, Text$)
Protected *buff.StringGadgetEx_desc
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
*buff\String = Text$
*buff\CursorPosition = 0
*buff\CursorLength = 0
UpdateStringGadgetEx(*buff)
EndIf
EndProcedure
Procedure.s SGEx_GetText(Gadget, StartPos = #PB_Ignore, EndPos = #PB_Ignore)
Protected *buff.StringGadgetEx_desc
Protected String$
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
With *buff
If StartPos >= 0 And StartPos < EndPos
If EndPos < 0
EndPos = Len(\String)
EndIf
String$ = Mid(\String, StartPos + 1, EndPos - StartPos)
Else
String$ = \String
EndIf
EndWith
ProcedureReturn String$
EndIf
EndProcedure
Procedure SGEx_InsertText(Gadget, Text$)
Protected *buff.StringGadgetEx_desc
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas And Text$
*buff = GetGadgetData(Gadget)
DeleteSelection(*buff)
With *buff
\String = Left(\String, \CursorPosition) + Text$ + Mid(\String, \CursorPosition + 1)
\CursorPosition + Len(Text$)
EndWith
UpdateStringGadgetEx(*buff)
EndIf
EndProcedure
Procedure SGEx_AddButton(Gadget, ButtonID, Image, Flag.b)
Protected *buff.StringGadgetEx_desc
If IsImage(Image) And IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas And ButtonID >= 0
*buff = GetGadgetData(Gadget)
With *buff
AddElement(\Buttons())
\Buttons()\Button = ButtonID
\Buttons()\Flag = Flag
\Buttons()\Image = Image
If Flag = #SGEx_Left_Button
\LButtonsWidth = CalcButonsWidth(*buff)
Else
\RButtonsWidth = CalcButonsWidth(*buff, #False)
EndIf
UpdateStringGadgetEx(*buff)
EndWith
ProcedureReturn #True
EndIf
EndProcedure
Procedure SGEx_RemoveButton(Gadget, ButtonID)
Protected *buff.StringGadgetEx_desc
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
With *buff
ForEach \Buttons()
If \Buttons()\Button = ButtonID
If \Buttons()\Flag = #SGEx_Left_Button
\LButtonsWidth - ImageWidth(\Buttons()\Image)
Else
\RButtonsWidth - ImageWidth(\Buttons()\Image)
EndIf
DeleteElement(\Buttons())
Break
EndIf
Next
UpdateStringGadgetEx(*buff)
EndWith
EndIf
EndProcedure
Procedure SGEx_BindEvent(Gadget, *Callback, EventType = #PB_All)
Protected *buff.StringGadgetEx_desc
Protected finded.b
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas And *Callback
*buff = GetGadgetData(Gadget)
With *buff
If EventType = #PB_All
EventType = #SGEx_Event_ButtonClick | #SGEx_Event_Input | #SGEx_Event_Key
EventType | #SGEx_Event_Focus | #SGEx_Event_LostFocus | #SGEx_Event_RightClick
EndIf
ForEach \Callbacks()
If \Callbacks()\Callback = *Callback
\Callbacks()\CEvents | EventType
finded = #True
Break
EndIf
Next
If Not finded
AddElement(\Callbacks())
\Callbacks()\Callback = *Callback
\Callbacks()\CEvents = EventType
EndIf
EndWith
EndIf
EndProcedure
Procedure SGEx_UnbindEvent(Gadget, *Callback, EventType = #PB_All)
Protected *buff.StringGadgetEx_desc, finded.b
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas And *Callback
*buff = GetGadgetData(Gadget)
With *buff
If EventType = #PB_All
EventType = #SGEx_Event_ButtonClick | #SGEx_Event_Input | #SGEx_Event_Key
EventType | #SGEx_Event_Focus | #SGEx_Event_LostFocus | #SGEx_Event_RightClick
EndIf
ForEach \Callbacks()
If \Callbacks()\Callback = *Callback
\Callbacks()\CEvents ! EventType
finded = #True
Break
EndIf
Next
If finded And \Callbacks()\CEvents = #Null
DeleteElement(\Callbacks())
EndIf
EndWith
EndIf
EndProcedure
Procedure SGEx_Resize(Gadget, X = #PB_Ignore, Y = #PB_Ignore, Width = #PB_Ignore, Height = #PB_Ignore)
Protected *buff.StringGadgetEx_desc
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
ResizeGadget(Gadget, X, Y, Width, Height)
UpdateStringGadgetEx(*buff)
EndIf
EndProcedure
Procedure SGEx_AddACText(Gadget, Text$, NoCase.b = #False, Seprator$ = " ")
Protected *buff.StringGadgetEx_desc
Protected index, index2, field$
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
With *buff
If Not (\Flags & #SGEx_Password)
For index = 1 To CountString(Text$, Seprator$) + 1
field$ = StringField(Text$, index, Seprator$)
If \Flags & #SGEx_LowerCase
field$ = LCase(field$)
ElseIf \Flags & #SGEx_UpperCase
field$ = UCase(field$)
ElseIf \Flags & #SGEx_Numeric
For index2 = 1 To Len(field$)
If Asc(Mid(field$, index2, 1)) < '0' Or Asc(Mid(field$, index2, 1)) > '9'
field$ = #Null$
Break
EndIf
Next
EndIf
If field$
AddElement(\ACTexts())
\ACTexts()\Text = field$
\ACTexts()\NoCase = NoCase
EndIf
Next
SortStructuredList(\ACTexts(), #PB_Sort_Ascending, OffsetOf(ACTexts_desc\Text), TypeOf(ACTexts_desc\Text))
ResetList(\ACTexts())
EndIf
EndWith
EndIf
EndProcedure
Procedure SGEx_RemoveACText(Gadget, Text$, Seprator$ = " ")
Protected *buff.StringGadgetEx_desc
Protected index, reset.b
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*buff = GetGadgetData(Gadget)
With *buff
If Text$ = #Null$
ClearList(\ACTexts())
reset = #True
Else
ForEach \ACTexts()
For index = 1 To CountString(Text$, Seprator$) + 1
If \ACTexts()\Text = StringField(Text$, index, Seprator$)
DeleteElement(\ACTexts())
reset = #True
Break
EndIf
Next
Next
EndIf
If reset
ResetList(\ACTexts())
EndIf
EndWith
EndIf
EndProcedure
EndModule
;- END OF MODULE