*-------------------------------------------------------- * 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 **************************************************