Here is my version of MakeBase.prg. (It stopped at VFP8 --- just add
any new ones from 9 into LBCLASS procedure.)
---------------------------------------------------------------
************************************************************************
*******************
* Program: Makebase - create a classlib of all base classes
* Each Classname will be the standard abbreviation for that Class
************************************************************************
*******************
************************************************************************
*******************
************************************************************************
*******************
LOCAL lcName,lcCName,lcNameSuffix,lcClassLib,lcTxtBaseName,lcFile
*** for backward compatibility only: delete old text file
if FILE("bclass.txt")
lcFile = FULLPATH("bclass.txt")
delete file (m.lcFile)
endif
do lbClass && create new one "on the fly"
CREATE CURSOR Bclass ( cPrefix C(3), cName C(20) )
APPEND FROM Bclass.txt DELIMITED
lcNameSuffix = "Base"
lcTxtBaseName = ""
**** Get input of the name of the base class libraries
lcNameSuffix = INPTCBO("Suffix for Class Names ('txtMine' the 'Mine'
part)",;
lcNameSuffix,;
"@! #"+repl("A",7))
lcClassLib = getfile("VCX","Your Class Library")
if empty(lcClassLib)
return
endif
lcTxtBaseName = "txt"+m.lcNameSuffix
GO TOP
SCAN
lcName = cPrefix
lcCName = ALLTRIM(LOWER(cName))
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
MODIFY CLASS (m.lcName+m.lcNameSuffix) OF (m.lcClassLib) AS
(m.lcCName) && NOWAIT
ENDSCAN
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
**** create some special classes, just to be a nice guy
MODIFY CLASS (m.lcTxtBaseName+"Currency") OF (m.lcClassLib) AS
(m.lcTxtBaseName) FROM (m.lcClassLib) && NOWAIT
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
MODIFY CLASS (m.lcTxtBaseName+"Date") OF (m.lcClassLib) AS
(m.lcTxtBaseName) FROM (m.lcClassLib) && NOWAIT
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
MODIFY CLASS (m.lcTxtBaseName+"DateTime") OF (m.lcClassLib) AS
(m.lcTxtBaseName) FROM (m.lcClassLib) && NOWAIT
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
MODIFY CLASS (m.lcTxtBaseName+"Integer") OF (m.lcClassLib) AS
(m.lcTxtBaseName) FROM (m.lcClassLib) && NOWAIT
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
MODIFY CLASS (m.lcTxtBaseName+"Numeric") OF (m.lcClassLib) AS
(m.lcTxtBaseName) FROM (m.lcClassLib) && NOWAIT
KEYBOARD "{CTRL+F4}"
KEYBOARD "{Y}"
MODIFY CLASS (m.lcTxtBaseName+"Double") OF (m.lcClassLib) AS
(m.lcTxtBaseName) FROM (m.lcClassLib) && NOWAIT
if FILE("bclass.txt")
lcFile = FULLPATH("bclass.txt")
delete file (m.lcFile)
endif
PROCEDURE LBCLASS
set print to bclass.txt
set print on
set console off
* a listing of all Base Classes and VFP suggested abbreviations
??'"acd","Activedoc"'
? '"chk","Checkbox"'
? '"cbo","Combobox"'
? '"cmd","Commandbutton"'
? '"cmg","Commandgroup"'
? '"cnt","Container"'
? '"cst","Custom"'
? '"ctl","Control"'
? '"edt","Editbox"'
? '"frm","Form"'
? '"frs","Formset"'
? '"grd","Grid"'
? '"hpl","Hyperlink"'
? '"img","Image"'
? '"lbl","Label"'
? '"lin","Line"'
? '"lst","Listbox"'
? '"opb","OptionButton"'
? '"opg","Optiongroup"'
? '"olb","OleBoundControl"'
*? '"ole","OLE"'
? '"pgf","Pageframe"'
? '"prh","Projecthook"'
? '"sep","Separator"'
? '"shp","Shape"'
? '"spn","Spinner"'
? '"txt","Textbox"'
? '"tmr","Timer"'
? '"tlb","Toolbar"'
#if VERSION() = "Visual FoxPro 08"
*? '"grc","Column"'
*? '"grh","Header"'
? '"col","Collection"'
? '"dte","DataEnvironment"'
? '"pag","Page"'
? '"xad","XMLAdapter"'
? '"xfd","XMLField"'
? '"xtb","XMLTable"'
? '"rel","Relation"'
#endif
set print off
set print to
set console on
FUNCTION INPTCBO
*--------------------------------------------------------
* Function Name.: InptBox() for Visual FoxPro
* kbk changed name since VFP now has this natively
* Adapted again for a combobox
*
* Author........: Rick Borup
* Information Technology Associates
* Champaign, IL U.S.A.
* http://www.prairienet.org/ita
* [EMAIL PROTECTED]
*
* Date Written..: March 20, 2000
*
* Date Released.: April 27, 2000
*
* Abstract......: A simple, general-purpose input box for Visual FoxPro.
*
* Parameters....: (All parameters are optional.)
*
***** >> I don't want a separate prompt, just use the Title
* 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, InputBox()
* is auto-centered.
*
* tcFormat - a value for the Format property of the textbox
*
* tcInputMask - a value for the InputMask property of the textbox
*
* Returns.......: Character, Date, Numeric, or Currency depending
* on the data type of the default value >> or .Null.
*
* If the Cancel button is chosen, InputBox() returns
* >> KBK .NULL.
* >> an empty value of the appropriate data type.
*
* Copyright.....: Copyright (c) Information Technology Associates, 2000
*
* License.......: InputBox() is freeware. You may include InputBox()
* 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 InputBox() 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 [EMAIL PROTECTED] or
* reach me via the Universal Thread at
* http://www.universalthread.com.
*
* Release History:
* April 27, 2000 - Original Release
*
* Known Limitations:
* The original release of InputBox 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 InputBox
lparameters tcTitle, txDefaultValue, tnLeft, tnTop, ;
tcFormat, tcInputMask
private pcReturnValue
pcReturnValue = .NULL.
local oInputBox
oInputBox = CreateObject("ITA_InputBox", tcTitle, ;
txDefaultValue, tnLeft, tnTop, ;
tcFormat,
tcInputMask)
oInputBox.Show()
RETURN pcReturnValue
**************************************************
*-- Class: ITA_InputBox
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 04/27/00 10:41:07 AM
*
DEFINE CLASS ITA_InputBox as Form
Height = 113
Width = 318
DoCreate = .T.
AutoCenter = .T.
Caption = "Enter Value"
ControlBox = .F.
WindowType = 1
Name = "frmInputBox"
xDefaultValue = .F. && The default value (if any).
xEmptyValue = .NULL. && Empty value to return if Cancel is chosen.
xReturnValue = .NULL. && The return value.
*!* ADD OBJECT lblInputBox AS lblKBK WITH ;
*!* Alignment = 1, ;
*!* Caption = "Enter the value", ;
*!* FontName = "Arial", ;
*!* FontSize = 9, ;
*!* Height = 20, ;
*!* Left = 6, ;
*!* Top = 26, ;
*!* Width = 190, ;
*!* TabIndex = 1, ;
*!* Name = "lblInputBox"
ADD OBJECT cboInputBox as Combobox WITH ;
Century = 1, ;
FontName = "Arial", ;
FontSize = 9, ;
Height = 24, ;
Left = 10, ;
SelectOnEntry = .T., ;
TabIndex = 2, ;
Top = 10, ;
Width = 110, ;
margin = 1,;
RowSourceType = 1,;
RowSource =
"Base,_Base,Mine,_Mine,Core,_Core,Prima,Adam,Mother,Mutha,Fatha"
Name = "cboInputBox"
ADD OBJECT cmdOK as commandbutton WITH ;
Caption = "\<OK", ;
Height = 50, ;
Left = 84, ;
Top = 62, ;
Width = 72, ;
TabIndex = 3, ;
Default = .T., ;
Name = "cmdOK",;
Picture = "ok.bmp"
ADD OBJECT cmdCancel as commandbutton WITH ;
Caption = "\<Cancel", ;
Height = 50, ;
Left = 172, ;
Top = 62, ;
Width = 72, ;
TabIndex = 4, ;
Cancel = .T., ;
Name = "cmdCancel",;
Picture = "cancel.bmp"
PROCEDURE Init
lparameters tcTitle, txDefaultValue, tnLeft, tnTop, ;
tcFormat, tcInputMask
local lcValueType,llAutoCenter,lnProposedWidth
m.lcValueType = type("txDefaultValue") && Type of
value passed
if type("tcTitle") <> "C"
tcTitle = "Enter Value"
endif
if !(lcValueType $ "CDNY")
* Valid input data types are C, D, N, and Y
txDefaultValue = "" && default to character data
type
endif
if type("tcFormat") <> "C"
if m.lcValueType = "Y"
tcFormat = "R$"
else
tcFormat = ""
endif
endif
if type("tcInputMask") <> "C"
if inlist(m.lcValueType,"Y","N")
if txDefaultValue%1 > 0
tcInputMask = "99,999,999.99"
else
tcInputMask = "999,999,999"
endif
else
tcInputMask = ""
endif
endif
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
.caption = ALLTRIM( tcTitle)
.xDefaultValue = txDefaultValue
.xReturnValue = .xDefaultValue
.cboInputBox.value = .xDefaultValue
.cboInputBox.format = ALLTRIM( tcFormat)
.cboInputBox.InputMask = ALLTRIM( tcInputMask)
lnProposedWidth =
max(110,len(.cboInputBox.InputMask)*7.4)
if lnProposedWidth < (.Width - 20)
.cboInputBox.Width = lnProposedWidth
else
.cboInputBox.Width = (.Width - 20)
.cboInputBox.Height = .cboInputBox.Height*2
endif
.Top = tnTop
.Left = tnLeft
.AutoCenter = llAutoCenter && Set
AutoCenter last so it overrides
Top and Left if .T.
***** >> Want to return .Null. if empty
*do case
*case m.lcValueType = "D"
* .xEmptyValue = {}
*case m.lcValueType = "N"
* .xEmptyValue = 0
*case m.lcValueType = "Y"
* .xEmptyValue = $0
*otherwise
* .xEmptyValue = ""
*endcase
endwith
ENDPROC
PROCEDURE Unload
with thisform
if type(".xReturnValue") = "C"
.xReturnValue = ALLTRIM( .xReturnValue)
endif
if !empty(.xReturnValue)
pcReturnValue = .xReturnValue
endif
endwith
ENDPROC
PROCEDURE cmdOK.Click
with thisform
if !empty(.cboInputBox.displayvalue)
.xReturnValue =
ALLTRIM(.cboInputBox.Displayvalue)
endif
.release()
endwith
ENDPROC
PROCEDURE cmdCancel.Click
*
* If Cancel was chosen, return the empty value of the
correct data
type.
*
wait window "Cancelled..." nowait
with thisform
.xReturnValue = .xEmptyValue
.release()
endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: ITA_InputBox
**************************************************
_______________________________________________
Post Messages to: [email protected]
Subscription Maintenance: http://leafe.com/mailman/listinfo/profox
OT-free version of this list: http://leafe.com/mailman/listinfo/profoxtech
Searchable Archive: http://leafe.com/archives/search/profox
This message: http://leafe.com/archives/byMID/profox/[EMAIL PROTECTED]
** All postings, unless explicitly stated otherwise, are the opinions of the
author, and do not constitute legal or medical advice. This statement is added
to the messages for those lawyers who are too stupid to see the obvious.
