First, the VB-like version, with fixed decimal point and currency symbol.
Current functionality:
- Supports fully validated keyboard entry
- Supports Set / GetGadgetText()
- Supports fully validated pasting
- Supports #PB_String_Borderless flag
- Supports SetGadgetFont, will place the decimal to fit the fontsize
// Todo: ResizeGadget(), Set /GetGadgetMask(), some cleanup stuff, your suggestions
Code: Select all
;=====================================================================
; Program: Currency String Gadget - Fanglized
; Author: netmaestro
; Date: February 15, 2007
; Target OS: Microsoft Windows All
; Target Compiler: PureBasic 4.xx
; License: Free, Unrestricted, credit appreciated
; but not required
;=====================================================================
;
ProcedureDLL.l IsSimpleNumber(String$)
If String$
*p.character = @String$
Repeat
char = *p\c
If (char >= '0' And char <= '9') Or char=0
*p+1
Else
ProcedureReturn 0
EndIf
Until char = 0
ProcedureReturn 1
EndIf
EndProcedure
Procedure RefuseKeyPress()
Shared currenthwnd
Protected GadgetNumber = GetDlgCtrlID_(currenthwnd)
content$ = GetGadgetText(GadgetNumber)
SendMessage_(currenthwnd, #EM_GETSEL, 0, @pos)
SendMessage_(currenthwnd, #EM_SETSEL, pos-1, pos)
SendMessage_(currenthwnd, #EM_REPLACESEL, 0, @"")
EndProcedure
Procedure SubClass(hwnd, msg, wparam, lparam)
Static tmpdollars.s = ""
Static tmppennies.s = ""
Static pennyback = 0
Static pennyarrow = 0
Static dollarforward = 0
Shared currenthwnd
currenthwnd = hwnd
Protected oldproc = GetProp_(hwnd, "oldproc")
Protected maxdigits = GetProp_(hwnd, "maxdigits")
Protected decimal = GetProp_(hwnd, "decimal")
Protected hiddenstring = GetProp_(hwnd, "hiddenstring")
Protected pennies = GetProp_(hwnd, "pennies")
Protected dollars = GetProp_(hwnd, "dollars")
Protected decimalg = GetProp_(hwnd, "decimalg")
Protected cont = GetProp_(hwnd, "cont")
Protected symbol = GetProp_(hwnd, "symbol")
result = CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
Select msg
Case #WM_COPY
SetClipboardText(GetGadgetText(dollars)+Chr(decimal)+GetGadgetText(pennies))
Case #WM_PASTE
Select hwnd
Case GadgetID(dollars)
txt.s = GetClipboardText()
If FindString(txt, Chr(decimal), 1)
dollarval.s = RemoveString(StringField(txt, 1, Chr(decimal)), Chr(32))
pennyval.s = RemoveString(StringField(txt, 2, Chr(decimal)), Chr(32))
If Len(dollarval) <= maxdigits And Len(pennyval) <= 2
pennyval = LSet(pennyval,2,"0")
If IsSimpleNumber(dollarval) And IsSimpleNumber(pennyval)
SetGadgetText(hiddenstring,dollarval+Chr(decimal)+LSet(pennyval,2,"0"))
Else
SetGadgetText(dollars, tmpdollars)
EndIf
Else
SetGadgetText(dollars, tmpdollars)
EndIf
Else
If Len(txt) <= maxdigits And IsSimpleNumber(txt)
SetGadgetText(hiddenstring,txt+Chr(decimal)+GetGadgetText(pennies))
Else
SetGadgetText(dollars, tmpdollars)
EndIf
EndIf
SendMessage_(GadgetID(dollars), #EM_SETSEL, Len(GetGadgetText(dollars)), Len(GetGadgetText(dollars)))
Case GadgetID(pennies)
txt.s = GetClipboardText()
If FindString(txt, Chr(decimal), 1)
dollarval.s = RemoveString(StringField(txt, 1, Chr(decimal)), Chr(32))
pennyval.s = RemoveString(StringField(txt, 2, Chr(decimal)), Chr(32))
If Len(dollarval) <= maxdigits And Len(pennyval) <= 2
pennyval = LSet(pennyval,2,"0")
If IsSimpleNumber(dollarval) And IsSimpleNumber(pennyval)
SetGadgetText(hiddenstring,dollarval+Chr(decimal)+LSet(pennyval,2,"0"))
Else
SetGadgetText(pennies, tmppennies)
EndIf
Else
SetGadgetText(pennies, tmppennies)
EndIf
Else
If Len(txt) <= 2 And IsSimpleNumber(txt)
SetGadgetText(hiddenstring,GetGadgetText(dollars)+Chr(decimal)+txt)
Else
SetGadgetText(pennies, tmppennies)
EndIf
EndIf
EndSelect
Case #WM_LBUTTONDOWN
Select GetActiveGadget()
Case dollars
If GadgetWidth(dollars) - lparam & $FF <= 4
dollarforward = #True
EndIf
Case pennies
If lparam & $FF <= 4
pennyarrow = #True
EndIf
EndSelect
Case #WM_SETFOCUS
If hwnd = GadgetID(hiddenstring)
SetActiveGadget(dollars)
EndIf
If hwnd = GadgetID(dollars)
If GetGadgetText(dollars)=""
dollarforward = #True
EndIf
tmpdollars = GetGadgetText(dollars)
SendMessage_(GadgetID(dollars), #EM_SETSEL, 0,0)
EndIf
If hwnd = GadgetID(pennies)
tmppennies = GetGadgetText(pennies)
SetWindowLong_(GadgetID(pennies), #GWL_STYLE, GetWindowLong_(GadgetID(pennies), #GWL_STYLE)| #WS_TABSTOP)
If GetGadgetText(pennies) <> ""
SendMessage_(GadgetID(pennies), #EM_SETSEL, 0, -1)
EndIf
EndIf
Case #WM_SETFONT
If hwnd = GadgetID(hiddenstring)
tmpimg = CreateImage(#PB_Any, 500,50)
StartDrawing(ImageOutput(tmpimg))
DrawingFont(wparam)
pennywidth = TextWidth("XX")
StopDrawing()
FreeImage(tmpimg)
ResizeGadget(symbol, 2,0, pennywidth/2, #PB_Ignore)
ResizeGadget(dollars, pennywidth/2, #PB_Ignore, GadgetWidth(cont)-pennywidth-pennywidth/2-10, #PB_Ignore)
ResizeGadget(decimalg, GadgetWidth(cont)-10-pennywidth, #PB_Ignore, #PB_Ignore, #PB_Ignore)
ResizeGadget(pennies, GadgetWidth(cont)-6-pennywidth, #PB_Ignore, pennywidth+10, #PB_Ignore)
SetGadgetFont(dollars, wparam)
SetGadgetFont(pennies, wparam)
SetGadgetFont(symbol, wparam)
EndIf
Case #WM_SETTEXT
If hwnd = GadgetID(hiddenstring)
txt.s = PeekS(lparam)
dollarval.s = StringField(txt, 1, Chr(decimal)) : If dollarval = "" : dollarval = "0" : EndIf
pennyval.s = LSet(StringField(txt, 2, Chr(decimal)), 2, "0")
If IsSimpleNumber(dollarval) And IsSimpleNumber(pennyval)
If Len(dollarval) <= maxdigits
SetGadgetText(dollars, dollarval)
SetGadgetText(pennies, pennyval)
If GetActiveGadget() = dollars
SendMessage_(GadgetID(dollars), #EM_SETSEL, 0,0)
EndIf
EndIf
EndIf
EndIf
Case #WM_KILLFOCUS
Select hwnd
Case GadgetID(dollars)
dollarforward=#False
If GetGadgetText(dollars) = ""
SetGadgetText(dollars, "0")
EndIf
If wparam <> GadgetID(pennies) ;
SetGadgetText(pennies, LSet(GetGadgetText(pennies), 2, "0"))
SetGadgetText(hiddenstring, GetGadgetText(dollars) + Chr(decimal) + LSet(GetGadgetText(pennies), 2, "0"))
EndIf
Case GadgetID(pennies)
pennyarrow=#False
SetWindowLong_(GadgetID(pennies), #GWL_STYLE, GetWindowLong_(GadgetID(pennies), #GWL_STYLE) &~ #WS_TABSTOP)
SetGadgetText(pennies, LSet(GetGadgetText(pennies), 2, "0"))
SetGadgetText(hiddenstring, GetGadgetText(dollars) + Chr(decimal) + LSet(GetGadgetText(pennies), 2, "0"))
EndSelect
Case #WM_KEYDOWN
Select hwnd
Case GadgetID(dollars)
If wparam = #VK_RIGHT
If GetGadgetText(dollars) = ""
dollarforward = #True
EndIf
SendMessage_(GadgetID(dollars), #EM_GETSEL, @starts, @ends)
If ends = Len(GetGadgetText(dollars))
If dollarforward
SetActiveGadget(pennies)
dollarforward=#False
pennyarrow=#True
SendMessage_(GadgetID(pennies),#EM_SETSEL,0,0)
Else
dollarforward = #True
EndIf
Else
dollarforward = #False
EndIf
EndIf
Case GadgetID(pennies)
If wparam = #VK_LEFT
If GetGadgetText(pennies) = ""
pennyarrow = #True
EndIf
SendMessage_(GadgetID(pennies), #EM_GETSEL, @starts, @ends)
If ends = 0
If pennyarrow
SetActiveGadget(dollars)
SendMessage_(GadgetID(dollars),#EM_SETSEL,Len(GetGadgetText(dollars)),Len(GetGadgetText(dollars)))
dollarforward = #True
pennyarrow=#False
Else
pennyarrow = #True
EndIf
Else
pennyarrow = #False
EndIf
Else
pennyarrow = #False
EndIf
EndSelect
Case #WM_CHAR
Select hwnd
Case GadgetID(dollars)
If Len( GetGadgetText(GetDlgCtrlID_(hwnd))) <= maxdigits
If (wparam < 48 Or wparam > 57) And wparam <> decimal
If wparam <> #VK_RETURN And wparam <> #VK_BACK And wparam <> #VK_ESCAPE
RefuseKeyPress()
EndIf
ElseIf wparam = decimal
RefuseKeyPress()
SetActiveGadget(pennies)
EndIf
Else
RefuseKeyPress()
If wparam = decimal
SetActiveGadget(pennies)
EndIf
EndIf
tmpdollars = GetGadgetText(dollars)
Case GadgetID(pennies)
If Len( GetGadgetText(pennies)) <= 2
If GetGadgetText(pennies) = ""
If pennyback
SetActiveGadget(dollars)
pennyback = #False
Else
pennyback = #True
EndIf
Else
pennyback = #False
EndIf
If (wparam < 48 Or wparam > 57)
If wparam <> #VK_RETURN And wparam <> #VK_BACK And wparam <> #VK_ESCAPE
RefuseKeyPress()
EndIf
EndIf
Else
RefuseKeyPress()
EndIf
tmppennies = GetGadgetText(pennies)
EndSelect
Case #WM_DESTROY
RemoveProp_(hwnd, "oldproc")
RemoveProp_(hwnd, "maxdigits")
RemoveProp_(hwnd, "hiddenstring")
RemoveProp_(hwnd, "decimal")
RemoveProp_(hwnd, "pennies")
RemoveProp_(hwnd, "dollars")
EndSelect
ProcedureReturn result
EndProcedure
ProcedureDLL CurrencyStringGadget(GadgetNumber, x, y, width, height, mask.s, flags)
Protected decimalchar, cont, symbol, dollars, pennies, oldproc
If Left(mask,1)<> "#"
currencysymbol = Asc(Left(mask,1))
Else
currencysymbol = 32
EndIf
If FindString(mask, ".",1)
decimalchar = '.'
ElseIf FindString(mask, ",",1)
decimalchar = ','
Else
ProcedureReturn -1
EndIf
If Right(mask, 3) <> Chr(decimalchar) + "##"
ProcedureReturn -1
EndIf
numberofdigits = CountString(mask, "#") - 2
Protected hiddenstring
If GadgetNumber = #PB_Any
hiddenstring = StringGadget(GadgetNumber, x, y, width, height, "")
Else
StringGadget(GadgetNumber, 0, 0, 0, 0, "")
hiddenstring = GadgetNumber
EndIf
HideGadget(hiddenstring, 1)
If flags
cont= ContainerGadget(#PB_Any, x, y, width-4, height-4, #PB_Container_BorderLess)
Else
cont= ContainerGadget(#PB_Any, x, y, width, height, #PB_Container_Double)
EndIf
symbol = TextGadget(#PB_Any, 2, 0 ,10, height-2, Chr(CurrencySymbol),#SS_CENTERIMAGE)
decimalg = TextGadget(#PB_Any, GadgetWidth(cont)-24, 0 ,4, height-2, Chr(DecimalChar),#SS_CENTERIMAGE)
SetGadgetFont(decimalg,GetStockObject_(#SYSTEM_FONT))
SetGadgetColor(cont, #PB_Gadget_BackColor, #White)
SetGadgetColor(symbol, #PB_Gadget_BackColor, #White)
SetGadgetColor(decimalg, #PB_Gadget_BackColor, #White)
dollars = StringGadget(#PB_Any, 12,2,GadgetX(decimalg)-13,height-2,"",#PB_String_BorderLess|#ES_RIGHT)
pennies = StringGadget(#PB_Any, GadgetWidth(cont)-19, 2,18,height-2,"",#PB_String_BorderLess)
CloseGadgetList()
SetWindowLong_(GadgetID(pennies), #GWL_STYLE, GetWindowLong_(GadgetID(pennies), #GWL_STYLE) &~ #WS_TABSTOP)
oldproc = SetWindowLong_(GadgetID(dollars), #GWL_WNDPROC, @SubClass())
oldproc = SetWindowLong_(GadgetID(pennies), #GWL_WNDPROC, @SubClass())
oldproc = SetWindowLong_(GadgetID(hiddenstring), #GWL_WNDPROC, @SubClass())
SetProp_(GadgetID(hiddenstring), "oldproc", oldproc)
SetProp_(GadgetID(hiddenstring), "pennies", pennies)
SetProp_(GadgetID(hiddenstring), "dollars", dollars)
SetProp_(GadgetID(hiddenstring), "maxdigits", NumberOfDigits)
SetProp_(GadgetID(hiddenstring), "hiddenstring", hiddenstring)
SetProp_(GadgetID(hiddenstring), "decimal", DecimalChar)
SetProp_(GadgetID(hiddenstring), "decimalg", decimalg)
SetProp_(GadgetID(hiddenstring), "cont", cont)
SetProp_(GadgetID(hiddenstring), "symbol", symbol)
SetProp_(GadgetID(pennies), "oldproc", oldproc)
SetProp_(GadgetID(pennies), "pennies", pennies)
SetProp_(GadgetID(pennies), "dollars", dollars)
SetProp_(GadgetID(pennies), "maxdigits", NumberOfDigits)
SetProp_(GadgetID(pennies), "hiddenstring", hiddenstring)
SetProp_(GadgetID(pennies), "decimal", DecimalChar)
SetProp_(GadgetID(dollars), "oldproc", oldproc)
SetProp_(GadgetID(dollars), "pennies", pennies)
SetProp_(GadgetID(dollars), "dollars", dollars)
SetProp_(GadgetID(dollars), "maxdigits", NumberOfDigits)
SetProp_(GadgetID(dollars), "hiddenstring", hiddenstring)
SetProp_(GadgetID(dollars), "decimal", DecimalChar)
ProcedureReturn hiddenstring
EndProcedure
; Little test program
OpenWindow(0,0,0,320,240,"",$CF0001)
CreateGadgetList(WindowID(0))
mymoney = CurrencyStringGadget(#PB_Any, 20,20, 100, 20, "$####.##", #PB_String_BorderLess)
CurrencyStringGadget(0, 20,50,100,30,"$###.##", 0) ; another string to test the killfocus stuff with
SetActiveGadget(mymoney)
SetGadgetText(mymoney, "123.45")
SetGadgetFont(0, LoadFont(0,"Courier New", 18))
Repeat
EventID = WaitWindowEvent()
Until EventID = #WM_CLOSE
Code: Select all
;========================================================================
; Program: Currency StringGadget
; Author: Lloyd Gallant (netmaestro)
; Date: February 8, 2007
; Target OS: Microsoft Windows All
; Target Compiler: PureBasic 4.xx
;
; License: Free, Unrestricted, credit appreciated
; but not required
;
; TailBite: The only obstacle to compiling this code
; is the optional parameters. Change those to
; mandatory or use the TailBite protocol
; and it should TailBite up without difficulty
;========================================================================
Procedure RefuseKeyPress(hwnd)
Protected GadgetNumber = GetDlgCtrlID_(hwnd)
content$ = GetGadgetText(GadgetNumber)
SendMessage_(hwnd, #EM_GETSEL, 0, @pos)
SetGadgetText(GadgetNumber, Left(content$,Len(content$)-1))
SendMessage_(hwnd, #EM_SETSEL, pos-1, pos-1)
EndProcedure
Procedure SubClass_String(hwnd, Message, wParam, lParam)
Protected result, Decimal_loc, content$
Protected OldStringProc = GetProp_(hwnd, "OldStringProc")
Protected Decimal = GetProp_(hwnd, "Decimal")
Protected MaxChars = GetProp_(hwnd, "MaxChars")
result = CallWindowProc_(OldStringProc, hwnd, Message, wParam, lParam)
Select Message
Case #WM_KILLFOCUS
content$ = Trim(GetGadgetText(GetDlgCtrlID_(hwnd)))
Decimal_loc = FindString(content$,Chr(decimal),1)
If Decimal_loc
If Decimal_loc = 1
content$ = "0" + content$
EndIf
While Len(content$) - FindString(content$,Chr(decimal),1) < 2
content$+"0"
SetGadgetText(GetDlgCtrlID_(hwnd), content$)
Wend
Else
If content$ <> ""
content$ + Chr(decimal) + "00"
SetGadgetText(GetDlgCtrlID_(hwnd), content$)
EndIf
EndIf
Case #WM_CHAR
result=0
Select wparam
Case decimal, 48 To 57
content$ = GetGadgetText(GetDlgCtrlID_(hwnd))
If FindString(content$, Chr(decimal), 1) = 0
If Len(content$) > MaxChars
If wparam <> decimal ; Refuse all other chars except decimal if MaxChars is reached
RefuseKeyPress(hwnd)
EndIf
EndIf
EndIf
If wparam = decimal
If CountString(content$, Chr(decimal)) > 1 ; Test for more than one decimal
RefuseKeyPress(hwnd)
EndIf
EndIf
If FindString(content$,Chr(decimal),1)
If Len(content$)-FindString(content$,Chr(decimal),1)>2 ; No more than 2 chars past decimal
RefuseKeyPress(hwnd)
EndIf
EndIf
Default
If wparam <> 8 And wparam <> 13 And wparam <> 27 ; Back, Esc and Enter are not errors
RefuseKeyPress(hwnd)
EndIf
EndSelect
Case #WM_DESTROY
RemoveProp_(hwnd, "OldStringProc")
RemoveProp_(hwnd, "Decimal")
RemoveProp_(hwnd, "MaxChars")
SetWindowLong_(hwnd, #GWL_WNDPROC, OldStringProc)
EndSelect
ProcedureReturn result
EndProcedure
ProcedureDLL CurrencyStringGadget(GadgetNumber, x, y, Width, Height, DefaultText$, Flags, MaxChars=11, Decimal=46)
Shared oldstringproc
result = StringGadget(GadgetNumber, x, y, Width, Height, DefaultText$, Flags)
If GadgetNumber = #PB_Any
GadID = GadgetID(result)
Else
GadID = result
EndIf
OldStringProc = SetWindowLong_(GadID, #GWL_WNDPROC, @SubClass_String())
SetProp_(GadID, "OldStringProc", OldStringProc)
SetProp_(GadID, "Decimal", Decimal)
SetProp_(GadID, "MaxChars", MaxChars)
ProcedureReturn result
EndProcedure
Code: Select all
OpenWindow(0,0,0,320,240,"",$CF0001)
CreateGadgetList(WindowID(0))
CurrencyStringGadget(0, 100, 100, 100, 20, "", 0, 2) ; Maximum two digits before the decimal place
CurrencyStringGadget(1, 100, 140, 100, 20, "", 0, 11, ',') ; Max 11 digits before decimal place, comma is decimal char
SetActiveGadget(0)
Repeat:Until WaitWindowEvent()=#WM_CLOSE
:roll: 
