High Voltage Shareware/high1.zip/high1/DIR7/FOXTAILS.ZIP/FOXTAILS.PRG

Text File | 1992-06-13 | 31KB | 814 lines

*    Written by R.L. Coppedge
*    Copyright 1992 dbF Software Productions
*    By the way, dbF also has:
*    SysTrak        A Computer Hardware/Software Inventory System
*    Flags        A Flatfile Application Gen. for Executable,db3,4 and Fox
*    ClasAdz        A Classified/Notice system for Networks in Exe and Fox
*    FoxTails #2    A collection of FoxPro tools (like these)
*    Contact dbF for more information.
*    dbF Software Productions
*    P.O. Box 37194
*    Cleve., Ohio 44137-0194
*    CIS: 72117,165
*    Prodigy: XRCG88A
*    [phone]
*
*
Vw = SYS(3)
CREATE VIEW (Vw)
SET TALK OFF
SET SAFETY OFF
SET EXCLUSIVE OFF
SET HELP TO Foxtails
PUSH KEY
ON KEY LABEL F1 HELP
CLEAR WINDOWS
CLEAR
DO Sign WITH "Fox",7,15,"T"
DO Sign WITH "Tails #1",14,5,"L"
=INKEY(5)
CLEAR
DEFINE WINDOW Hooplah FROM 1,5 TO 6,75 DOUBLE TITLE "> The scoop... <"
ACTIVATE WINDOW Hooplah
@0,5 SAY "This program will give you a demonstration"
@1,5 SAY "of the capabilities that FoxTails give you!"
@2,5 SAY "Simply select which tool you want to see."
@3,5 SAY "We'll take care of the rest!     V1.01"
DEFINE WINDOW Arena FROM 7,7 TO 22, 75 DOUBLE TITLE "> The choices... <" FOOTER " Select an Option, or <Esc> To Exit "
ACTIVATE WINDOW Arena
DECLARE Vr(13)
Vr(1) = "WPCONV"
Vr(2) = "SIGN"
Vr(3) = "PICKPOP"
Vr(4) = "MKEY"
Vr(5) = "LOOKUP"
Vr(6) = "GET_DATE"
Vr(7) = "DBFIXED"
Vr(8) = "REORG"
Vr(9) = "STEP"
Vr(10) = "CPACK"
Vr(11) = "REGISTER"
Vr(12) = "HELP"
Vr(13) = "QUIT"
SET TOPIC TO Vr(_Curobj)
Quitting = .F.
*          01234567891123456789212345678931234567894123456789512345678961234
*          *           *            *            *            *            *
@ 0,0 SAY "   Wpconv        Sign        Pickpop       Mkey         Look"
@ 2,0 SAY " Word Perf.      Sign          GET         Keybd        Power"
@ 3,0 SAY " Converter       Maker        Valid       Emulator     Browse"
@ 6,0 SAY "  Get_date      dbFixed       Reorg         Step         Cpack"
@ 8,0 SAY "  Calendar       File         Index         Number       Pack"
@ 9,0 SAY "    Tool       Importer     Rebuilder      Stepper     W/Char's"
@11,5 SAY "Documentation...Register...How do I pay for this thing?"
@12,7 SAY "Help...As in more information...as in...What's Up??"
@13,6 SAY "Outta here!  Exit!!  Adios!!!  Goodbye!!!!  Done!!!!!"
@ 0, 1 GET Ch1 FUNCTION '*IH ;;;;' SIZE 5,12,1 VALID Doit(1) MESSAGE "Choose me to look at some tools!" DEFAULT 1
@ 6, 1 GET Ch2 FUNCTION '*IH ;;;;' SIZE 5,12,1 VALID Doit(2) MESSAGE "Choose me to look at some tools" DEFAULT 1
@11,1 GET Ch3 FUNCTION "*I " SIZE 1,64,1 VALID Doit(3) MESSAGE "Honesty dictates you should read this..." DEFAULT 1
@12,1 GET Ch4 FUNCTION "*I " SIZE 1,64,1 VALID Doit(4) MESSAGE "I need to know more about this!!" DEFAULT 1
@13,1 GET Ch5 FUNCTION "*IT " SIZE 1,64,1 MESSAGE "Outta here!  I'm impressed enough!" DEFAULT 1
READ CYCLE
ACTIVATE SCREEN
@24,0
DEFINE WINDOW Ferret FROM 9,15 TO 23,65 DOUBLE TITLE "...and the dues"
ACTIVATE WINDOW Ferret
@1,2 SAY "If you've enjoyed this and would like to see"
@2,2 SAY "other FoxPro 2.0 Tools (Some of which are even"
@3,2 SAY "more exciting), send $25(US) to:"
@5,2 SAY "dbF Software Productions"
@6,2 SAY "P.O. Box 37194"
@7,2 SAY "Cleve., Ohio 44137-0194"
@8,2 SAY "CIS: 72117,165"
@9,2 SAY "[phone]"
@11,3 SAY "Member ASP"
WAIT WINDOW
CLEAR WINDOWS
SET VIEW TO (Vw)
DELETE FILE (Vw+".VUE")
SET HELP TO
RETURN


