Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/DATABASE/DB3STOCK.ZIP/DB3STOCK.TXT

Text File | 1986-04-12 | 15.4 KB | 527 lines

procedure bigboxdt
* -----------------------------------------------------
* BIGBOXDT - draws a large box for major screen display
* -----------------------------------------------------
* define HEADER as a str < 60 chars before entering this routine
SET COLOR TO 7/0
@ 1,0 SAY "╔══════════════════════════════════════════════════════"
@ 1,55 SAY "═══════════════════════╗"
L=2
DO WHILE L<24
   @ L,0 SAY "║"
   @ L,78 SAY "║"
   L=L+1
ENDDO
@ 24,0 SAY "╚══════════════════════════════════════════════════════"
@ 24,55 SAY "═══════════════════════╝"
@ 3, 1 SAY "---------------------------------------"
@ 3,40 SAY "--------------------------------------"
@ 2,3 say date()
@ 2,69 say time()
* H E A D E R  programming set up below
set color to 15/0
@ 2,(80-len(header))/2 say header
set color to 7/0
RETURN

procedure boxclear
* ---------------------------------------------------------------
* BOXCLEAR.prg - a routine that clears the screen INSIDE BIGBOXDT
* ---------------------------------------------------------------
* define LN BEFORE coming into this routine
do while ln<24
   @ ln,1 say space(77)
   ln=ln+1
enddo
RETURN


procedure smallbox
* -----------------------------------------------------------
* SMALLBOX.prg - a routine that draws a smaller box on screen
* -----------------------------------------------------------
@ 4,12 SAY "┌───────────────────────────────────────────────────────┐"
L=5
DO WHILE L<21
   @ L,12 SAY "│"
   @ L,68 SAY "│"
   L=L+1
ENDDO
@21,12 SAY "└───────────────────────────────────────────────────────┘"
RETURN

procedure lineboxm
* ------------------------------------------------------------------
* LINEBOXM.prg - draws a single line box in the middle of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
@ 11,12 SAY "┌───────────────────────────────────────────────────────┐"
@ 12,12 SAY "│"
@ 12,68 SAY "│"
@ 13,12 SAY "└───────────────────────────────────────────────────────┘"
set color to 15/0
@12,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure slinboxm
* ------------------------------------------------------------------
* SLINBOXM.prg - draws a single line box in the middle of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
SET COLOR TO 7/0
@ 11,12 SAY "┌───────────────────────────────────────────────────────┐"
@ 12,12 SAY "│"
@ 12,68 SAY "│"
@ 13,12 SAY "└───────────────────────────────────────────────────────┘"
set color to 15/0
@12,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure slinboxt
* ------------------------------------------------------------------
* SLINBOXT.prg - draws a single line box at the top of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
SET COLOR TO 7/0
@  1,12 SAY "┌───────────────────────────────────────────────────────┐"
@  2,12 SAY "│"
@  2,68 SAY "│"
@  3,12 SAY "└───────────────────────────────────────────────────────┘"
set color to 15/0
@ 2,(80-len(msg))/2 say msg
set color to 7/0
RETURN

procedure slinboxb
* ------------------------------------------------------------------
* SLINBOXB.prg - draws a single line box at the bottom of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
SET COLOR TO 7/0
@ 22,12 SAY "┌───────────────────────────────────────────────────────┐"
@ 23,12 SAY "│"
@ 23,68 SAY "│"
@ 24,12 SAY "└───────────────────────────────────────────────────────┘"
set color to 15/0
@23,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure dlinboxm
* ------------------------------------------------------------------
* DLINBOXM.prg - draws a double line box at the middle of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
SET COLOR TO 7/0
@ 11,12 SAY "╔═══════════════════════════════════════════════════════╗"
@ 12,12 SAY "║"
@ 12,68 SAY "║"
@ 13,12 SAY "╚═══════════════════════════════════════════════════════╝"
set color to 15/0
@12,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure dlinboxt
* ------------------------------------------------------------------
* DLINBOXT.prg - draws a double line box at the top of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
SET COLOR TO 7/0
@  1,12 SAY "╔═══════════════════════════════════════════════════════╗"
@  2,12 SAY "║"
@  2,68 SAY "║"
@  3,12 SAY "╚═══════════════════════════════════════════════════════╝"
set color to 15/0
@ 2,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure dlinboxb
* ------------------------------------------------------------------
* DLINBOXB.prg - draws a double line box at the bottom of the screen
* ------------------------------------------------------------------
* define MSG as a str <55 chars before entering this routine
SET COLOR TO 7/0
@ 22,12 SAY "╔═══════════════════════════════════════════════════════╗"
@ 23,12 SAY "║"
@ 23,68 SAY "║"
@ 24,12 SAY "╚═══════════════════════════════════════════════════════╝"
set color to 15/0
@23,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure linprm23
* --------------------------------------
* LINPRM23.PRG - GET A PARTICULAR KEY
* --------------------------------------
* define MSG as a str <75 chars before entering this routine
* define TEST as a target string of chars to test FOR
* define TZ as PUBLIC, and then initialize to " " before using this routine
@ 23,1 say space(77)
set color to 15/0
@ 23,(80-len(msg))/2 say msg
set color to 7/0
tz=" "
do while at(tz,test)=0
   tz=" "
   CLEAR GETS
   tkol=((80-len(msg))/2)+len(msg)+2
   if tkol>77
      tkol=77
   endif
   @ 23,tkol get tz picture "!"
   read
