Tweet
Originally posted by James C Morgan
View Post
Code:
#COMPILE EXE
#DIM ALL
#INCLUDE "Win32API.inc"
%IDC_DoBtn = 500
%IDC_TxtLbl = 501
FUNCTION PBMAIN() AS LONG
LOCAL hDlg AS LONG
DIALOG NEW PIXELS, 0, "Custom InputBox", 300, 300, 320, 60, %WS_SYSMENU TO hDlg
CONTROL ADD BUTTON, hDlg, %IDC_DoBtn, "Get Text", 5, 5, 60, 50
CONTROL ADD LABEL, hDlg, %IDC_TxtLbl, "", 70, 6, 250, 50
CONTROL SET FOCUS hDlg, %IDC_DoBtn
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
CALLBACK FUNCTION DlgProc()
LOCAL dflttxt, inputname AS STRING
LOCAL limit AS LONG
SELECT CASE CB.MSG
CASE %WM_INITDIALOG
CASE %WM_COMMAND
SELECT CASE AS LONG CB.CTL
CASE = %IDCANCEL
DIALOG END CB.HNDL
CASE %IDC_DoBtn
CONTROL GET TEXT CB.HNDL, %IDC_TxtLbl TO dflttxt
CONTROL GET TEXT CB.HNDL, %IDC_DoBtn TO inputname
SELECT CASE inputname
CASE "Get Text"
CONTROL SET TEXT CB.HNDL, %IDC_TxtLbl, _
CustomInputBox(CB.HNDL, %IDC_DoBtn, "Please Enter Your Name", 32, _
"", 0, 1)
CONTROL SET TEXT CB.HNDL, %IDC_DoBtn, "Try Again"
CASE "Try Again"
CONTROL SET USER CB.HNDL, %IDC_DoBtn, 1, %RGB_NAVY 'Use these to set a custom color
CONTROL SET USER CB.HNDL, %IDC_DoBtn, 2, %RGB_SKYBLUE 'for the input dialog.
CONTROL SET TEXT CB.HNDL, %IDC_TxtLbl, _
CustomInputBox(CB.HNDL, %IDC_DoBtn, "Please Enter Your Quest", 128, _
"Example. I seek the Grail.")
CONTROL SET TEXT CB.HNDL, %IDC_DoBtn, "One More"
CASE "One More"
CONTROL SET USER CB.HNDL, %IDC_DoBtn, 1, 0 'revert to default colors
CONTROL SET USER CB.HNDL, %IDC_DoBtn, 2, 0 'by zeroing USER variables
CONTROL SET TEXT CB.HNDL, %IDC_TxtLbl, _
CustomInputBox(CB.HNDL, %IDC_DoBtn, "Please Enter a number", 16, _
TRIM$(dflttxt), 1)
CONTROL SET TEXT CB.HNDL, %IDC_DoBtn, "Exit"
CASE "Exit"
DIALOG END CB.HNDL
END SELECT
END SELECT
END SELECT
END FUNCTION
FUNCTION StrPoque(temp AS STRING) AS STRING
STATIC hold AS STRING
IF temp = "" THEN
FUNCTION = hold: hold = ""
ELSE
hold = temp: FUNCTION = temp
END IF
END FUNCTION
%IDC_CustomInTxt = 16001
%IDC_CustomInInf = 16002
%IDC_CustomInOkB = 16003
%IDC_CustomInNoB = 16004
FUNCTION CustomInputBox(hParent AS LONG, ctrl AS LONG, title AS STRING, limit AS LONG, _
OPTIONAL dflt AS STRING, OPTIONAL numric AS LONG, OPTIONAL password AS LONG) AS STRING
'get the parent dialog handle, control handle to which input is connected,
'title of the input box, limit of input length, default string if desired,
'numeric limitation if desired and password input if desired.
LOCAL result, dlginfo, defaulttxt, teststring AS STRING
LOCAL hInDlg, x, y, px, py, bwide, forecolor, backcolor, high, param AS LONG
DIALOG DISABLE hParent 'disable parent dialog
CONTROL GET USER hParent, ctrl, 1 TO forecolor 'get custom foreground color
CONTROL GET USER hParent, ctrl, 2 TO backcolor 'get custom background color
IF forecolor = 0 AND backcolor = 0 THEN 'set default colors if custom colors not used
forecolor = %RGB_NAVY
backcolor = %RGB_GAINSBORO
END IF
result = SPACE$(limit) 'create a buffer space
dlginfo = "Input text here." 'create input box title variable
defaulttxt = "" 'create default data variable
IF VARPTR(dflt) <> 0 THEN defaulttxt = dflt 'if default string is supplied, use it
teststring = defaulttxt
IF VARPTR(numric) AND numric <> 0 THEN teststring = TRIM$(STR$(VAL(defaulttxt)))
'if numeric values only, delete default string content if not numeric
IF teststring = "0" AND INSTR(defaulttxt, teststring) = 0 THEN teststring = ""
'if numeric and value is zero, test for zero in received default string
defaulttxt = teststring 'set default string equal to filtered test string
result = LEFT$(defaulttxt + SPACE$(limit), limit) 'configure string space to accommodate text to limit
IF title <> "" THEN dlginfo = title 'If there was a title received, use that.
CONTROL GET LOC hParent, ctrl TO x, y 'get screen location of control calling for input
CONTROL GET SIZE hParent, ctrl TO bwide, high 'get screen dimensions of control calling for input
DIALOG NEW PIXELS, hParent, dlginfo, x, y, 230, 35, %WS_POPUP OR %WS_BORDER TO hInDlg
param = %WS_BORDER OR %WS_TABSTOP OR %ES_AUTOHSCROLL 'set parameters for input textbox
IF VARPTR(numric) AND numric THEN param OR= %ES_NUMBER 'add numeric input if requested
IF VARPTR(password) AND password THEN param OR= %ES_PASSWORD 'add password input if requested
CONTROL ADD TEXTBOX, hInDlg, %IDC_CustomInTxt, defaulttxt, 0, 0, 190, 19, param
CONTROL ADD LABEL, hInDlg, %IDC_CustomInInf, dlginfo, 0, 19, 230, 16
CONTROL ADD BUTTON, hInDlg, %IDC_CustomInOkB, "&OK", 190, 0, 20, 19
CONTROL ADD BUTTON, hInDlg, %IDC_CustomInNoB, "&NO", 210, 0, 20, 19
strpoque STR$(limit)
CONTROL SET FOCUS hIndlg, %IDC_CustomInTxt 'give keyboard focus to input textbox
DIALOG SHOW MODAL hInDlg CALL CustomInputBoxProc 'show input dialog
DIALOG ENABLE hParent 're-enable parent dialog
CONTROL SET FOCUS hParent, ctrl 'give focus to calling control
FUNCTION = strpoque("") 'return string from input dialog
END FUNCTION
CALLBACK FUNCTION CustomInputBoxProc()
LOCAL result, txtIn AS BYTE PTR
LOCAL tempstr AS STRING
LOCAL limit, copyloop AS LONG
SELECT CASE CB.MSG
CASE %WM_INITDIALOG
CASE %WM_COMMAND
SELECT CASE AS LONG CB.CTL
CASE = %IDOK 'exit with text returned on Enter
DIALOG POST CB.HNDL, %WM_COMMAND, %IDC_CustomInOkB, 0
CASE = %IDCANCEL
StrPoque "" 'exit without text on Escape
DIALOG END CB.HNDL
CASE %IDC_CustomInOkB 'exit with OK button
CONTROL GET TEXT CB.HNDL, %IDC_CustomInTxt TO tempstr 'get textbox string
limit = VAL(strpoque(""))
strpoque ""
tempstr += SPACE$(limit)
tempstr = LEFT$(tempstr, limit)
strpoque RTRIM$(tempstr)
DIALOG END CB.HNDL
CASE %IDC_CustomInNoB 'exit with NO button
StrPoque ""
DIALOG END CB.HNDL
END SELECT
END SELECT
END FUNCTION
Comment