InputRequester() with Multiple Inputs & Decimal-Digit Mask

Share your advanced PureBasic knowledge/code with the community.
User avatar
TI-994A
Addict
Addict
Posts: 2512
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

InputRequester() with Multiple Inputs & Decimal-Digit Mask

Post by TI-994A »

Here's a concerted contribution, of yet another custom input requester.

Code: Select all

;====================================================================
;   Custom InputBox() with multiple inputs & decimal-digit mask
;
;   cross-platform masking routines by Keya & Shardik - Thank you!
;   original posted code available in the following forum thread:
;
;====================================================================
; http://forums.purebasic.com/english/viewtopic.php?t=67986&p=503517
;====================================================================
;   
;   tested & working on Win10 running PureBasic v5.62 (x64)
;
;   by TI-994A - free to use, improve, share...
;
;   10th May 2018
;====================================================================


;==================
; masking routines 
;==================

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  CompilerIf #PB_Compiler_Version < 470 Or (#PB_Compiler_Version >= 500 And Subsystem("Carbon"))
    ImportC ""
      GetControlData(ControlRef.L, ControlPartCode.L, TagName.L, BufferSize.L, *Buffer, *ActualSize)
      SetControlData(ControlRef.L, ControlPartCode.L, TagName.L, BufferSize.L, *Buffer)
    EndImport   
    #kControlEditTextPart = 5
    #kControlEditTextSelectionTag = $73656C65 ;'sele'   
    Structure ControlEditTextSelectionRec
      SelStart.W
      SelEnd.W
    EndStructure
  CompilerElse
    Global NSRangeZero.NSRange
    Procedure.i TextEditor(Gadget.i)
      Protected TextField.i = GadgetID(Gadget)
      Protected Window.i = CocoaMessage(0, TextField, "window")
      ProcedureReturn CocoaMessage(0, Window, "fieldEditor:", #YES, "forObject:", TextField)
    EndProcedure
  CompilerEndIf
CompilerEndIf

Procedure SetStringGadgetSelection(GadgetID.i, Start.i, Length.i=0)
  SetActiveGadget(gadgetid)
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      SendMessage_(GadgetID(GadgetID), #EM_SETSEL, Start-1, Start-1)
    CompilerCase #PB_OS_Linux
      gtk_editable_select_region_(GadgetID(gadgetid), Start-1, Start-1)
    CompilerCase #PB_OS_MacOS
      CompilerIf #PB_Compiler_Version < 470 Or (#PB_Compiler_Version >= 500 And Subsystem("Carbon"))
        Protected TextSelection.ControlEditTextSelectionRec
        TextSelection\selStart = Start - 1
        TextSelection\selEnd = Start -1 
        SetControlData(GadgetID(GadgetID), #kControlEditTextPart, 
                       #kControlEditTextSelectionTag, SizeOf(ControlEditTextSelectionRec), @TextSelection)
      CompilerElse
        Protected Range.NSRange\location = Start - 1 : Range\length = 0
        CocoaMessage(0, TextEditor(GadgetID), "setSelectedRange:@", @Range)
      CompilerEndIf
  CompilerEndSelect
EndProcedure

Procedure.i GetCaretPosition(GadgetID.i)
  Protected Start.i = 0
  Protected Stop.i = 0
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      SendMessage_(GadgetID(GadgetID.i), #EM_GETSEL, @Start.i, @Stop.i)
      ProcedureReturn Stop + 1
    CompilerCase #PB_OS_Linux
      Stop = gtk_editable_get_position_(GadgetID(gadgetid))
      ProcedureReturn Stop + 1
    CompilerCase #PB_OS_MacOS
      CompilerIf #PB_Compiler_Version < 470 Or (#PB_Compiler_Version >= 500 And Subsystem("Carbon"))
        Protected TextSelection.ControlEditTextSelectionRec
        GetControlData(GadgetID(GadgetID), #kControlEditTextPart, #kControlEditTextSelectionTag, 
                       SizeOf(ControlEditTextSelectionRec), @TextSelection.ControlEditTextSelectionRec, 0)
        ProcedureReturn TextSelection\End + 1
      CompilerElse
        Protected Range.NSRange
        CocoaMessage(@Range, TextEditor(GadgetID), "selectedRange")        
        ProcedureReturn Range\location + Range\length + 1
      CompilerEndIf
  CompilerEndSelect
EndProcedure

Procedure RestrictChars(*pchr.Ascii, slen)
  If slen
    *pout.Ascii = *pchr
    For i = 1 To slen
      Select *pchr\a
        Case '0' To '9'
          *pchr+SizeOf(Character): *pout+SizeOf(Character)
        Case '.':
          dotcnt+1
          If dotcnt=1
            *pchr+SizeOf(Character): *pout+SizeOf(Character)
          Else
            Goto BadChar
          EndIf
        Default:
          BadChar:
          *pchr+SizeOf(Character): changed=1
      EndSelect 
      *pout\a = *pchr\a
    Next
  EndIf
  ProcedureReturn changed
EndProcedure

Procedure DecimalDigitMask(gadget)
  Static Changing
  If Not Changing
    Changing=1
    sTxt$ = GetGadgetText(gadget)
    lastcaretpos = GetCaretPosition(gadget)
    If RestrictChars(@sTxt$, Len(sTxt$))
      SetGadgetText(gadget, sTxt$)
      SetStringGadgetSelection(gadget, lastcaretpos-1)
    EndIf
    Changing=0
  EndIf 
EndProcedure


;====================
; input box routines
;====================

Procedure InputBoxHandler()
  Select Event()
    Case #PB_Event_CloseWindow
      w = EventWindow()
      DisableWindow(GetWindowData(w), #False)
      CloseWindow(w)  
    Case #PB_Event_Gadget      
      g = EventGadget()      
      w = GetGadgetData(g)
      If GadgetType(g) = #PB_GadgetType_Button 
        DisableWindow(GetWindowData(w), #False)
        CloseWindow(w)          
      Else
        If GetGadgetData(w) = 1
          DecimalDigitMask(g)
        EndIf
        SetGadgetText(w, GetGadgetText(g))        
      EndIf      
  EndSelect  
EndProcedure

Procedure InputBoxApplyDecimalMask(gadget)
  SetGadgetData(gadget, 1)
EndProcedure

Procedure InputBox(parentWindow, Array parentInputs(1), x = 0, y = 0, width = 300, height = 160)   
  inputCount = ArraySize(parentInputs())
  Dim inputs(inputCount)
  height = ((inputCount + 1) * 30) + 100
  inputBoxWindow = OpenWindow(#PB_Any, x, y, width, height, "Numeric InputBox", 
                              #PB_Window_SystemMenu | #PB_Window_WindowCentered, 
                              WindowID(parentWindow))
  inputBoxLabel = TextGadget(#PB_Any, 50, 15, 200, 30, "Please input values:")
  For i = 0 To inputCount
    inputs(i) = StringGadget(#PB_Any, 50, 40 + inc, 200, 25, "")
    SetGadgetData(inputs(i), parentInputs(i))  
    BindGadgetEvent(inputs(i), @InputBoxHandler(), #PB_EventType_Change)
    If GetGadgetData(parentInputs(i)) = 1
      SetGadgetColor(inputs(i), #PB_Gadget_BackColor, RGB(150, 250, 255))
    EndIf    
    inc + 30
  Next i  
  inputBoxButton = ButtonGadget(#PB_Any, 50, 40 + inc, 200, 30, "OK")
  SetWindowData(inputBoxWindow, parentWindow)  
  SetGadgetData(inputBoxButton, inputBoxWindow)    
  BindGadgetEvent(inputBoxButton, @InputBoxHandler())
  BindEvent(#PB_Event_CloseWindow, @InputBoxHandler(), inputBoxWindow)  
  DisableWindow(parentWindow, #True)
EndProcedure


;===============
; usage example
;===============

tFlags = #PB_Text_Center | #PB_Text_Border
wFlags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
mainWindow = OpenWindow(#PB_Any, 0, 0, 400, 300, "Custom Numeric InputBox", wFlags)
clockDisplay = TextGadget(#PB_Any, 0, 10, 390, 20, "Clock Display", #PB_Text_Right)
popInputBox = ButtonGadget(#PB_Any, 90, 250, 220, 30, "INPUT REQUIRED VALUES")
TextGadget(0, 90, 50, 220, 30, "Float Value", tFlags)
TextGadget(1, 90, 90, 220, 30, "String Value", tFlags)
TextGadget(2, 90, 130, 220, 30, "Float Value", tFlags)
TextGadget(3, 90, 170, 220, 30, "String Value", tFlags)
AddWindowTimer(mainWindow, clock, 1000)

Dim inputs(3)
For i = 0 To 3    
  inputs(i) = i
  SetGadgetColor(inputs(i), #PB_Gadget_BackColor, RGB(255, 255, 255))
Next

Repeat
  Select WaitWindowEvent()
      
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case mainWindow
          appQuit = 1          
      EndSelect
      
    Case #PB_Event_Timer
      Select EventTimer()
        Case clock
          SetGadgetText(clockDisplay, FormatDate("%hh:%ii:%ss", Date()))
      EndSelect  
      
    Case #PB_Event_Gadget
      Select EventGadget()  
        Case popInputBox          
          InputBoxApplyDecimalMask(inputs(1))
          InputBoxApplyDecimalMask(inputs(3))
          InputBox(mainWindow, inputs())
      EndSelect
      
  EndSelect  
Until appQuit
To set the decimal-digit mask on any of the inputs:

Code: Select all

InputBoxApplyDecimalMask(inputPlaceholder)
To invoke the custom requester with multiple inputs:

Code: Select all

InputBox(#parentWindow, inputPlaceHolderArray())
The masking and input box routines are fully portable and could be extracted and included as separate .pbi files for use in any project. The input box routines could also work independently, without the masking routines, if the decimal-digit sub-classing is not required. It accommodates multiple inputs automatically, which are tied in to placeholder gadgets on the main window, passed in arrays. This could be easily modified to work with variables as well.

Suggestions, feedback, and improvements are most welcome. Thank you. :D
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: InputRequester() with Multiple Inputs & Decimal-Digit Ma

Post by mk-soft »

Very nice :wink:

Missing automatic decimal digit for different language.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
TI-994A
Addict
Addict
Posts: 2512
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Re: InputRequester() with Multiple Inputs & Decimal-Digit Ma

Post by TI-994A »

mk-soft wrote:Missing automatic decimal digit for different language.
Thank you.

Improvements are welcome! :lol:
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Post Reply