Piper's Pit BBS/FTP: ibm 0010 - 0019/ibm0010-0019/ibm0010.tar/ibm0010/CLIPB52.ZIP/ZINKY.ZIP/EDIT.PRG

Text File | 1990-05-01 | 8.7 KB | 304 lines

********************************
*                              *
*     EDIT.PRG                 *
*                              *
* SUB PROGRAM OF SAMPLE.PRG    *
*                              *
********************************

*If you are sure that you have variables that will be
*used in one module only, declare them PRIVATE. This
*allows the programmer to use the same variable names
*in different modules, while keeping the values of
*those variables local to that module. Declaring
*variables PRIVATE also ensures that memory will be
*freed when the module is exited. It is a good idea to
*declare arrays used by DBEDIT()as PRIVATE.

PRIVATE io_flg, Am_fields[4], Am_namees[4]
io_flg=.T.             && Flag to be used for io later
scr_color = "w/n,r+/b"
CLEAR
SET CURSOR ON
DO MAKEDBF
@ 0,0,24,79 BOX boxframe
SET COLOR TO &scr_color

*The subscript value must be as large as the amount of
*fields you choose to use in the DBEDIT() window. In
*this model Am_fields was the author's choice of
*variable name for the fields to be displayed and
*Am_namees was the name chosen for the titles for the
*display.

Am_fields[1] = 'Del'
Am_fields[2] = 'SUBSTR(artist,1,20)'
Am_fields[3] = 'condition'
Am_fields[4] = 'STR(book_value,6,2)'
Am_namees[1] = 'Del'
Am_namees[2] = 'Artist'
Am_namees[3] = 'Condition'
Am_namees[4] = 'Book Value'

@14,04 TO 21,44
@15,5 SAY "INSERT Key to ADD     records          "
@16,5 SAY "RETURN Key to EDIT    records          "
@17,5 SAY "F5 Key to SEARCH for  record           "
@18,5 SAY "DELETE Key - mark for deletion         "
@19,5 SAY "F4    to make/edit   a memo            "
@20,5 SAY "ESC TO QUIT                            "
DBEDIT(3,3,12,74,Am_fields,"Audf",.t.,Am_namees)

*A full coverage of DBEDIT() is beyond our scope,
*however this model includes a brief explanation. The
*numerical parameters contained in the paranthesis,
*locate the upper left and lower right dimensions of
*the DBEDIT() window. Am_fields references the field
*you have chosen. Audf references a user defined
*function to handle the exception keys read by
*DBEDIT(). For example DBEDIT() reads the down-arrow
*and page-up. Those keys are already defined to
*DBEDIT() and not exception keys. If however, you
*wanted to define a search function when a certain key
*is pressed, this is where it would be read. The next
*parameter .T. allows editing of the database. If .F.
*(false) is sent, only browsing is allowed. The last
*parameter Am_namees holds the titles you wish
*displayed.

CLOSE ALL                     &&Close the database.
CLEAR SCREEN
RETURN

*The Audf function is a "user-defined" function, and is
*continually called by DBEDIT() to see if any of the
*exception keys have been defined. The two parameters
*(mode and fld_ptr) are required. DBEDIT() modes are:
*You should use the case statement for all your
*exception key statements.
*  0. Idle, all key strokes have been
*     processed;nothing pending.
*  1. Attempt to move cursor past beginning of file.
*  2. Attempt to move cursor past end of file.
*  3. Data file is empty.
*  4. Keystroke exception.

*The second parameter passes the exact field the cursor
*is positioned on in DBEDIT().
*RETURN(0)- Returning 0 is the value that DBEDIT()
*interprets as exit.

*RETURN(1)- Returning 1 is continue DBEDIT().

*RETURN(2)- Returning 2 is repaint window and continue.

FUNCTION Audf
PARAMETERS mode,fld_ptr
Acur_field = Am_fields[fld_ptr]
IF mode < 4
  RETURN(1)
ENDIF

IF LASTKEY() = 27
  SAVE SCREEN TO quit_scr
  quit_in = 3
  @  2,50 SAY '╓───────────────────┐'
  @  3,50 SAY '║    Quit Menu      │'
  @  4,50 SAY '╟───────────────────┤'
  @  5,50 SAY '║ Return to Program │'
  @  6,50 SAY '║ Quit              │'
  @  7,50 SAY '╚═══════════════════╛'
  @  5,52 PROMPT 'Return to Program'
  @  6,52 PROMPT 'Quit             '
  MENU TO quit_in
  IF quit_in = 1 .OR. quit_in = 0
    RESTORE SCREEN FROM quit_scr
    RETURN(1)
  ENDIF
  IF quit_in = 2
    RETURN(0)
  ENDIF
ENDIF
DO CASE
  CASE LASTKEY() = -4  && F5
    SAVE SCREEN TO Ascr_hold
    @ 20,01 SAY "┌─────────────────────────┐"
    @ 21,01 SAY "│Search For:              │"
    @ 22,01 SAY "└─────────────────────────┘"
    search_in = SPACE(80)
    @ 21,13 GET search_in PICTURE "@S14!"
    READ
    SET SOFTSEEK ON
    SEEK search_in
    RESTORE SCREEN FROM Ascr_hold
    SET COLOR TO &scr_color
    SET SOFTSEEK OFF
    RETURN(2)
  CASE LASTKEY() = 7     && Delete Key
    SAVE SCREEN TO Ascr_1
    DO Adel_rec
    RESTORE SCREEN FROM Ascr_1
    SET COLOR TO &scr_color
    RETURN(2)
  CASE LASTKEY() = -3
    SAVE SCREEN TO Ascr_1
    CLEAR
    @ 3,30 SAY 'WRITE OR EDIT YOUR MEMO'
    @ 4,4 to 21,66
    @ 22,30 SAY 'CTRL-W TO SAVE  <ESC>ABORT'
    IF Rlok()
      REPLACE MEMO WITH MEMOEDIT(MEMO,5,5,20,65,.T.)
    ENDIF
    UNLOCK
    COMMIT


