280 lines
8.1 KiB
Plaintext
280 lines
8.1 KiB
Plaintext
*--------------------------------------------------------
|
|
* Function Name.: rbInputBox()
|
|
*
|
|
* Author........: Rick Borup
|
|
* Information Technology Associates
|
|
* Champaign, IL U.S.A.
|
|
* http://www.ita-software.com
|
|
* rborup@ita-software.com
|
|
*
|
|
* Date Written..: March 20, 2000
|
|
*
|
|
* Date Released.: April 27, 2000
|
|
*
|
|
* Date Revised..: January 30, 2003
|
|
*
|
|
* Abstract......: A simple, general-purpose input box for Visual FoxPro.
|
|
*
|
|
* Parameters....: (All parameters are optional.)
|
|
*
|
|
* tcPrompt - the prompt that the user sees.
|
|
* The default is "Enter the value".
|
|
*
|
|
* tcTitle - the title for the form.
|
|
* The default is "InputBox".
|
|
*
|
|
* txDefaultValue - default value.
|
|
* This parameter can be a character, date, numeric, or
|
|
* currency data type. If this parameter is omitted, an
|
|
* empty textbox is displayed and the data type is character.
|
|
* The data type of the return value is the same as the
|
|
* data type of the default value.
|
|
*
|
|
* tnLeft - the form's Left position
|
|
*
|
|
* tnTop - the form's Top position.
|
|
*
|
|
* If Left and Top are omitted or are not numeric, rbInputBox()
|
|
* is auto-centered.
|
|
*
|
|
* tcFormat - a value for the Format property of the textbox
|
|
*
|
|
* tcInputMask - a value for the InputMask property of the textbox
|
|
*
|
|
* tcPasswordChar - a value for the textbox's PasswordChar value
|
|
* (the default is blank)
|
|
*
|
|
* Returns.......: Character, Date, Numeric, or Currency depending
|
|
* on the data type of the default value
|
|
*
|
|
* If the Cancel button is chosen, rbInputBox() returns
|
|
* an empty value of the appropriate data type.
|
|
*
|
|
* Copyright.....: Copyright (c) Information Technology Associates, 2000-2003
|
|
*
|
|
* License.......: rbInputBox() is freeware. You may include rbInputBox()
|
|
* royalty-free inside a compiled Visual FoxPro APP or EXE
|
|
* that you create for your own use or for distribution to
|
|
* a third party.
|
|
*
|
|
* You may redistribute the rbInputBox() distribution
|
|
* package, INPUTBOX.ZIP, as long as (a) you distribute
|
|
* INPUTBOX.ZIP in its entirety and without modifications,
|
|
* and (b) you do not charge anything for it.
|
|
*
|
|
* Warranty......: NONE. This code is released AS IS without warranty
|
|
* of any kind. The user assumes all responsibility and
|
|
* liability for its use.
|
|
*
|
|
* Support.......: NONE, but your comments and suggestions for improvements
|
|
* are welcome. Please e-mail rborup@ita-software.com or
|
|
* reach me via the Universal Thread at
|
|
* http://www.universalthread.com.
|
|
*
|
|
* Release History:January 30, 2003 - Renamed as "rbInputBox" to avoid conflict
|
|
* with the native InputBox() function in
|
|
* VFP 7.0 and later.
|
|
* - Added tcPasswordChar as 8th parameter
|
|
*
|
|
* May 2, 2000 - Corrected errata in the readme.txt file.
|
|
*
|
|
* April 27, 2000 - Original Release
|
|
*
|
|
* Known Limitations:
|
|
* The original release of rbInputBox does not automatically
|
|
* resize the form or any of its controls. The current
|
|
* sizes are designed to be adequate for most simple input
|
|
* functions. There is no arbitrary limitations, other than
|
|
* VFP's own inherent limitations, on the size of the return
|
|
* value. However, long titles, prompts, or entered values may
|
|
* appear truncated on the form.
|
|
*
|
|
FUNCTION rbInputBox
|
|
lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ;
|
|
tcFormat, tcInputMask, tcPasswordChar
|
|
private pcReturnValue
|
|
pcReturnValue = txDefaultValue
|
|
local oInputBox
|
|
oInputBox = CreateObject("rbInputBox", tcPrompt, tcTitle, ;
|
|
txDefaultValue, tnLeft, tnTop, ;
|
|
tcFormat, tcInputMask, tcPasswordChar)
|
|
oInputBox.Show()
|
|
RETURN pcReturnValue
|
|
|
|
|
|
**************************************************
|
|
*-- Class: rbinputbox
|
|
*-- ParentClass: form
|
|
*-- BaseClass: form
|
|
*-- Time Stamp: 01/29/03 01:03:14 PM
|
|
*
|
|
DEFINE CLASS rbinputbox AS form
|
|
|
|
|
|
Height = 113
|
|
Width = 318
|
|
DoCreate = .T.
|
|
AutoCenter = .T.
|
|
Caption = "Input Box"
|
|
ControlBox = .F.
|
|
WindowType = 1
|
|
Name = "frmInputBox"
|
|
|
|
*-- empty value to return if Cancel is chosen; data type depends on data type of txValueIn
|
|
xemptyvalue = .F.
|
|
|
|
*-- the default value (if any)
|
|
xdefaultvalue = .F.
|
|
|
|
*-- the return value
|
|
xreturnvalue = .F.
|
|
|
|
|
|
ADD OBJECT lblinputbox AS label WITH ;
|
|
FontName = "Arial", ;
|
|
FontSize = 9, ;
|
|
Alignment = 1, ;
|
|
Caption = "Enter the value", ;
|
|
Height = 20, ;
|
|
Left = 6, ;
|
|
Top = 26, ;
|
|
Width = 190, ;
|
|
TabIndex = 1, ;
|
|
Name = "lblInputBox"
|
|
|
|
|
|
ADD OBJECT txtinputbox AS textbox WITH ;
|
|
FontName = "Arial", ;
|
|
FontSize = 9, ;
|
|
Century = 1, ;
|
|
Height = 24, ;
|
|
Left = 202, ;
|
|
SelectOnEntry = .T., ;
|
|
TabIndex = 2, ;
|
|
Top = 22, ;
|
|
Width = 110, ;
|
|
Name = "txtInputBox"
|
|
|
|
|
|
ADD OBJECT cmdok AS commandbutton WITH ;
|
|
Top = 72, ;
|
|
Left = 84, ;
|
|
Height = 24, ;
|
|
Width = 72, ;
|
|
Caption = "OK", ;
|
|
Default = .T., ;
|
|
TabIndex = 3, ;
|
|
Name = "cmdOK"
|
|
|
|
|
|
ADD OBJECT cmdcancel AS commandbutton WITH ;
|
|
Top = 72, ;
|
|
Left = 172, ;
|
|
Height = 24, ;
|
|
Width = 72, ;
|
|
Cancel = .T., ;
|
|
Caption = "Cancel", ;
|
|
TabIndex = 4, ;
|
|
Name = "cmdCancel"
|
|
|
|
|
|
PROCEDURE Unload
|
|
with thisform
|
|
if type(".xReturnValue") = "C"
|
|
.xReturnValue = RTRIM( .xReturnValue)
|
|
endif
|
|
pcReturnValue = .xReturnValue
|
|
endwith
|
|
ENDPROC
|
|
|
|
|
|
PROCEDURE Init
|
|
lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ;
|
|
tcFormat, tcInputMask, tcPasswordChar
|
|
if type("tcPrompt") <> "C"
|
|
tcPrompt = "Enter the value"
|
|
endif
|
|
if type("tcTitle") <> "C"
|
|
tcTitle = "Input Box"
|
|
endif
|
|
if !( type("txDefaultValue") $ "CDNY")
|
|
* Valid input data types are C, D, N, and Y
|
|
txDefaultValue = "" && default to character data type
|
|
endif
|
|
if type("tcFormat") <> "C"
|
|
tcFormat = ""
|
|
endif
|
|
if type("tcInputMask") <> "C"
|
|
tcInputMask = ""
|
|
endif
|
|
if type("tcPasswordChar") <> "C"
|
|
tcPasswordChar = ""
|
|
endif
|
|
if len( alltrim( tcPasswordChar)) > 1
|
|
tcPasswordChar = left( tcPasswordChar, 1)
|
|
endif
|
|
local llAutoCenter
|
|
if pcount() < 5 && Top and Left parameters were not passed
|
|
tnLeft = 0
|
|
tnTop = 0
|
|
else && Top and left parameters were passed but may not be numeric
|
|
if type("tnTop") = "N" and type("tnLeft") = "N" && both are numeric
|
|
llAutoCenter = .F.
|
|
else && one or both is not numeric, so AutoCenter the form
|
|
tnLeft = 0
|
|
tnTop = 0
|
|
llAutoCenter = .T.
|
|
endif
|
|
endif
|
|
|
|
with thisform
|
|
.lblInputBox.caption = ALLTRIM( tcPrompt)
|
|
.caption = ALLTRIM( tcTitle)
|
|
.xDefaultValue = txDefaultValue
|
|
.xReturnValue = .xDefaultValue
|
|
.txtInputBox.value = .xDefaultValue
|
|
.txtInputBox.format = ALLTRIM( tcFormat)
|
|
.txtInputBox.InputMask = ALLTRIM( tcInputMask)
|
|
.txtInputBox.PasswordChar = tcPasswordChar
|
|
.Top = tnTop
|
|
.Left = tnLeft
|
|
.AutoCenter = llAutoCenter && Set AutoCenter last so it overrides Top and Left if .T.
|
|
|
|
do case
|
|
case type("txDefaultValue") = "D"
|
|
.xEmptyValue = {}
|
|
case type("txDefaultValue") = "N"
|
|
.xEmptyValue = 0
|
|
case type("txDefaultValue") = "Y"
|
|
.xEmptyValue = $0
|
|
otherwise
|
|
.xEmptyValue = ""
|
|
endcase
|
|
endwith
|
|
ENDPROC
|
|
|
|
|
|
PROCEDURE cmdok.Click
|
|
with thisform
|
|
.xReturnValue = .txtInputBox.value
|
|
.release()
|
|
endwith
|
|
ENDPROC
|
|
|
|
|
|
PROCEDURE cmdcancel.Click
|
|
*
|
|
* If Cancel was chosen, return the empty value of the correct data type.
|
|
*
|
|
with thisform
|
|
.xReturnValue = .xEmptyValue
|
|
.release()
|
|
endwith
|
|
ENDPROC
|
|
|
|
|
|
ENDDEFINE
|
|
*
|
|
*-- EndDefine: rbinputbox
|
|
**************************************************
|