Module NumGadget
Update v1.10.0
- Optimized
Code: Select all
;-TOP
; Comment : Module Simple NumGadget
; Author : mk-soft
; Version : v1.10.0
; Update : 06.01.2020
DeclareModule MyGadget
Declare NumGadget(Gadget, x, y, Width, Height, Number.s, Point.s = ".", Sufix.s = "")
Declare FreeNumGadget(Gadget)
Declare SetNumGadget(Gadget, Number.s)
Declare.s GetNumGadget(Gadget)
Declare SetNumGadgetFont(Gadget, FontID)
Declare GetNumGadgetFont(Gadget)
Declare SetNumGadgetColor(Gadget, ColorType, Color)
Declare GetNumGadgetColor(Gadget, ColorType)
EndDeclareModule
Module MyGadget
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
#PB_Shortcut_Enter = 13
CompilerCase #PB_OS_Linux
#PB_Shortcut_Enter = 65421
CompilerCase #PB_OS_MacOS
#PB_Shortcut_Enter = 3
CompilerEndSelect
Structure udtNumGadgetData
Gadget.i
x.i
y.i
Width.i
Height.i
Number.s
Point.s
Sufix.s
FrontColor.i
BackColor.i
LineColor.i
FontID.i
IsFocus.i
IsEdit.i
Edit.s
EndStructure
Global NewMap NumGadgetData.udtNumGadgetData()
; ----
Procedure DrawNumGadget(*this.udtNumGadgetData)
Protected text.s, text_width.i, text_height
With *this
If StartDrawing(CanvasOutput(\Gadget))
If \FontID
DrawingFont(\FontID)
EndIf
Box(0, 0, \Width, \Height, \BackColor)
If \IsFocus
Box(0, 0, \Width, \Height, \LineColor)
Box(2, 2, \Width - 4, \Height- 4, \BackColor)
Else
Box(0, 0, \Width, \Height, #Gray)
Box(1, 1, \Width - 2, \Height- 2, \BackColor)
EndIf
If \IsEdit
text = \Edit + "_"
Else
text = \Number
EndIf
text + \Sufix
DrawingMode(#PB_2DDrawing_Default)
text_width = TextWidth(text)
text_height = TextHeight(text)
DrawText(\Width - text_width - 4, \Height / 2 - text_height / 2, text, \FrontColor, \BackColor)
StopDrawing()
EndIf
EndWith
EndProcedure
Procedure DoNumGadgetEvent()
Protected *this.udtNumGadgetData = GetGadgetData(EventGadget())
Protected key.i, len
With *this
If *this
Select EventType()
Case #PB_EventType_Focus
\IsFocus = #True
DrawNumGadget(*this)
Case #PB_EventType_LostFocus
\IsFocus = #False
If \IsEdit
\IsEdit = #False
\Number = \Edit
PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_Change)
EndIf
DrawNumGadget(*this)
Case #PB_EventType_Input
key = GetGadgetAttribute(\Gadget, #PB_Canvas_Input)
Select key
Case '-' , '+'
If Not \IsEdit
\Edit = Chr(key)
\IsEdit = #True
DrawNumGadget(*this)
ElseIf \IsEdit And Len(\Edit) = 0
\Edit = Chr(key)
DrawNumGadget(*this)
EndIf
Case '0' To '9'
If Not \IsEdit
\Edit = Chr(key)
\IsEdit = #True
DrawNumGadget(*this)
Else
\Edit + Chr(key)
DrawNumGadget(*this)
EndIf
Case '.', ','
If \IsEdit And Not FindString(\Edit, \Point)
\Edit + \Point
DrawNumGadget(*this)
EndIf
EndSelect
Case #PB_EventType_KeyDown
key = GetGadgetAttribute(\Gadget, #PB_Canvas_Key)
Select key
Case #PB_Shortcut_Right, #PB_Shortcut_Left
If Not \IsEdit
\Edit = \Number
\IsEdit = #True
DrawNumGadget(*this)
EndIf
Case #PB_Shortcut_Back
If Not \IsEdit
\Edit = \Number
\IsEdit = #True
EndIf
len = Len(\Edit)
If len
\Edit = Left(\Edit, len - 1)
DrawNumGadget(*this)
EndIf
Case #PB_Shortcut_Tab, #PB_Shortcut_Return, #PB_Shortcut_Enter
If \IsEdit
\IsEdit = #False
\Number = \Edit
DrawNumGadget(*this)
PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_Change)
EndIf
PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_ReturnKey)
Case #PB_Shortcut_Escape
If \IsEdit
\IsEdit = #False
DrawNumGadget(*this)
EndIf
EndSelect
Case #PB_EventType_Resize
\x = GadgetX(\Gadget)
\y = GadgetY(\Gadget)
\Width = GadgetWidth(\Gadget)
\Height = GadgetHeight(\Gadget)
DrawNumGadget(*this)
EndSelect
EndIf
EndWith
EndProcedure
;-- Public
Procedure SetNumGadget(Gadget, Number.s)
If FindMapElement(NumGadgetData(), Str(Gadget))
NumGadgetData()\Number = Number
DrawNumGadget(@NumGadgetData())
EndIf
EndProcedure
Procedure.s GetNumGadget(Gadget)
If FindMapElement(NumGadgetData(), Str(Gadget))
ProcedureReturn NumGadgetData()\Number
Else
ProcedureReturn ""
EndIf
EndProcedure
; ----
Procedure SetNumGadgetFont(Gadget, FontID)
If FindMapElement(NumGadgetData(), Str(Gadget))
NumGadgetData()\FontID = FontID
DrawNumGadget(@NumGadgetData())
EndIf
EndProcedure
Procedure GetNumGadgetFont(Gadget)
If FindMapElement(NumGadgetData(), Str(Gadget))
ProcedureReturn NumGadgetData()\FontID
Else
ProcedureReturn 0
EndIf
EndProcedure
; ----
Procedure SetNumGadgetColor(Gadget, ColorType, Color)
If FindMapElement(NumGadgetData(), Str(Gadget))
Select ColorType
Case #PB_Gadget_FrontColor
NumGadgetData()\FrontColor = Color
Case #PB_Gadget_BackColor
NumGadgetData()\BackColor = Color
Case #PB_Gadget_LineColor
NumGadgetData()\LineColor = Color
EndSelect
DrawNumGadget(@NumGadgetData())
EndIf
EndProcedure
Procedure GetNumGadgetColor(Gadget, ColorType)
If FindMapElement(NumGadgetData(), Str(Gadget))
Select ColorType
Case #PB_Gadget_FrontColor
ProcedureReturn NumGadgetData()\FrontColor
Case #PB_Gadget_BackColor
ProcedureReturn NumGadgetData()\BackColor
Case #PB_Gadget_LineColor
ProcedureReturn NumGadgetData()\LineColor
EndSelect
EndIf
EndProcedure
; ----
Procedure NumGadget(Gadget, x, y, Width, Height, Number.s, Point.s = ".", Sufix.s = "")
Protected id, key.s, *this.udtNumGadgetData
id = CanvasGadget(Gadget, x, y, Width, Height, #PB_Canvas_Keyboard)
If Not id
ProcedureReturn 0
EndIf
If Gadget = #PB_Any
Gadget = id
EndIf
key = Str(Gadget)
If Not FindMapElement(NumGadgetData(), key)
AddMapElement(NumGadgetData(), key)
EndIf
*this = @NumGadgetData()
With *this
\Gadget = Gadget
\x = x
\y = y
\Width = Width
\Height = Height
\Number = Number
\Point = Point
\Sufix = Sufix
\FrontColor = #Blue
\BackColor = #White
\LineColor = #Blue
\FontID = 0
\IsEdit = #False
SetGadgetData(Gadget, *this)
DrawNumGadget(*this)
BindGadgetEvent(Gadget, @DoNumGadgetEvent())
EndWith
ProcedureReturn id
EndProcedure
Procedure FreeNumGadget(Gadget)
If FindMapElement(NumGadgetData(), Str(Gadget))
UnbindGadgetEvent(Gadget, @DoNumGadgetEvent())
DeleteMapElement(NumGadgetData())
FreeGadget(Gadget)
EndIf
EndProcedure
EndModule
; ****
CompilerIf #PB_Compiler_IsMainFile
LoadFont(0, "Courier New", 14, #PB_Font_Italic)
Procedure Main()
If OpenWindow(0, 100, 100, 300, 200, "MyGadget", #PB_Window_SystemMenu)
MyGadget::NumGadget(0, 10, 10, 280, 30, "", ",", " €")
MyGadget::SetNumGadget(0, "10,5")
MyGadget::SetNumGadgetColor(0, #PB_Gadget_LineColor, #Red)
MyGadget::SetNumGadgetFont(0, FontID(0))
MyGadget::NumGadget(1, 10, 50, 280, 30, "", ".", " kg")
MyGadget::SetNumGadget(1, "0.3")
MyGadget::SetNumGadgetColor(1, #PB_Gadget_BackColor, #Green)
MyGadget::NumGadget(2, 10, 90, 280, 30, "", "", " km/h")
MyGadget::SetNumGadget(2, "120")
MyGadget::SetNumGadgetColor(2, #PB_Gadget_FrontColor, #Red)
MyGadget::SetNumGadgetColor(2, #PB_Gadget_BackColor, #Yellow)
SetActiveGadget(0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 0
If EventType() = #PB_EventType_Change
Debug "NumGadget 0 = " + MyGadget::GetNumGadget(0)
EndIf
If EventType() = #PB_EventType_ReturnKey
SetActiveGadget(1)
EndIf
Case 1
If EventType() = #PB_EventType_Change
Debug "NumGadget 1 = " + MyGadget::GetNumGadget(1)
EndIf
If EventType() = #PB_EventType_ReturnKey
SetActiveGadget(2)
EndIf
Case 2
If EventType() = #PB_EventType_Change
Debug "NumGadget 2 = " + MyGadget::GetNumGadget(2)
EndIf
If EventType() = #PB_EventType_ReturnKey
SetActiveGadget(0)
EndIf
EndSelect
EndSelect
ForEver
EndIf
EndProcedure : Main()
CompilerEndIf
