Initial commit - tasks v1.1.14
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
279
programe/rbinputbox.prg
Normal file
279
programe/rbinputbox.prg
Normal file
@@ -0,0 +1,279 @@
|
||||
*--------------------------------------------------------
|
||||
* 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
|
||||
**************************************************
|
||||
Reference in New Issue
Block a user