FUNCTION Doit
PARAMETER Which
ACTIVATE SCREEN
@24,0
HIDE WINDOW Hooplah, Arena
DO CASE
    CASE Which=1 AND Ch1 = 1        &&    Wpconv
    DO Dwpconv
    CASE Which=1 AND Ch1 = 2        &&    Sign
    DO Dsign
    CASE Which=1 AND Ch1 = 3        &&    Pickpop
    DO Dpickpop
    CASE Which=1 AND Ch1 = 4        &&    Mkey
    DO DMkey
    CASE Which=1 AND Ch1 = 5        &&    Lookup
    DO DLookup
    CASE Which=2 AND Ch2 = 1        &&    Get_date
    DO DGet_Date
    CASE Which=2 AND Ch2 = 2        &&    dbFixed
    DO DdbFixed
    CASE Which=2 AND Ch2 = 3        &&    Reorg
    DO DReorg
    CASE Which=2 AND Ch2 = 4        &&    Step
    DO DStep
    CASE Which=2 AND Ch2 = 5        &&    CPack
    DO DCpack
    CASE Which=3                    &&    Register
    DO Reginfo
    CASE Which=4                    &&    Help
    HELP Help
ENDCASE
SHOW WINDOW Hooplah, Arena
_CUROBJ=11
SHOW GETS
RETURN .T.

PROCEDURE Dwpconv
USE PEOPLE
SET TALK OFF
DEFINE WINDOW WpConv FROM 5,2 TO 19,60 DOUBLE TITLE "WPCONV"
ACTIVATE WINDOW Wpconv
@0,5 SAY "Word Perfect Secondary Text File Creator....."
@2,5 SAY "This will take the database People and create"
@3,5 SAY "a file called Tst.txt which can then be used"
@4,5 SAY "for a Word Perfect MailMerge"
@5,5 SAY "The call for this is a simple:"
@6,15 SAY "=WPCONV('Tst.Txt',@Tst)"
@7,5 SAY "Where we've created an array called 'Tst'"
@8,5 SAY "which contains an element for each field or"
@9,5 SAY "function you want in the Output file 'Tst.Txt'"
@10,5 SAY "See the documentation for information about"
@11,5 SAY "other parameters..."
WAIT WINDOW
DECLARE Tst(8)            &&    We declare the array to be equal to the
Tst(1)= 'F_name'        &&    number of fields we're sending to the
Tst(2)= 'MI'            &&    UDF.  We then fill each one with the
Tst(3)= 'L_name'        &&    NAME of the field, not the value!
Tst(4)= 'Title'
Tst(5)= 'H_Date'
Tst(6)= 'Salary'
Tst(7)= 'Ugly'
Tst(8)= 'DATE()'        &&    Oooh!  Functions work too!
*    We selected ALL of the fields in the People database.  You
*    wouldn't have to (unless so inclined...)
GO TOP
*    Here's where we'd set up a filter or conditional index
*    to select the ones we want.
*    Send a 3rd parameter ('.T.') if you want
*    a blank record to be inserted at the beginning
*    Send a 4th parameter (which would force you to send
*    a 3rd one as well) which would override the default
*    ',' field delimited used by Word Perfect
=WPCONV('Tst.Txt',@Tst)
DO Dsprpt WITH "Demo file of WPConv", "Tst.Txt"
WAIT "We're done...tap any key" WINDOW
CLOSE DATA
RELEASE WINDOW WpConv
RETURN


PROCEDURE DSign
SET TALK OFF
DEFINE WINDOW DSign FROM 0,0 TO 22,79 DOUBLE TITLE "Sign"
ACTIVATE WINDOW DSign
*    We'll do 3 tests.  1st, we'll popup the string "IT'S" starting
*    at position 1,15 from the top with 0 delay.
WAIT "1st, popup a string starting at 1,15 with 0 delay" WINDOW
DO Sign WITH "IT'S",1,15,"T"
*    Next we'll do "FERRET" (always a favourite, don't you agree?)
*    from 8,1 scrolling from the right with a .1 second delay
*    between updates
=INKEY(2)
WAIT "Next, popup a string at 8,1 from the right with .1 Sec delay" WINDOW
DO Sign WITH "FERRET", 8,1,"R",.1
*    And finally, the string "TIME!" appears starting at 15,10
*    scrolling left, also with a .1 delay.
WAIT "Finally, a string at 15,10 from the left with .1 Sec delay" WINDOW
DO Sign WITH "TIME!", 15,10,"L",.01
*    Boy, was that fun!
WAIT WINDOW TIMEOUT 4
RELEASE WINDOW DSign
RETURN


