Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : EDITIT10.ZIP
Filename : EDITIT.PRG
* Program Id: editit.prg
* System: JFK.LIB
* Client: My customers!
* Version: 1.00
********************************************************************************
*
* Purpose: simulate dBase's EDIT command
*
********************************************************************************
*
* Called by: anything
*
* Calls to: EXTEND.LIB routines
*
********************************************************************************
*
* Databases: Whatever is active
*
********************************************************************************
* Date Name Description
*
* 09/21/89 jfk Original program
********************************************************************************
****** Comment out all code up to the first 'return' when you're done using
****** this to test the routine.
parameter filename
if pcount() < 1
? "Syntax: editit
endif
use &filename
editrec()
skip
editrec( 5, 10, 20, 60, "ÚÄ¿³ÙÄÀ³ ", "Smaller box" )
return
****************
****************
**
** Syntax:
** editrec( [
** [,
**
** Variable T Len Description
** ÄÄÄÄÄÄÄÄ Ä ÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄ
** toprow N Top row of edit window
** leftcol N Left column of edit window
** botrow N Bottom row of edit window
** rightcol N Right column of edit window
** frame C 9 Frame for box around window
** title C Title for box
**
** Notes: uses the currently active data file to edit it.
** EXTEND.LIB must be linked in to use AFIELDS()
** [PgUp] is the only key to allow the user to get back to the
** previous screen. Includes support for memo fields.
**
****************
****************
function editrec
parameter toprow, leftcol, botrow, rightcol, frame, title
private pc, rows, numflds, numscrns, i, aliname, fn, topfld, botfld, j, cols,;
k, editscr
store '' to fn, editscr
pc = pcount()
if m->pc < 6 && Parameters will default
if m->pc < 1
toprow = 1
endif
if m->pc < 2
leftcol = 0
endif
if m->pc < 3
botrow = 23
endif
if m->pc < 4
rightcol = 79
endif
if m->pc < 5
frame = "ÚÄ¿³ÙÄÀ³ "
endif
title = "[ Record: " + ltrim( str( recno() ) ) + " ]"
endif
****** Set dimensions for actually INSIDE the box
toprow = m->toprow + 1
leftcol = m->leftcol + 1
botrow = m->botrow - 1
rightcol = m->rightcol - 1
****** # of rows in window
rows = m->botrow - m->toprow + 1
****** (# of cols in window) - field display width
cols = m->rightcol - m->leftcol - 13
aliname = alias()
if m->rows < 1 .or. m->cols < 1 .or. empty( m->aliname ) && Come on now!
return .f.
endif
if ! rlock()
@ 0,0 say "Unable to lock record"
return .f.
endif
****** Determine the number of screens needed for editing the record
numflds = fcount()
numscrns = round( m->numflds / m->rows, 0 )
if m->numscrns * m->rows < m->numflds
numscrns = m->numscrns + 1
endif
****** Declare array for fields
private _fname[ m->numflds ], _ftype[ m->numflds ], _fwid[ m->numflds ],;
_fdec[ m->numflds ], _fval[ m->numflds ]
afields( _fname, _ftype, _fwid, _fdec )
****** Assign field equivalents
for i = 1 to m->numflds
fn = _fname[ m->i ]
if _ftype[ m->i ] = 'M'
****** Do the memo edit from the valid clause!
_fval[ m->i ] = .f.
else
_fval[ m->i ] = &aliname->&fn
endif
next i
****** Take care of the (+ 1) problem for 0-based screens
toprow = m->toprow - 1
editscr = savescreen( m->toprow, m->leftcol - 1, m->botrow + 1, ;
m->rightcol + 1 )
i = 1
do while m->i > 0 .and. m->i <= m->numscrns
****** Calculate the field offset on this edit window
topfld = m->rows * ( m->i - 1 )
****** Make sure we don't try to display more fields than there are
if m->topfld + m->rows > m->numflds
botfld = m->numflds - m->topfld
else
botfld = m->rows
endif
@ m->toprow, m->leftcol - 1, m->botrow + 1, m->rightcol + 1 box m->frame
@ m->toprow, m->leftcol say m->title
****** Setting up the get clauses
for j = 1 to m->botfld
k = m->topfld + m->j
@ m->toprow + m->j, m->leftcol say _fname[ m->k ]
@ m->toprow + m->j, m->leftcol + 11 get _fval[ m->k ] ;
picture fieldpic( _ftype[ m->k ], _fwid[ m->k ], _fdec[ m->k ], m->cols ) ;
valid fieldvalid( m->toprow + 1, m->rows, m->i )
if _ftype[ m->k ] = 'M' .and. m->cols > 15
@ m->toprow + m->j, m->leftcol + 13 say "
endif
next j
read
****** Determining which screen to go to from here
if lastkey() = 27 && [Esc]
i = 0
elseif lastkey() = 18 && [PgUp]
if i > 1
i = m->i - 1
endif
elseif lastkey() = 23 && [^W] or [^End]
exit
else
i = m->i + 1
endif
enddo
restscreen( m->toprow, m->leftcol - 1, m->botrow + 1, m->rightcol + 1, ;
m->editscr )
if m->i = 0 && Escape was pressed
return .f.
endif
****** Replace values in fields
for i = 1 to m->numflds
fn = _fname[ m->i ]
if _ftype[ m->i ] # 'M'
replace &aliname->&fn with _fval[ m->i ]
endif
next i
****** Successful edit!
return .t.
*****************
*****************
**
** Syntax:
** fieldpic( <_ftype>, <_fwid>, <_fdec>,
**
** Variable T Len Description
** ÄÄÄÄÄÄÄÄ Ä ÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄ
** _ftype C Type of field
** _fwid N Width of field
** _fdec N Decimal for numeric fields
** wid N Display width of window
**
** Notes:
** will overlap the window if they don't fit.
**
** Source: h:\users\jfk\clip\editit.prg
*****************
*****************
function fieldpic
parameter _ftype, _fwid, _fdec, wid
if pcount() < 4 && returns a generic field picture
return '@X'
endif
if m->_ftype = 'N'
if _fdec > 0
return replicate( '9', m->_fwid - m->_fdec - 1 ) + '.' + ;
replicate( '9', m->_fdec )
endif
return replicate( '9', m->_fwid )
elseif m->_ftype = 'D'
return '@D'
elseif m->_ftype $ 'LM'
return 'Y'
endif
if m->wid < m->_fwid
return '@S' + ltrim( str( m->_fwid - m->wid ) )
endif
return '@X'
*******************
*******************
**
** Syntax:
** fieldvalid(
**
** Variable T Len Description
** ÄÄÄÄÄÄÄÄ Ä ÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄ
** toprow N Top row of window
** rows N # of rows per edit window
** scrnum N # of current screen
**
** Notes: This function is NO GOOD OUTSIDE of editrec(). It assumes that
** memory variables declared private in editrec() are available to
** it (because I didn't want a huge parameter list) and because it's
** set up specifically for that edit window. Because valid clauses
** are evaluated on AFTER the READ is invoked, there is no telling
** what the actual value of 'j' is at that time. This will figure
** out what field you're on, and do the validation necessary for that
** field. Capiche?
**
** EXTEND.LIB must be linked because this function used savescreen()
** and restscreen().
**
** Be warned that this function is a potential memory grabber because
** of memoedit() and my making a copy of the memo field before editing
** it.
**
*******************
*******************
function fieldvalid
parameter toprow, rows, scrnum
private fldptr, fn, valscr, tmpmem
****** Nulling out private character variables for maximum memory recovery
store '' to fn, valscr, tmpmem
****** Calculating the field pointer based on the current screen row, top
****** row, and screen number
fldptr = ( row() - m->toprow ) + ( m->rows * ( m->scrnum - 1 ) ) + 1
if _ftype[ m->fldptr ] # 'M' && Any type OTHER than a memo field
return .t.
endif
if ! _fval[ m->fldptr ] && .F. was in field value - no edit!
return .t.
endif
fn = _fname[ m->fldptr ]
****** Copy the memo
tmpmem = &aliname->&fn
****** Save the screen before blanking it out
valscr = savescreen( m->toprow, m->leftcol, m->botrow, m->rightcol )
@ m->toprow, m->leftcol, m->botrow, m->rightcol box "ÉÍ»º¼ÍȺ "
****** edit the memo
tmpmem = memoedit( m->tmpmem, m->toprow + 1, m->leftcol + 1, m->botrow - 1,;
m->rightcol - 1, .t., "", 75 )
if lastkey() # 27
replace &aliname->&fn with m->tmpmem
endif
restscreen( m->toprow, m->leftcol, m->botrow, m->rightcol, m->valscr )
****** set toggle back to .F., so edit isn't ALWAYS called
_fval[ m->fldptr ] = .f.
return .t.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/