• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

Validation of textboxes

Started by Chris Chancellor, November 14, 2018, 03:39:12 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Chris Chancellor

Hello all

the attached is a small program to validate data entry input into textboxes
allowing say numeric and alphabet data entry

please suggest some improvement on this code so that O2 can go to greater heights


' Subclassing Textbox in a Dialog with validation
' TextboxValid.o2bas

' TextBox1 allows only numbers to be entered
' TextBox2  allows NON numeric characters to be entered


$ filename "TextBoxValid.exe"

uses rtl64

'% review
uses O2Common
uses dialogs

% GWLP_WNDPROC= -4
% DS_3DLOOK  0x0004L
% DS_NOFAILCREATE  0x0010L
% DS_MODALFRAME  0x80L

'Equates
% IDC_EDIT1    = 1001
% IDC_LABEL1   = 1006

% IDC_EDIT2    = 1008
% IDC_LABEL2   = 1009



sys hEdit1 , hEdit2
sys hLabel




'=================================
sub WinMain()

Dialog( 0, 0, 302, 160, "Textboxes validation",
         WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | WS_CLIPSIBLINGS | WS_VISIBLE | DS_MODALFRAME | DS_3DLOOK | DS_NOFAILCREATE | DS_SETFONT | DS_CENTER,
          8, "MS Sans Serif",
          WS_EX_CONTROLPARENT | WS_EX_LEFT | WS_EX_LTRREADING | WS_EX_RIGHTSCROLLBAR)
     
    '  Textbox 1
      EDITTEXT("", IDC_EDIT1, 8, 18, 200, 14,
                        WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
                       WS_EX_CLIENTEDGE)

    ' Label for    Textbox 1
     LText( "Enter only numbers", IDC_LABEL1, 8, 5, 120, 10)


'  Textbox 2
      EDITTEXT("", IDC_EDIT2, 8, 53, 200, 14,
                        WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
                       WS_EX_CLIENTEDGE)

    ' Label for    Textbox 2
     LText( "Enter only alphabetic characters", IDC_LABEL2, 8, 40, 120, 10)



   


    CreateModalDialog( null, @DlgProc, 0)     
end function
   



'=================================
function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
    hEdit1= GetDlgItem(hDlg, IDC_EDIT1)
    hEdit2= GetDlgItem(hDlg, IDC_EDIT2)
   
   select case uMsg

    case WM_INITDIALOG
      '  for light yellow background
        MainWindBGColor = 1
        SetProp(hEdit1, "OldEditProc1", SetWindowLongPtr(hEdit1, GWLP_WNDPROC, @EditProc1))
        SetProp(hEdit2, "OldEditProc2", SetWindowLongPtr(hEdit2, GWLP_WNDPROC, @EditProc2))


    case WM_CLOSE
             ' display the values from Textboxes upon closing
              string text1=nuls 100
              GetWindowText(hEdit1, text1, 32)
             mbox " textbox1   " + text1 ,0
             string text2=nuls 100
             GetWindowText(hEdit2, text2, 32)
             mbox  "    textbox2   " + text2 ,0

       'Remove control subclassing
       RemoveProp(hEdit1, "OldEditProc1", GetWindowLongPtr(hEdit1, GWLP_WNDPROC, @EditProc1))       
       RemoveProp(hEdit2, "OldEditProc2", GetWindowLongPtr(hEdit2, GWLP_WNDPROC, @EditProc2))           
       EndDialog( hDlg, null )



    CASE WM_ERASEBKGND   
'            added to display background color for the main window 
             hBGDC = wParam
  '          Pass the DC of the region to be repaint
             DrawGradient hBGDC           
             FUNCTION = 1
             EXIT FUNCTION

    CASE   WM_CTLCOLORSTATIC
                  '  set text forecolor to  dark blue
               SetTextColor(wPARAM, RGB(0,0,1390))
                 ' set background to transparent
               SetBkMode(wPARAM, Transparent)
               FUNCTION = GetStockObject(NULL_BRUSH)
               EXIT FUNCTION



    end select   
 
    return 0
end function


'======================================
' Subclass procedure for the Textbox 1 control to detect what  ASCII values were key in
' this function only allows Numbers to be entered
Function EditProc1(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback

   Select CASE wMsg 

    CASE  WM_CHAR
         SELECT CASE wParam
            CASE 8, 46, 48 TO 57   
                  'back key, dot, numbers
                   'these are numeric keys are allowed, nothing to do
            CASE ELSE
                  'inappropriate key, discard
                   EXIT FUNCTION
         END SELECT           
     
        CASE  WM_KEYDOWN
           

        CASE WM_KEYUP
            '  Go to the next control when enter key is pressed
         IF wParam = 13 THEN
              SetFocus GetNextDlgTabItem(GetParent(hDlg), GetFocus, FALSE)
         end if
   End Select

   Return CallWindowProc(GetProp(hEdit1, "OldEditProc1"), hEdit1, wMsg, wParam, lParam)

End Function


'======================================
' Subclass procedure for the Textbox 2 control to detect what  ASCII values were key in
' this function only allows alphabetic characters to be entered
Function EditProc2(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback

   Select CASE wMsg 

    CASE  WM_CHAR
         SELECT CASE wParam
           CASE 8,32, 65 to 122
                  ' Alphabetic characters , space and  backspace are allowed
            CASE ELSE
                 EXIT FUNCTION
         END SELECT           
     
        CASE  WM_KEYDOWN
       

   CASE WM_KEYUP
       '  Go to the next control when enter key is pressed
         IF wParam = 13 THEN
              SetFocus GetNextDlgTabItem(GetParent(hDlg), GetFocus, FALSE)
         end if


   End Select

   Return CallWindowProc(GetProp(hEdit2, "OldEditProc2"), hEdit2, wMsg, wParam, lParam)

End Function





'-----------------------------------------
'  Start of program
   WinMain()