PROCEDURE Dpickpop
*    Ok...this may seem confusing...actually, it may BE confusing, but
*    bear with me.  What we're gonna do is to demonstrate how PICKPOP
*    can be used in a variety of ways...1st we have to USE the databases
*    that Pickpop will call
DEFINE WINDOW Pickpop FROM 4,10 TO 12,70 DOUBLE TITLE "Pickpop"
ACTIVATE WINDOW Pickpop
CLOSE DATA
SET TALK OFF
SELECT 0
USE State ORDER St_Code
SELECT 0
USE Title ORDER Ttle
SELECT 0
USE PEOPLE
*    Now, we define the databases here, as opposed to within PICKPOP
*    itself.  That's because PICKPOP can be used for any number of
*    Popups, as opposed to just one.
DEFINE POPUP Title FROM 10,5 TO 16,32 PROMPT FIELD Ttle TITLE "Choose a Title!"
ON SELECTION POPUP Title DEACTIVATE POPUP Title
DEFINE POPUP State FROM 10,35 TO 13,55 PROMPT FIELD St_code+"│"+St_name ;
TITLE "Choose State!"
ON SELECTION POPUP State DEACTIVATE POPUP State
*    Boy, was that a religious experience!
CLEAR
WAIT "1st, let's use these within a standard GET Situation..." WINDOW
REPLACE People.Title WITH "WallyBurger", People.State WITH "XX"
*    Start out Title and State as illegal values...
@2,10 SAY "Title of person: " GET People.Title DEFAULT SPACE(25) VALID ;
Pickpop("Title","Title","Ttle","People.Title","Title.Ttle",.T.,.F.) ;
ERROR "Bad Title...Evil Title..."
*    Now, what the heck did that VALID Mean?!
*    1st        Db is the name of the database that the popup uses...
*    2nd        is the name of the CDX tag that the popup uses...
*    3rd        is the name of the field to be verified...
*    4th        is the expression to be replaced from the POPUP.
*    5th        Is the expression to be validated a Field?
*    6th        Is this a variable STORE (as opposed to a GET?)
@4,5 SAY "State from whence they came: " GET People.State DEFAULT "  " VALID ;
Pickpop("State","State","St_Code","People.State","State.St_Code",.T.,.F.) ;
ERROR "Bad, Nasty State!"
*    Notice we can use a very similar call to bring up a completely
*    separate Popup!
READ
*    But wait, we're not done!
WAIT "Boy, that was fun!  Now, let's do it in a data initialization..." WINDOW
*    We can also use PICKPOP in a non-GET situation.  Just toggle the
*    last parameter to indicate that it isn't a GET.  Then PICKPOP
*    will automatically bring up the popup!
*    (Sharp-eyed people will also notice that I place a different
*    field name into the "s" variable than the example above).
*    Dull-eyed people will wonder why I defined the variable "s"
*    twice.  The first time is because PICKPOP needs to know what
*    type of variable (ie, character) it's getting into.
CLEAR
@1,10 SAY "We've initialized a variable 'S' into which we"
@2,10 SAY "want to place the selected State code.  Instead"
@3,10 SAY "of the traditional SAY/GET code normally used,"
@4,10 SAY "we use Pickpop as part of a Store or = statement,"
@5,10 SAY "which accomplished the same thing! (Using the"
@6,10 SAY "(same Pickpop code and the same Popup menu!)"
S = ' '
S = Pickpop("State","State","St_Code","S","State.St_name",.F.,.T.)
WAIT "Wow...We Chose the state of: " +S WINDOW
CLOSE DATA
RELEASE WINDOW Pickpop
RETURN


PROCEDURE DMkey
*    Program MKeydemo, which is a sample of the use of
*    the Goshamighty program called Mkey, which allows a user to
*    Actually perform a majority of data entry using just the mouse.
*
*    Now, why would someone want to do that?  Well, as a true couch
*    potato, I could try to claim some level of slouch-saving doing this.
*
*    More importantly (and seriously), it shows how relatively
*    simple it is to maximize the capabilities of the computer
*    for someone who is physically challenged (or whatever the
*    current "politically correct" term is these days) to access
*    programs already written.
*
*    There are other situations where access to the keyboard is limited,
*    I suppose.  Like when my wife hides it from me.
*
*    Now, how would you use this program? Welllll....like this:
*
*    The key thing is to include Mkey(Var, length) in any VALID statement
*    so that it would be called.  It would also help to initialize
*    an OKL so that the Right mouse button calls MKey with the proper
*    parameters.  This would allow the program to be
*    called whenever the user tapped the button.
*    Simple, huh?

*    Well, there are some limitations.  They are as follows:

*    1>    Memo field probably won't work too well here.  I could have
*        included them, and perhaps will in a subsequent release.
*        But they represent a different colored horse story.

*    2>    The field must have some kind of default condition.  If
*        it doesn't, Fox will give it a Logical field type, which
*        is pretty useless.

