MaskedEdit in StringGadgets

Windows specific forum
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

..

Post by NoahPhense »

Sparkie wrote:Maybe you can play with this to suit your needs...
That's what 'she' said.. ;)

- np
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:

Post by TerryHough »

@Sparkie
Sparkie wrote:Maybe you can play with this to suit your needs...
Yeah, thanks! I think that will get me moving towards what I need. a few tweaks... prevent certain characters from being entered twice, like the decimal point, etc.... should work fine.

Terry
fweil
Enthusiast
Enthusiast
Posts: 725
Joined: Thu Apr 22, 2004 5:56 pm
Location: France
Contact:

Post by fweil »

I did this as a small decimal / hexadecimal / binary training tool ...

It shows how to manage string gadgets with a given list of allowed characters. It does not test consistancy but just if any entered characters belong to the list passed to the procedure.

Maybe this will help for embedding numeric formats in string gadgets.

Rgrds

Code: Select all

Enumeration
  #Window_Main
  #StatusBar
  #Gadget_String_Decimal
  #Gadget_String_Hexadecimal
  #Gadget_String_Binary
  #Gadget_Frame3D_1
  #Gadget_Frame3D_2
  #Gadget_Frame3D_3
EndEnumeration

;
; La structure OneByte est utilisée comme intermédiaire de pointage de la chaine argument des fonctions.
; Ce système d'adressage est plus rapide et efficace qu'une analyse par caractère dans une chaine.
;

Structure OneByte
  a.b
EndStructure