enddo
set color to 7/0
@ 23,1 SAY SPACE(77)
RETURN

procedure linmsg23
* --------------------------------------
* LINMSG23.PRG - GET ANY KEY TO CONTINUE
* --------------------------------------
* define MSG as a str <75 chars before entering this routine
@ 23,1 say space(77)
set color to 15/0
@ 23,(80-len(msg))/2 say msg
set color to 7/0
zz=" "
tkol=((80-len(msg))/2)+len(msg)+2
if tkol>77
   tkol=77
endif
@ 23,tkol get zz
read
set color to 7/0
@ 23,1 SAY SPACE(77)
RETURN


procedure prtmsg23
* --------------------------------------------------------------
* PRTMSG23.PRG - prints a message ONLY on line 23; no gets/reads
* --------------------------------------------------------------
* define MSG as a str <75 chars before entering this routine
@23,1 say space(77)
set color to 15/0
@23,(80-len(msg))/2 say msg
set color to 7/0
RETURN


procedure getfld23
* --------------------------------------
* GETFLD23.PRG - GET A PARTICULAR FIELD
* --------------------------------------
* define KOL as 0 before entering the routine.
* define FEELD as any EMPTY string of any length.
* define MSG as a str <75 chars before entering this routine
* the variable KOL is now the new column position at which to GET the field
msg=msg+"  "+feeld
@ 23,1 say space(77)
set color to 15/0
@ 23,(80-len(msg))/2 say msg
set color to 7/0
kol=col()-len(feeld)
if kol>77
   kol=77
endif
RETURN