*    The parameters are stated as such:
*    Mkey((<expC1>, <expC2> , <expL1> [, <expN>])
*    Where:
*    expC1 is the name of the field
*    expC2 is the initial starting value
*    expL1 is it a GET? (a .F. means it's a STORE)
*    expN1 is the maximum length (for Chr and numeric only)
DEFINE WINDOW Dmkey FROM 0,0 TO 22,79 DOUBLE TITLE "MKey!"
ACTIVATE WINDOW Dmkey

ON KEY LABEL RIGHTMOUSE DO Mkey WITH "","",.T.,0

@6,10 SAY "Once MKey is up, simply point and shoot at the"
@7,10 SAY "keyboard that shows up on your screen."
@8,10 SAY "Use the Backspace key on the screen, for"
@9,10 SAY "example, to take the last character off"
@10,10 SAY "the Keyboard Buffer, which is the line just"
@11,10 SAY "under 'Data Entered'."
@12,10 SAY "For our 1st example, let's just enter a Date,"
@13,10 SAY "Defaulted as todays date, by calling:"
@14,10 SAY 'Dt = Mkey("Dt",DATE(),.F.)'
WAIT WINDOW
Dt = Mkey("Dt",DATE(),.F.)
WAIT "You chose: " + DTOC(Dt)+" An Excellent choice!" WINDOW
*    As exciting as that was, let's push on...I'll wait a second
*    while you check your pulse.
*    Now, let's do something a little more common.  Let's call it
*    as part of a VALID statement.
CLEAR
WAIT "Now let's get a couple as part of a GET!" WINDOW
Nm = "Larry Linville      "
@2,10 SAY "We've created an OKL (On Key Label) Command"
@3,10 SAY "using the Rightmouse button to trigger MKey."
@4,10 SAY "Specifically, we said:"
@5,10 SAY 'ON KEY LABEL RIGHTMOUSE DO Mkey WITH "","",.T.,0'
@7,10 SAY "Use the left-Mouse button to highlight the"
@8,10 SAY "Field you want to edit, and then tap the"
@9,10 SAY "Right-Mouse button to call Mkey (and click on 'Done'"
@10,10 SAY "when you're finished)"
@12,15 SAY "Who played 'Ferret Face' on M*A*S*H?" GET Nm
@13,15 SAY "And how much was that worth to him (be nice)?" GET Num ;
    PICTURE "999999" DEFAULT 100000 MESSAGE "Be nice now!"
@15,15 GET Dne PICTURE "@*CT \<Done" DEFAULT .F.
READ CYCLE
*
WAIT "We're done...tap any key" WINDOW
ON KEY LABEL RIGHTMOUSE        &&    Remember to reset the OKL
RELEASE WINDOW Dmkey
RETURN


PROCEDURE Dlookup
SET PROCEDURE TO Lookup
NumLkp = "0"
SELECT A
USE Account ORDER Name IN A
USE Policy ORDER Acct IN B
SET RELATION TO Acc_Pnum INTO Policy
DEFINE WINDOW Acc_Lookup FROM  17, 0 TO 22, 66  FLOAT
ACTIVATE WINDOW Acc_Lookup
@ 0, 1 SAY "<F1>    - Lookup Help"
@ 1, 1 SAY "<F2>    - Edit Account"
@ 2, 1 SAY "<F3>    - Policy (1-Many) Lookup"
@ 3, 1 SAY "Account Lookup Screen - Tap <Esc> to Exit"
PUSH KEY
ON KEY LABEL F1 DO Hlp
ON KEY LABEL F2 DO Edt
ON KEY LABEL F3 DO Pol
DO Lokup WITH "Accounts",' ACCOUNT.ACC_NAME:H="Account Name", ACCOUNT.ACC_PNUM:H="Acc #", ACCOUNT.ACC_STATE:H="State",Fnd=FOUND("Policy"):H="Policy"','';
,5,0,16,70,ALIAS(),'ACCOUNT','','NONE','NONE'
POP KEY
RELEASE WINDOW Acc_lookup
SET PROCEDURE TO
RETURN

PROCEDURE Hlp
*    Part of the Dlookup Routine...this is called when
*    you press the F1 key from the Browse window!
PUSH KEY CLEAR        &&    Remember to Save our old OKL's!
DEFINE WINDOW Hlp FROM 15,5 TO 22,70 DOUBLE TITLE "edit me!"
ACTIVATE WINDOW Hlp
@0,0 SAY "This is help...not much in terms of"
@1,0 SAY "Excitement, but you would put your "
@2,0 SAY "Message here to calm people's nerves..."
X=INKEY(0)
POP KEY        &&    Remember to Reset our old OKL's!
RELEASE WINDOW Hlp
RETURN

PROCEDURE Edt
*    Part of the Dlookup Routine...this is called when
*    you press the F2 key from the Browse window!
PUSH KEY CLEAR        &&    Remember to Save our old OKL's!
DEFINE WINDOW EDT FROM 15,5 TO 22,70 DOUBLE TITLE "edit me!"
ACTIVATE WINDOW Edt
@0,0 SAY "Name: " GET Acc_name
@1,0 SAY "Address: " GET Acc_adrs
READ
POP KEY        &&    Remember to Reset our old OKL's!
RELEASE WINDOW Edt
RETURN

PROCEDURE Pol
*    Part of the Dlookup Routine...this is called when
*    you press the F3 key from the Browse window!
PUSH KEY CLEAR        &&    Remember to Save our old OKL's!
DEFINE WINDOW Pol_Lookup FROM  18, 10 TO 22, 56  FLOAT
ACTIVATE WINDOW Pol_Lookup
@ 0, 1 SAY "Nested Lookup Window"
@ 1, 1 SAY "Neat, huh?"
@ 2, 1 SAY "Policy Lookup Screen - Tap <Esc> to Exit"
DO Lokup WITH "Policy",' Policy.Pol_acct:H="Policy #", Policy.Status:H="Status", Policy.Pol_Date:H="Date"','';
,7,10,15,60,ALIAS(),'Policy','Accounts','Account.Acc_Pnum','Account.Acc_pnum'
POP KEY        &&    Remember to Reset our old OKL's!
RELEASE WINDOW Pol_lookup
RETURN

PROCEDURE Dget_date
*    This is a sample of the use of the AMAZING program Get_date,
*    which allows the user to point and click at a Date
*    which is displayed calendar-style.
*
*    We're gonna do two things with Get_date.  1st, we're going to
*    show how it's used for an original entry of a date.

DEFINE WINDOW DGET_DATE FROM 5,0 TO 20,60 DOUBLE TITLE "Get_Date"
ACTIVATE WINDOW DGet_date
SET TALK OFF
CLEAR
@5,10 SAY "1st Sample...let's just get a date...any date..."
@6,10 SAY "We do that by saying:"
@7,10 SAY "Dt = GET_Date(DATE())"
WAIT WINDOW
Dt = GET_Date(DATE())
WAIT "You chose: " + DTOC(Dt)+" An Excellent choice!" WINDOW

*    Whew! That was tough!  Notice how we called it with the default
*    value equal to today's date.  Clever, huh?  Heck, I thought so.
*    Now, let's do something a little more bizarre.  Let's call it
*    as part of a VALID statement.
CLEAR
@3,5 SAY "Now let's get one as a part of a GET Validation!"
@4,5 SAY "This is a little trickier...we do this by creating"
@5,5 SAY "an additional UDF to do the initial test, which"
@6,5 SAY "in this case is called Wed.  Wed tests the value"
@7,5 SAY "and, if necessary, calls Get_date.  The initial"
@8,5 SAY "Get Statement is:"
@9,5 SAY '@5,15 SAY "..." GET Dt VALID Wed(Dt,"Dt") ERROR ...'
Dt = {01/25/92}
@12,5 SAY "Enter a Date that's a Wednesday " GET Dt ;
    VALID Wed(Dt,"Dt") ERROR "Not a Wednesday, Twit!"
READ
*    Notice how we have the Function Wed actually calling Get_date, as
*    opposed to the VALID statement calling it itself.  That's because
*    Get_date doesn't actually do validation itself, being a shy critter.
*    And yes, I realize you could just say VALID DOW(Dt)=4...lemme alone!
*
WAIT "Boy, was that fun!" WINDOW
RELEASE WINDOW DGet_date
RETURN

FUNCTION Wed
PARAMETER Dte, Nam
DO WHILE DOW(Dte) <> 4        &&    Now here we're gonna loop regardless
    Dte = Get_date(Dte)        &&    of the GET...
    IF LASTKEY() = 27        &&    Did they hit escape?
        EXIT                &&    Well, the outta here!
    ENDIF
    IF DOW(Dte) <> 4        &&    They STILL can't get it right!
        WAIT "Still not Wednesday" WINDOW    &&    Let 'em know
    ENDIF
ENDDO                    &&    Loop till Wednesday, Escape or Power Failure
&Nam = Dte                &&    Replace Get variable with new value
SHOW GETS                &&    Show the new value.
RETURN DOW(Dte)=4        &&    Return .T. or .F. as per normal VALID Return



PROCEDURE Ddbfixed
DEFINE WINDOW Ddbfix FROM 5,5 TO 15,75 DOUBLE TITLE "Demo of DbFixed"
ACTIVATE WINDOW Ddbfix
@1,2 SAY "DbFixed will let you specify a fixed length file with some"
@2,2 SAY "kind of header record (a standard .dbf file would work,"
@3,2 SAY "but it would more likely be a COBOL or other"
@4,2 SAY "non-recognizable kind of file) and help you figure out"
@5,2 SAY "the header and record length by seeing samples of it."
@6,2 SAY "Say, for example, the file People.dbf, which has a header"
@7,2 SAY "length of 290 and a record length of 80."
WAIT
DO Dbfixed
RELEASE WINDOW Ddbfix
RETURN

PROCEDURE Dreorg
DEFINE WINDOW Reorg FROM 2,10 TO 15,70 DOUBLE TITLE "Reorg"
ACTIVATE WINDOW Reorg
@3,5 SAY "There's not much to say about Reorg, except in"
@4,5 SAY "passing...by simply running Reorg all open"
@5,5 SAY "database indexes will be recreated."
@6,5 SAY "You need to be careful, though.  Reorg will NOT"
@7,5 SAY "recreate index tags with Relations in them, nor"
@8,5 SAY "indexes using 'UNIQUE' clauses...so be warned!"
WAIT WINDOW
RELEASE WINDOW Reorg
RETURN


PROCEDURE dStep
PRIVATE X
DEFINE WINDOW Step FROM 1,2 TO 23,70 DOUBLE TITLE "Step"
ACTIVATE WINDOW Step
X=50
@0,5 SAY "This function will let you create arrows to"
@1,5 SAY "Increase or decrease Numeric, Date or Character"
@2,5 SAY "Fields w/out typing in the value"
@4,5 SAY ""        &&    Marker for the Invisible Button #1
@6,5 SAY ""        &&    Marker for the Invisible Button #2
@4,5 GET IncN FUNCTION '*I' SIZE 1,1,1 VALID Step("X","N",45,55,1,.F.) DEFAULT 1 ERROR "Min of 1"
@5,5 GET X VALID BETWEEN(X,45,55) PICTURE "99"
@6,5 GET DecN FUNCTION '*I' SIZE 1,1,1 VALID Step("X","N",45,55,-1,.F.) DEFAULT 1 ERROR "Max of 100"
@ 8,6 SAY "     "        &&    Marker for the Invisible Buttons #3,4,5
@ 9,5 GET Dt DEFAULT DATE()
@10,6 SAY "     "        &&    Marker for the Invisible Buttons #6,7,8
@8, 6 GET IncM FUNCTION '*I' SIZE 1,1,1 VALID Step("Dt","M",{1/1/90},{12/31/94},1,.F.) ;
    DEFAULT 1 ERROR "Min of 1" MESSAGE "Click on me to move 1 Month ahead"
@8, 9 GET IncD FUNCTION '*I' SIZE 1,1,1 VALID Step("Dt","D",{1/1/90},{12/31/94},1,.F.) ;
    DEFAULT 1 ERROR "Min of 1" MESSAGE "Click on me to move 1 Day ahead"
@8,12 GET IncY FUNCTION '*I' SIZE 1,1,1 VALID Step("Dt","Y",{1/1/90},{12/31/94},1,.F.) ;
    DEFAULT 1 ERROR "Min of 1" MESSAGE "Click on me to move 1 Year ahead"
@10, 6 GET DecM FUNCTION '*I' SIZE 1,1,1 VALID Step("Dt","M",{1/1/90},{12/31/94},-1,.F.) ;
    DEFAULT 1 ERROR "Max of 100" MESSAGE "Click on me to move 1 Month back"
@10, 9 GET DecD FUNCTION '*I' SIZE 1,1,1 VALID Step("Dt","D",{1/1/90},{12/31/94},-1,.F.) ;
    DEFAULT 1 ERROR "Max of 100" MESSAGE "Click on me to move 1 Day back"
@10,12 GET DecY FUNCTION '*I' SIZE 1,1,1 VALID Step("Dt","Y",{1/1/90},{12/31/94},-1,.F.) ;
    DEFAULT 1 ERROR "Max of 100" MESSAGE "Click on me to move 1 Year back"

@4, 7 SAY "<---This is an invisible button set up using Step"
@5, 9 SAY "<---A standard # get...the trick's in the Inv. Buttons"
@6, 7 SAY "<---This is an invisible button set up using Step"
@12,5 SAY "Tap on the arrows to increase or decrease by"
@13,5 SAY "1...tap <Escape> when sufficiently impressed"
@15,5 SAY "The Invisible Button's GET Statements look like:"
@16,5 SAY '@6,5 GET Dec FUNCTION "*I" SIZE 1,1,1 VALID ;'
@17,5 SAY 'Step("X","N",45,55,-1,.F.) DEFAULT 1'
@18,5 SAY "Where 'X' is the variable contained in the middle GET"
@19,5 SAY "statement"
READ CYCLE
RELEASE WINDOW Step
RETURN


PROCEDURE DCpack
PRIVATE FVar, PChar
DEFINE WINDOW CPack FROM 2,2 TO 15,60 DOUBLE TITLE "CPack"
ACTIVATE WINDOW CPack
FVar = "Test    "
@0,5 SAY "This function will let you Replace your input,"
@2,5 SAY "Packing it with whatever character you please."
@3,5 SAY "What character would you like to pack with? " GET PChar ;
DEFAULT "0"
@5,5 SAY "Enter something smaller than the field" GET FVar VALID ;
    CPack(Pchar,"",.T.) PICTURE "XXXXXXXXXX"
@7,5 SAY "Tap <Escape> when your excitement level has"
@8,5 SAY "Peaked..."
READ CYCLE
RELEASE WINDOW CPack
RETURN

PROCEDURE Reginfo
DEFINE WINDOW Reg FROM 1,5 TO 23,75 DOUBLE
ACTIVATE WINDOW Reg
SET TOPIC TO "REGISTER"
DO WHILE .T.
    CLEAR
    @0,5 SAY "This software is NOT free, but shareware.  This entitles"
    @1,5 SAY "you to use this software to determine it's suitability."
    @2,5 SAY "If you continue to use it, YOU ARE LEGALLY AND MORALLY"
    @3,5 SAY "BOUND TO REGISTER AND MAKE PAYMENT AS DESCRIBED BELOW."
    @4,5 TO 4,65
    @ 5,5 SAY "dbF Software Productions                 CIS #:    72117,165"
    @ 6,5 SAY "PO Box 37194                    Cleve Free-Net:    AE069"
    @ 7,5 SAY "Cleveland, Ohio 44137-0194               Phone:[phone]"
    @ 8,5 TO 8,65
    @ 9,5 SAY "The fee structure is like this:"
    @10,2 SAY "$25              -   Next upgrade, plus next volume of FoxTails"
    @12,2 SAY "All International orders please add $10."
    @14,25 GET Sp PICTURE ;
        "@*RT \<License Request;\<Order Form;\<dbF Info;\<ASP Info;D\<isclaimer;Do\<cumentation;\!\?\<Quit" ;
        MESSAGE "Choose one" DEFAULT 2
    READ CYCLE
    IF Sp = 7 OR LASTKEY()=27
        RELEASE WINDOW Reg
        SET TOPIC TO Vr(_Curobj)
        SHOW GETS
        RETURN
    ENDIF
    CLEAR
    DO CASE
    CASE Sp = 1
        ?
        ?
        ?
        ? " Please feel free to distribute this system in its original format."
        ? " This package cannot be bundled or distributed with any other"
        ? " software or hardware package without prior written permission,"
        ? " except as a shareware system."
        ? " This software is presented on an as-is basis, with no liability or"
        ? " warranty implied or expressed."
        ? " As a somewhat responsible company, dbF Software will attempt to help"
        ? " parties through whatever difficulties they have with FoxTails.  We"
        ? " cannot accept responsibility for any damages caused by the existance"
        ? " of this package.  In cases where appropriate, we would be happy to"
        ? " develop initial databases for a registered client, and then they can"
        ? " take it from there.  dbF Software also can also provide contract"
        ? " programming in any of the xBase flavors.  Contact us for more info."
        ? " Please support the Shareware concept."
        WAIT WINDOW
    CASE Sp = 2
        @8,10 SAY "Do you want a Printout of the Order Form? " ;
        GET M.Prt PICTURE "@*H \<Yes;\<No" SIZE 1,6,2 DEFAULT 1
        READ
        IF Prt = 2
            LOOP
        ENDIF
        Abrt = .F.
        DO WHILE !PRINTSTATUS()
            WAIT "Printer Not ready! Reset or tap any key to abort print" WINDOW NOWAIT
            N=INKEY()
            IF N<>0
                Abrt = .T.
                EXIT
            ENDIF
        ENDDO
        WAIT CLEAR
        IF Abrt
            LOOP
        ENDIF
        SET PRINTER ON
        SET CONSOLE OFF
        N=ADIR(A,"foxtails.prg")
        ? "                             FoxTails #1"
        IF N<> 0
            ? DTOC(A[3])+"-"+ALLTRIM(STR(A[2]))
        ENDIF
        ? "                             ORDER FORM "
        ?
        ? "Please Enter the following:                       Today's Date:  __/__/__"
        ?
        ? "Name         : __________________________________________"
        ?
        ? "Address #1   :__________________________________________"
        ?
        ? "Address #2   :__________________________________________"
        ?
        ? "City         :__________________________________________"
        ?
        ? "State/Zip    :__________________________________________"
        ?
        ? "Country      :__________________________________________"
        ?
        ? "Day Phone    :__________________________________________"
        ?
        ? "Eve Phone    :__________________________________________"
        ?
        ?
        ? "What kind of diskette do you want to receive?"
        ?
        ? '  _____ 5 1/4"  _____ 3 1/2"'
        ?
        ? "Where did you find FoxTails?"
        ?
        ? "             :__________________________________________"
        ?
        ? "What improvements would you like to see (use more paper if needed)?"
        ?
        ? ":______________________________________________________________"
        ?
        ? ":______________________________________________________________"
        ?
        ? ":______________________________________________________________"
        ?
        ? "Do you want to be on our mailing list  ___YES   ___NO"
        ?
        ?
        ? "Include:  $25"
        ? "Send Form and Money (please add $10 for international orders) to:"
        ?
        ? "dbF Software Productions          (please make checks payable"
        ? "PO Box 37194                       to dbF Software)"
        ? "Cleveland, Ohio 44137-0194"
        ?
        ? "Please allow several weeks for delivery."
        SET PRINTER OFF
        SET CONSOLE ON
        EJECT

    CASE Sp = 3
        CLEAR
        ? " Glad you asked!  dbF Software Productions is a software"
        ? " company with *you* the end user in mind.  FoxTails #1 is our"
        ? " fourth released product, along with these other shareware"
        ? " systems:"
        ? " SysTrak        A Computer Hardware/Software Inventory System"
        ? " Flags          A Flatfile Application Gen. for db3,4 and Fox"
        ? " ClasAdz        A classified ad/notice system"
        ?
        ? " dbF Software is interested in hearing about ideas of applications"
        ? " you'd like to see.  Those people interested in helping us design"
        ? " the systems would get first crack at them (and vice versa)."
        ? " You're where we get our ideas!  Let us know what you want!"
        ? " Also, each registered dbF user will receive a free copy of"
        ? " another dbF release, along with their registered product."
        @15, 5 SAY "Would you like to learn more about:"
        DO WHILE .T.
            @16,5 GET Sys PICTURE "@*RT \<SysTrak;\<Clas Adz;\<Flags;F\<ox Tails #1;\?\<Quit" ;
            MESSAGE "Choose one" DEFAULT 1
            READ CYCLE
            DO CASE
            CASE Sys = 1
                DO Dsprpt WITH "Systrak Description Screen", "Systrak.Scr"
            CASE Sys = 2
                DO Dsprpt WITH "Clas Adz", "Adz.Scr"
            CASE Sys = 3
                DO Dsprpt WITH "Flags Description Screen", "Flags.Scr"
            CASE Sys = 4
                DO Dsprpt WITH "FoxTails #1 Description Screen", "FTails.Scr"
            CASE Sys = 5
                EXIT
            ENDCASE
        ENDDO

    CASE Sp = 4
        CLEAR
        ? " This program is produced by a member of the Association of"
        ? " Shareware Professionals (ASP). ASP wants to make sure that"
        ? " the shareware principle works for you. If you are unable to"
        ? " resolve a shareware-related problem with an ASP member by"
        ? " contacting the member directly, ASP may be able to help."
        ? " The ASP Ombudsman can help you resolve a dispute or problem"
        ? " with an ASP member, but does not provide technical support"
        ? " for members' products. Please write to the ASP Ombudsman at"
        ? " 545 Grover Road, Muskegon, MI 49442 or send a CompuServe"
        ? " message via CompuServe Mail to ASP Ombudsman 70007,3536."
        WAIT WINDOW

    CASE Sp = 5
        CLEAR
        ? "                      DISCLAIMER OF WARRANTY"
        ?
        ? " THIS SOFTWARE AND MANUAL ARE SOLD 'AS IS' AND WITHOUT WARRANTIES"
        ? " AS TO PERFORMANCE OF MERCHANTABILITY OR ANY OTHER WARRANTIES"
        ? " WHETHER EXPRESSED OR IMPLIED.  BECAUSE OF THE VARIOUS HARDWARE"
        ? " AND SOFTWARE ENVIRONMENTS INTO WHICH THIS PROGRAM MAY BE PUT, NO"
        ? " WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE IS OFFERED."
        ?
        ? " GOOD DATA PROCESSING PROCEDURE DICTATES THAT ANY PROGRAM BE"
        ? " THOROUGHLY TESTED WITH NON-CRITICAL DATA BEFORE RELYING ON IT. "
        ? " THE USER MUST ASSUME THE ENTIRE RISK OF USING THE PROGRAM.  ANY"
        ? " LIABILITY OF dbF SOFTWARE PRODUCTIONS ITS PRINCIPALS WILL BE"
        ? " LIMITED EXCLUSIVELY TO PRODUCT REPLACEMENT OR REFUND OF PURCHASE"
        ? " PRICE."
        ?
        ? " So there!"
        WAIT WINDOW

    CASE Sp = 6
    *    Print out documentation
        CLEAR
        @5,5 SAY "Documentation is included in a file called"
        @6,5 SAY "'FoxTails.Doc', located (on installation,"
         @7,5 SAY "anyway) in "+ALLTRIM(CURDIR())+".  The other file contains"
        @8,5 SAY "information updated in FoxTails too recently"
        @9,5 SAY "to be included in 'FoxTails.DOC', and is called"
        @10,5 SAY "'README.DOC', also located in "+ALLTRIM(CURDIR())+"."
        @12,5 SAY "Which do you want do:"
        @14,5 GET Whch PICTURE "@*RV \<Main Doc;\<Readme Doc;\<Both" DEFAULT 1
        @14,30 GET Scr PICTURE '@*C \<Printer' DEFAULT 1
        @16,30 GET ch FUNCTION '*T \!\<OK;\?\<Cancel' DEFAULT 1
        READ CYCLE
        SET HEADING OFF
        IF Ch = 2
            LOOP
        ENDIF
        IF Whch <> 1        &&    Readme Doc
            DO CASE
            CASE !FILE('README.DOC')
                WAIT "I can't find the README.DOC file in "+ALLTRIM(CURDIR()) WINDOW
            CASE Scr = 1
                SET CONSOLE OFF
                TYPE README.DOC TO PRINT
                SET CONSOLE ON
                EJECT
            OTHERWISE
                DO Dsprpt WITH "Readme File","Readme.Doc"
            ENDCASE
        ENDIF
        IF Whch <> 2        &&    Main Doc
            DO CASE
            CASE !FILE('Foxtails.DOC')
                WAIT "I can't find the FOXTAILS.DOC file in "+ALLTRIM(CURDIR()) WINDOW
            CASE Scr = 1
                SET CONSOLE OFF
                TYPE Foxtails.doc TO PRINT
                SET CONSOLE ON
                EJECT
            OTHERWISE
                DO Dsprpt WITH "Foxtails Doc","FoxTails.Doc"
            ENDCASE
        ENDIF
    ENDCASE
ENDDO
RETURN