home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 September
/
Simtel20_Sept92.cdr
/
msdos
/
clipper
/
nannws33.arc
/
MOVE.PRG
< prev
next >
Wrap
Text File
|
1988-11-01
|
2KB
|
104 lines
* Program: Move.prg
* Author: Don L. Powells
* Version: Clipper Summer '87
* Note(s): Collection of routines that automate the data deposit
* and withdrawal process.
*
* Copyright (c) 1988 Nantucket Corp.
* Mempty() - Initialize field variables with empty value.
*
FUNCTION Mempty
IF LEN(ALIAS()) !=0
FOR i = 1 TO FCOUNT()
mfield = FIELDNAME(i)
fieldvar = "m" + mfield
IF type("&mfield") = "C"
&fieldvar = SPACE(LEN(&mfield))
ELSEIF type("&mfield") = "N"
&fieldvar = 0
ELSEIF type("&mfield") = "D"
&fieldvar = CTOD(" / / ")
ELSEIF type("&mfield") = "L"
&fieldvar = .F.
ELSEIF type("&mfield") = "M"
&fieldvar = SPACE(512)
ENDIF
NEXT
ELSE
BEEP("BOZO")
Err_msg("No database file is open. ")
BREAK && Abort Add/Edit routine
ENDIF
RETURN(.T.)
* Fld2mem() - Assign fields to field memory variables.
*
FUNCTION Fld2mem
IF LEN(ALIAS()) != 0
FOR i = 1 TO FCOUNT()
mfield = FIELDNAME(i)
fieldvar = "m" + mfield
&fieldvar = &mfield
NEXT
ELSE
BEEP("BOZO")
Err_msg("No database file is open. ")
ENDIF
RETURN(.T.)
* Mem2fld() - Replace fields with field memory variables.
*
FUNCTION Mem2fld
IF LEN(ALIAS()) !=0 && Check for open file.
FOR i = 1 TO FCOUNT()
mfield = FIELDNAME(i)
fieldvar = "m" + mfield
REPLACE &mfield. WITH &fieldvar.
NEXT
ELSE
BEEP("BOZO")
Err_msg("No database file is open. ")
ENDIF
RETURN(.T.)
* Beep() - Sounds a tone to get user's attention.
*
* Usage: Beep("NORM") && Informative information or warning.
* Beep("BOZO") && Error beep.
*
FUNCTION Beep
PARAMETER beeptype
IF beep_on
IF UPPER(beeptype) = "BOZO"
TONE(87.3,2)
TONE(40,7)
ELSE
TONE(261.7,2)
TONE(392,7)
ENDIF
ENDIF
RETURN(.T.)
* Err_msg() - Prints an error message or warning on row 0.
*
* Usage: Err_msg("Error or warning message")
*
FUNCTION Err_msg
PARAMETER e_msg
@ 0,0
err_scrn = SAVESCREEN(0,0,1,79)
currcolr = SETCOLOR()
SET COLOR TO i
@ 0,0 SAY e_msg + " Press a key to continue."
INKEY(0)
SETCOLOR(currcolr)
@ 0,0
RESTSCREEN(0,0,1,79,err_scrn)
RETURN(.T.)