;
; IsValid prend la chaine d'un gadget et vérifie que tous les caractères de cette chaine appartiennent à la liste de caractères autorisés dans Mask
;
Procedure IsValid(Gadget.l, Mask.s, Warning.s, Text.s)
  IsValid = #TRUE
  For i = 1 To Len(GetGadgetText(Gadget))
    If FindString(Mask, Mid(GetGadgetText(Gadget), i, 1), 1)
      Else
        IsValid = #FALSE
        SetGadgetText(Gadget, ReplaceString(GetGadgetText(Gadget), Mid(GetGadgetText(Gadget), i, 1), ""))
    EndIf
  Next
  If IsValid = #FALSE
      String.s = Text + ReplaceString(Mask, Chr(27), "")
      Singles.s = ""
      For i = 1 To Len(Mask)
        If Mid(Mask, i, 1) = Chr(27)
            Singles = Singles + Mid(Mask, i + 1, 1)
        EndIf
      Next
      If Singles <> ""
          String = String + " (" + Singles + ")"
      EndIf
      MessageRequester(Warning, String, #PB_MessageRequester_OK)
  EndIf
EndProcedure

;
; Conversion d'une chaine de caractères binaire en valeur décimale stockée dans un entier long
;
Procedure.l Bin2Dec(BinaryStringNumber.s)
  *t.OneByte = @BinaryStringNumber
  Result.l = 0
  While *t\a <> 0
    Result = (Result << 1) + (*t\a - 48)
    *t + 1
  Wend
  ProcedureReturn Result
EndProcedure

;
; Conversion d'une chaine de caractères héxadécimale en valeur décimale stockée dans un entier long
;
Procedure.l Hex2Dec(HexNumber.s)
  *t.OneByte = @HexNumber
  Result.l = 0
  While *t\a <> 0
    If *t\a >= '0' And *t\a <= '9'
        Result = (Result << 4) + (*t\a - 48)
      ElseIf *t\a >= 'A' And *t\a <= 'F'
        Result = (Result << 4) + (*t\a - 55)
      ElseIf *t\a >= 'a' And *t\a <= 'f'
        Result = (Result << 4) + (*t\a - 87)
      Else
        Result = (Result << 4) + (*t\a - 55)
    EndIf
    *t + 1
  Wend
  ProcedureReturn Result
EndProcedure

;
; Conversion d'une chaine de caractères décimale en valeur héxadécimale stockée dans une chaine
;
Procedure.s Dec2HexString(DecimalString.s)
  ProcedureReturn Hex(Val(DecimalString))
EndProcedure

;
; Conversion d'une chaine de caractères décimale en valeur binaire stockée dans une chaine
;
Procedure.s Dec2BinString(DecimalString.s)
  ProcedureReturn Bin(Val(DecimalString))
EndProcedure

;
; Conversion d'une chaine de caractères héxadécimale en valeur décimale stockée dans une chaine
;
Procedure.s Hex2DecString(HexadecimalString.s)
  ProcedureReturn Str(Hex2Dec(HexadecimalString))
EndProcedure

;
; Conversion d'une chaine de caractères héxadécimale en valeur binaire stockée dans une chaine
;
Procedure.s Hex2BinString(HexadecimalString.s)
  ProcedureReturn Bin(Hex2Dec(HexadecimalString))
EndProcedure

;
; Conversion d'une chaine de caractères binaire en valeur décimale stockée dans une chaine
;
Procedure.s Bin2DecString(BinaryString.s)
  ProcedureReturn Str(Bin2Dec(BinaryString))
EndProcedure

;
; Conversion d'une chaine de caractères binaire en valeur héxadécimale stockée dans une chaine
;
Procedure.s Bin2HexString(BinaryString.s)
  ProcedureReturn Hex(Bin2Dec(BinaryString))
EndProcedure

;
; Programme principal
;
  Select GetUserDefaultLangID_()
    Case 1036
      Restore French
    Default
      Restore English
  EndSelect
  Read WindowTitle.s
  Read Warning.s
  Read TextDecimal.s
  Read TextHexadecimal.s
  Read TextBinary.s
  Read Decimal.s
  Read Hexadecimal.s
  Read Binary.s
  
  WindowXSize = 480
  WindowYSize = 260
  Quit = #FALSE
  OldGadgetText_Decimal.s
  OldGadgetText_Hexadecimal.s
  OldGadgetText_Binary.s
  If OpenWindow(#Window_Main, 0, 0, WIndowXSize, WindowYSize, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered, WindowTitle)
      AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
      AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Return, #PB_Shortcut_Return)
      AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Up, #PB_Shortcut_Up)
      AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Down, #PB_Shortcut_Down)
      If CreateGadgetList(WindowID())
          SetGadgetFont(#PB_Default, LoadFont(22, "Verdana", 8, #PB_Font_Bold | #PB_Font_HighQuality))
          Frame3DGadget(#Gadget_Frame3D_1, 5, 10, WindowXSize - 10, 70, Decimal)
          Frame3DGadget(#Gadget_Frame3D_2, 5, 90, WindowXSize - 10, 70, Hexadecimal)
          Frame3DGadget(#Gadget_Frame3D_3, 5, 170, WindowXSize - 10, 70, Binary)
          SetGadgetFont(#PB_Default, LoadFont(23, "Verdana", 14, #PB_Font_Bold | #PB_Font_HighQuality))
          hStringGadget_Decimal = StringGadget(#Gadget_String_Decimal, 10, 30, WindowXSize - 20, 40, "", #PB_String_UpperCase | #ES_RIGHT)
          SendMessage_(hStringGadget_Decimal, #EM_SETLIMITTEXT, 10, 0)
          hStringGadget_Hexadecimal = StringGadget(#Gadget_String_Hexadecimal, 10, 110, WindowXSize - 20, 40, "", #PB_String_UpperCase | #ES_RIGHT)
          SendMessage_(hStringGadget_Hexadecimal, #EM_SETLIMITTEXT, 8, 0)
          hStringGadget_Binary = StringGadget(#Gadget_String_Binary, 10, 190, WindowXSize - 20, 40, "", #PB_String_UpperCase | #ES_RIGHT)
          SendMessage_(hStringGadget_Binary, #EM_SETLIMITTEXT, 32, 0)
      EndIf
      If CreateStatusBar(#StatusBar, WindowID())
      EndIf
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = #TRUE
      Case #PB_Event_Menu
        Select EventMenuID()
          Case #PB_Shortcut_Escape
            Quit = #TRUE
          Case #PB_Shortcut_Return
            Select LastGadgetTouched
              Case #Gadget_String_Decimal
                SetGadgetText(#Gadget_String_Hexadecimal, Dec2HexString(GetGadgetText(#Gadget_String_Decimal)))
                SetGadgetText(#Gadget_String_Binary, Dec2BinString(GetGadgetText(#Gadget_String_Decimal)))
              Case #Gadget_String_Hexadecimal
                SetGadgetText(#Gadget_String_Decimal, Hex2DecString(GetGadgetText(#Gadget_String_Hexadecimal)))
                SetGadgetText(#Gadget_String_Binary, Hex2BinString(GetGadgetText(#Gadget_String_Hexadecimal)))
              Case #Gadget_String_Binary
                SetGadgetText(#Gadget_String_Hexadecimal, Bin2HexString(GetGadgetText(#Gadget_String_Binary)))
                SetGadgetText(#Gadget_String_Decimal, Bin2DecString(GetGadgetText(#Gadget_String_Binary)))
            EndSelect
          Case #PB_Shortcut_Up
            Select LastGadgetTouched
              Case #Gadget_String_Decimal
                SetGadgetText(#Gadget_String_Decimal, Str(Val(GetGadgetText(#Gadget_String_Decimal)) + 1))
                SetGadgetText(#Gadget_String_Hexadecimal, Dec2HexString(GetGadgetText(#Gadget_String_Decimal)))
                SetGadgetText(#Gadget_String_Binary, Dec2BinString(GetGadgetText(#Gadget_String_Decimal)))
              Case #Gadget_String_Hexadecimal
                SetGadgetText(#Gadget_String_Hexadecimal, Str(Val(GetGadgetText(#Gadget_String_Hexadecimal)) + 1))
                SetGadgetText(#Gadget_String_Decimal, Hex2DecString(GetGadgetText(#Gadget_String_Hexadecimal)))
                SetGadgetText(#Gadget_String_Binary, Hex2BinString(GetGadgetText(#Gadget_String_Hexadecimal)))
              Case #Gadget_String_Binary
                SetGadgetText(#Gadget_String_Binary, Str(Val(GetGadgetText(#Gadget_String_Binary)) + 1))
                SetGadgetText(#Gadget_String_Hexadecimal, Bin2HexString(GetGadgetText(#Gadget_String_Binary)))
                SetGadgetText(#Gadget_String_Decimal, Bin2DecString(GetGadgetText(#Gadget_String_Binary)))
            EndSelect
          Case #PB_Shortcut_Down
            Select LastGadgetTouched
              Case #Gadget_String_Decimal
                SetGadgetText(#Gadget_String_Decimal, Str(Val(GetGadgetText(#Gadget_String_Decimal)) - 1))
                SetGadgetText(#Gadget_String_Hexadecimal, Dec2HexString(GetGadgetText(#Gadget_String_Decimal)))
                SetGadgetText(#Gadget_String_Binary, Dec2BinString(GetGadgetText(#Gadget_String_Decimal)))
              Case #Gadget_String_Hexadecimal
                SetGadgetText(#Gadget_String_Hexadecimal, Str(Val(GetGadgetText(#Gadget_String_Hexadecimal)) - 1))
                SetGadgetText(#Gadget_String_Decimal, Hex2DecString(GetGadgetText(#Gadget_String_Hexadecimal)))
                SetGadgetText(#Gadget_String_Binary, Hex2BinString(GetGadgetText(#Gadget_String_Hexadecimal)))
              Case #Gadget_String_Binary
                SetGadgetText(#Gadget_String_Binary, Str(Val(GetGadgetText(#Gadget_String_Binary)) - 1))
                SetGadgetText(#Gadget_String_Hexadecimal, Bin2HexString(GetGadgetText(#Gadget_String_Binary)))
                SetGadgetText(#Gadget_String_Decimal, Bin2DecString(GetGadgetText(#Gadget_String_Binary)))
            EndSelect
        EndSelect
      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case #Gadget_String_Decimal
            If OldGadgetText_Decimal <> GetGadgetText(#Gadget_String_Decimal)
                IsValid(#Gadget_String_Decimal, "-0123456789", Warning, TextDecimal)
                LastGadgetTouched = #Gadget_String_Decimal
                SetGadgetText(#Gadget_String_Hexadecimal, Dec2HexString(GetGadgetText(#Gadget_String_Decimal)))
                SetGadgetText(#Gadget_String_Binary, Dec2BinString(GetGadgetText(#Gadget_String_Decimal)))
                OldGadgetText_Decimal = GetGadgetText(#Gadget_String_Decimal)
            EndIf
            While WindowEvent() : Wend
          Case #Gadget_String_Hexadecimal
            If OldGadgetText_Hexadecimal <> GetGadgetText(#Gadget_String_Hexadecimal)
                IsValid(#Gadget_String_Hexadecimal, "0123456789ABCDEF", Warning, TextHexadecimal)
                LastGadgetTouched = #Gadget_String_Hexadecimal
                SetGadgetText(#Gadget_String_Decimal, Hex2DecString(GetGadgetText(#Gadget_String_Hexadecimal)))
                SetGadgetText(#Gadget_String_Binary, Hex2BinString(GetGadgetText(#Gadget_String_Hexadecimal)))
                OldGadgetText_Hexadecimal = GetGadgetText(#Gadget_String_Hexadecimal)
            EndIf
            While WindowEvent() : Wend
          Case #Gadget_String_Binary
            If OldGadgetText_Binary <> GetGadgetText(#Gadget_String_Binary)
                IsValid(#Gadget_String_Binary, "01", Warning, TextBinary)
                LastGadgetTouched = #Gadget_String_Binary
                SetGadgetText(#Gadget_String_Decimal, Bin2DecString(GetGadgetText(#Gadget_String_Binary)))
                SetGadgetText(#Gadget_String_Hexadecimal, Bin2HexString(GetGadgetText(#Gadget_String_Binary)))
                OldGadgetText_Binary = GetGadgetText(#Gadget_String_Binary)
            EndIf
            While WindowEvent() : Wend
        EndSelect
    EndSelect
  Until Quit
  EndIf
End

DataSection
French:
  Data.s "Tests Bin Dec Hex"
  Data.s "Attention"
  Data.s "Les valeurs décimales ne peuvent contenir que des caratères parmi "
  Data.s "Les valeurs hexadécimales ne peuvent contenir que des caratères parmi "
  Data.s "Les valeurs binaires ne peuvent contenir que des caratères parmi "
  Data.s "Décimal"
  Data.s "Hexadécimal"
  Data.s "Binaire"
English:
  Data.s "Bin Dec Hex Training"
  Data.s "Warning"
  Data.s "Decimal values can contain only "
  Data.s "Hexadecimal values can contain only "
  Data.s "Binary values can contain only "
  Data.s "Decimal"
  Data.s "Hexadecimal"
  Data.s "Binary"
  
My avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:

Post by TerryHough »

Please see the topic here for an idea that came from this topic:

viewtopic.php?p=58907#58907

Terry
akj
Enthusiast
Enthusiast
Posts: 668
Joined: Mon Jun 09, 2003 10:08 pm
Location: Nottingham

Post by akj »

Sparkie's validation routine is badly flawed.
In particular, the validation fails if Len(text_gadget_string)>Len(valid_chars$).

I believe my code below is more robust:

Code: Select all

valid_chars$ = "0123456789.+-/"
text$ = GetGadgetText(#String_0)
SendMessage_(GadgetID(#String_0), #EM_GETSEL, @cPos, 0) ; Get caret position
c$=Mid(text$, cPos, 1) ; The character at the caret
If FindString(valid_chars$, c$, 1)=0 ; If the character at the caret is invalid
  text$=Left(text$,cPos-1)+Mid(text$,cPos+1,999) ; Remove the invalid character
  SetGadgetText(#String_0, text$) ; Update the gadget
  SendMessage_(GadgetID(#String_0), #EM_SETSEL, cPos-1, cPos-1) ; Restore caret
EndIf
Notice there is absolutely no looping. This is because of the observation that if the routine is working correctly and has eliminated all invalid characters so far, than any new invalid character MUST be at the position of the caret. Therefore my routine only tests one character each time it is invoked.
Anthony Jordan
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

@akj: Thanks for pointing out the flaw in my code. ;)

I changed..

Code: Select all

For i = 1 To Len(valid_chars$) 
to

Code: Select all

For i = 1 To Len(validate_it$) 

It seems to work better now. I was rather new to PB at the time of my original post, but if I remember correctly, I used a loop in order to catch and remove invalid characters within a paste operation.

Code: Select all

Enumeration 
  #Window_0 
EndEnumeration 

Enumeration 
  #String_0 
  #Text_0 
EndEnumeration 

If OpenWindow(#Window_0, 434, 225, 193, 174,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "New window ( 0 )") 
  If CreateGadgetList(WindowID()) 
    Attributes.l = #ES_RIGHT 
    hStringGadget = StringGadget(#String_0, 43, 28, 112, 21, "", Attributes) 
    TextGadget(#Text_0, 41, 63, 118, 20, "Enter your Text above", #PB_Text_Center) 
    SendMessage_(hStringGadget, #EM_SETLIMITTEXT, 22, 0) ; adjust to the limit you want to have 
  EndIf 
EndIf 

quit = #False 
valid_chars$ = "0123456789.+-/" 
Repeat 
  event = WaitWindowEvent() 
  Select event 
    Case #PB_EventGadget 
      Select EventGadgetID() 
        Case #String_0 
          validate_it$ = GetGadgetText(#String_0) 
          For i = 1 To Len(validate_it$) 
            ; see if all characters in StringGadget are valid 
            keepit = FindString(valid_chars$, Mid(validate_it$, i, 1), 1) 
            If keepit = 0 
              ; get current caret position 
              SendMessage_(hStringGadget, #EM_GETSEL, @cPos, 0) 
              ; remove invalid character 
              newstring$ = RemoveString(validate_it$, Mid(validate_it$, i, 1),1) 
              SetGadgetText(#String_0, newstring$) 
              ;set caret position to last position after setting newstring$ 
              SendMessage_(hStringGadget, #EM_SETSEL, cPos-1, cPos-1) 
            EndIf 
          Next i
      EndSelect 
    Case #PB_EventCloseWindow 
      quit = #True 
  EndSelect 
Until quit 
End 
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
Post Reply