*The COMMIT command sends a message to the operating
*system to write to the database a soon as possible and
*not hold in buffer. This command requires DOS 3.3 or
*higher.

    RESTORE SCREEN FROM Ascr_1
    RETURN(2)
  CASE LASTKEY() = 13     && Return Key
    SET CURSOR ON
    SAVE SCREEN TO Ascr_1
    DO Aio WITH .F.,.F.           &&   Editing Records
    RESTORE SCREEN FROM Ascr_1
    SET COLOR TO &scr_color
    RETURN(1)
  CASE LASTKEY() = 22     && Insert Key Or Ctrl-U
    SET CURSOR ON
    SAVE SCREEN TO Ascr_1
    DO Aio WITH .T.,io_flg
    RESTORE SCREEN FROM Ascr_1
    SET COLOR TO &scr_color
    RETURN(2)
ENDCASE
RETURN(1)

*The basic concept behind the Aio procedure is
*aimed at network applications. That is, you should
*have the user inputting data to memory variables, as
*opposed to referencing the field names of the
*database.

*The user still has the option to ESC and abort or to
*enter the data and commit it to the file.
*This keeps the record from being locked while they are
*editing, correcting, or inputting.

PROCEDURE Aio
PARAMETERS add_flg,val_flg
SET COLOR TO W/N
@ 15,03,23,54 BOX "╔═╗║╝═╚║ "
@ 16,04 SAY "Artist  :"
@ 17,04 SAY "Title   :"
@ 18,04 SAY "Condit. :"
@ 19,04 SAY "Remarks :"
@ 20,04 SAY "Year    :"
@ 21,04 SAY "Book Val:"
@ 22,04 SAY "Catalog :"
SET CURSOR ON
IF val_flg
  m_artist = SPACE(40)
  m_title = SPACE(40)
  m_condition = SPACE(10)
  m_remarks = SPACE(35)
  m_yr_release = SPACE(4)
  m_book_value = 0.00
  m_catalog = SPACE(30)
ENDIF
IF .NOT. val_flg
  m_artist = artist
  m_title = title
  m_condition = condition
  m_remarks = remarks
  m_yr_release = yr_release
  m_book_value = book_value
  m_catalog = catalog
ENDIF
@ 16,13 GET m_artist PICTURE;
  "@K!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
@ 17,13 GET m_title  PICTURE;
  "@K!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
@ 18,13 GET m_condition PICTURE "@K!!!!!!!!"
@ 19,13 GET m_remarks PICTURE;
  "@K!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
@ 20,13 GET m_yr_release PICTURE "@K!!"
@ 21,13 GET m_book_value PICTURE "999.99"
@ 22,13 GET m_catalog PICTURE;
  "@K!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
READ
IF LASTKEY() <> 27  && ESC KEY
  IF add_flg
    APPEND BLANK
  ENDIF
  IF Rlok()
    REPLACE artist     WITH m_artist
    REPLACE title      WITH m_title
    REPLACE condition  WITH m_condition
    REPLACE remarks    WITH m_remarks
    REPLACE yr_release WITH m_yr_release
    REPLACE book_value WITH m_book_value
    REPLACE catalog    WITH m_catalog
  ENDIF
  UNLOCK
  COMMIT
ENDIF
RETURN

PROCEDURE Adel_rec

*Note that in this procedure, to pack a database
*requires that you have exclusive use.

SET COLOR TO &scr_color
@ 01,00,08,12 BOX "┌─┐│┘─└│"
@ 03,00 SAY "├"
@ 03,12 SAY "┤"
SET COLOR TO &scr_color
@ 02,01,07,11 BOX "         "
@ 02,01 SAY  "DELETE MENU"
@ 03,00 SAY "├───────────┤"
@ 04,01 SAY  "Return     "
@ 05,01 SAY  "Delete Rec."
@ 06,01 SAY  "ReCall Rec."
@ 07,01 SAY  "Pack Data  "
SET COLOR TO &scr_color
SET WRAP ON
SET MESSAGE TO
@ 04,01 PROMPT "Return     "
@ 05,01 PROMPT "Delete Rec."
@ 06,01 PROMPT "ReCall Rec."
@ 07,01 PROMPT "Pack Data  "
MENU TO Adel_in
DO CASE
  CASE Adel_in = 0 .OR. Adel_in = 1
    RETURN
  CASE Adel_in = 2
    IF Rlok()
      REPLACE del WITH '*'
      DELETE
    ENDIF
    COMMIT
  CASE Adel_in = 3
    IF Rlok()
      REPLACE del WITH ' '
      RECALL
    ENDIF
  CASE Adel_in = 4
     CLOSE ALL
     SET EXCLUSIVE ON
     USE a_d INDEX a_d
     PACK
     CLOSE ALL
     SET EXCLUSIVE OFF
     USE a_d INDEX a_d
     RETURN
ENDCASE
SET COLOR TO &scr_color
RETURN