procedure prevmo
* ----------------------------------------------------------
* Prevmo.prg -- finds the ACTUAL month of the previous month
* ----------------------------------------------------------
* must define PMONTH as a blank string BEFORE entering this routine
Tmonth=substr(dtoc(date(),1,2)+"/"+substr(dtoc(date(),7,2)
Pmo=ctod(substr(Tmonth,1,2)+"/15/"+substr(Tmonth,4,2))
Pmo=Pmo-30
Pmonth=substr(dtoc(Pmo),1,2)+"/"+substr(dtoc(Pmo),7,2)
RETURN

procedure nextmo
* ----------------------------------------------------------
* Nextmo.prg -- finds the ACTUAL month of the next month
* ----------------------------------------------------------
*  must define NMONTH as a blank string BEFORE entering this routine
Tmonth=substr(dtoc(date(),1,2)+"/"+substr(dtoc(date(),7,2)
Nmo=ctod(substr(Tmonth,1,2)+"/15/"+substr(Tmonth,4,2))
Nmo=Nmo+30
Nmonth=substr(dtoc(Nmo),1,2)+"/"+substr(dtoc(Nmo),7,2)
RETURN

procedure passwerd
* -------------------------------------------------------------
* PASSWERD.PRG - COMPLETE SECURITY PROGRAM FOR AUTHORIZED USERS
* -------------------------------------------------------------
use SECURITY.dbf
go top
delete all for enterok=space(12)
pack
go top
mastrpass=trim(enterok)
header="Authorized Users Check"
do bigboxdt
ct=1
password=space(12)
nupasswd=space(12)
MSG=" "
do dlinboxm
do while .t.
   @ 12,14 say space(50)
   password=space(12)
   @ 12,23 say "Enter your PASSWORD:  "
   SET console Off
   ACCEPT TO PASSWORD
   SET console ON
   @ 12,14 say space(50)
   @ 12,20 say "Checking authorized users.  Please wait."
   password=upper(password)
   nupass=""
   z=1
   do while z<len(password)+1
      tz=asc(substr(password,z,1))+117
      nupass=nupass+chr(tz)
      z=z+1
   enddo
   go top
   locate for nupass=trim(enterok)
   if eof()
      @ 12,14 say space(50)
      ct=ct+1
      if ct>5
         set color to 15/0
         @ 12,21 say "I think you are an unauthorized user."
         set color to 7/0
         set console off
         set escape off
         do while .t.
            loop
         enddo
       else
         msg="Wrong SECURITY CODE.  Press any key to continue."
         do linmsg23
         loop
      endif
   endif
   if nupass<>mastrpass
      exit
   endif
   * ---------------------------------------
   * PASSWORD ADDITION ROUTINE follows here:
   * ---------------------------------------
   do while .t.
      @ 12,14 say space(50)
      @ 12,21 say "Enter a password to add:  "
      set console OFF
      ACCEPT TO NUPASSWD
      nupasswd=upper(nupasswd)
      set console on
      nupass=""
      nupasswd=trim(nupasswd)
      z=1
      do while z<len(nupasswd)+1
         tz=asc(substr(nupasswd,z,1))+117
         nupass=nupass+chr(tz)
         z=z+1
      enddo
      append blank
      replace enterok with nupass
      msg="Enter another NEW password?  <Y/N>  "
      test="YN"
      do linprm23
      if tz="Y"
         loop
        else
         exit
      endif
   enddo
   * -----------------------------------
   * PASSWORD ADDITION ROUTINE ends here
   * -----------------------------------
enddo
use
set color to 15/0
@ 23,6 say "The System identifies you.  Welcome!  Please wait."
set color to 7/0
RETURN


* ----------------------------------------------------------------------
* END OF USEABLE DBASE III SUBROUTINES;  TEXT   O N L Y   FOLLOWS BELOW:
* ----------------------------------------------------------------------


* ---------------------------------
* Displrut.prg
* ---------------------------------
This is actually a text file, not a program.  The dBASE routine below
here is merely an example of a way to set up REPORT DETAIL data to BOTH
SCREEN AND PRINTER with a MINIMUM of programming code/effort!


You must use the following variables:

(AND THEY MUST BE DEFINED and initialized  B E F O R E   invoking the
LINCOUNT.PRG subroutine.  THIS IS EXTREMELY IMPORTANT!)


      devicetest =  a one-character variable that contains ONLY "S" or "P"
                    Makes sense -- is the device a <s>creen or <p>rinter?
      Ppage      =  Printer page count.  IT MUST BE INITIALIZED TO ZERO (0)
                    before going to LINCOUNT.PRG!
      Spage      =  Screen page count.  IT MUST BE INITIALIZED TO ZERO (0)
                    before going to LINCOUNT.PRG!
      lc         =  The variable that "points" to the current printer
                    or screen line position.  This is a numeric variable.
      overmax    =  a T/F logic variable that points to whether you are
                    "over the max" # of lines allowed
      stopflag   =  a T/F logic variable that is use only in LINCOUNT that
                    determines whether user does NOT want to continue
                    scrolling through page after page of display.
      linemax    =  used by LINCOUNT.prg to determine the proper # of
                    lines to use for screen (21) or printer (56).  This
                    is a numeric variable.
      header1    =  a string which contains the main one-liner heading
                    for this display.  It should be useable for BOTH
                    screen and printer.


Other Notes:
-----------
Notice that LINCOUNT.PRG does not clear the screen per se; it assumes you
using BOXCLEAR to clear out BIGBOXDT, and you want to preserve those lines!


* ---------------------------------
* Dummy  D I S P L A Y   PROGRAM
* ---------------------------------
* this program does not run!  It is merely a subroutine from an actual larger
* application, but it is included here for study and later incorporation into
* your own work.  All variables in UPPERCASE signify variables that
* are detail or header variables that were specific to my application;
* they have no other significance in the routine beyond informational purposes.
* Notice, too, that some of the DO <subroutine> calls are to the subroutines
* listed above.
*

lc=99
stopflag=.f.
overmax=.f.
do while .not. eof()
   DO LINCOUNT
   *
   *                  SEE LINCOUNT.PRG BELOW!
   *
   if stopflag .and. devicetest="S"
      exit
   endif
   if overmax
      lc=4
      if devicetest="S"
         set color to 15/0
      endif
      @ lc,(80-len(HEADER1))/2 say HEADER1
      if devicetest="S"
         set color to 7/0
      endif
      lc=lc+1
      if devicetest="P"
         @ lc,17 say date()
         @ lc,60 say time()
         lc=lc+2
      endif
      @ lc,5 say "SHORT NAME CLIENT NAME"
      lc=lc+1
      @ lc,5 say "-----------------------------------------------------------------------"
      lc=lc+1
      overmax=.f.
   endif
   if devicetest="S"
      set color to 15/0
   endif
   @ lc, 7 say ALFAPREFIX
   if devicetest="S"
      set color to 7/0
   endif
   @ lc,17 say NAME
   *
   *
   * -----------------------------------
   * CONTINUE WITH DETAIL REPORT DISPLAY
   * -----------------------------------
   *
   *
   lc=lc+1
   skip
enddo
firstloop=.T.
if devicetest="S" .and. .not. stopflag
   msg="Press any key to continue."
   do linmsg23
endif
if devicetest="P"
   eject
   set device to screen
endif


* -------------------------
* L I N C O U N T . P R G
* -------------------------

If devicetest="P" .and. lc>linemax
   overmax=.t.
   Ppage=Ppage+1
   if Ppage>1
      eject
      @ 2,70 say "Page "+str(Ppage,3,0)
   endif
endif

If devicetest="S" .and. lc>linemax
   overmax=.t.
   Spage=Spage+1
   if Spage<2
      lc=4
      do while lc<24
         @ lc,1 say space(77)
         lc=lc+1
      enddo
   endif
   if Spage>1
      test="CS"
      msg="<C>ontinue with the display or <S>top the display?"
      do linprm23
      if tz="S"
         stopflag=.t.
         RETURN
      endif
      lc=4
      do while lc<24
         @ lc,1 say space(77)
         lc=lc+1
      enddo
      set color to 15/0
      @ 4,69 say "Page "+str(Spage,3,0)
      set color to 7/0
      lc=5
   endif
endif
RETURN