home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / DATABASE / BROWSERO.ZIP / SAMPLE.PRG < prev   
Encoding:
Text File  |  1993-04-07  |  2.2 KB  |  69 lines
  1. *******************************************************************************
  2. *    Procedure VEPieces lets the user view/edit the Units or Media for the Item
  3. * currently selected.
  4. *******************************************************************************
  5. PROCEDURE VEPieces(Flag)
  6. LOCAL BUScreen
  7.  
  8. IF (!Flag).AND.(UPDATED())
  9.   IF YesNo("Save Changes to this Record?")
  10.     LibItems->(LPutRecord(Buffer,RECNO()))
  11.     BackupBuffer := ACLONE(Buffer)
  12.   ENDIF
  13. ENDIF
  14.  
  15. SELECT PIECES
  16. BUScreen := SAVESCREEN()
  17.  
  18. DO CASE
  19.   CASE "MED"$Buffer[4]
  20.     CName := "Unit"
  21.   CASE "WLM"$Buffer[4]
  22.     CName := "White Label Media Set"
  23.   CASE "DWG"$Buffer[4]
  24.     CName := "Station Multiple"
  25. ENDCASE
  26. // set up SuperBrowse Object...
  27. SB := PiecesBrowser():New(17,0,23,79)
  28. SB:FileName := "PIECES"
  29. SB:IndexOrder := 1
  30. SB:Fields := {"Title","Revision","Location","Format","NumParts","Date_Arc","Date","License","Date_Rec","Comments"}
  31. SB:Headers := {"Media Title","Rev","Locat","Format","#Pt","Archived","CertDate","Lic","Received","Comments"}
  32. SB:Pictures := {"@!","@!","@!","@!","","","","","",""}
  33. SB:Title := " "+CName+"s Listed for "+ALLTRIM(LIBITEMS->ID)+" "
  34. SB:Colors := {"N/GR","B/BG","GR+/B","W+/R"}
  35. SB:WhileBlock := {|x| (ALLTRIM(PIECES->ID) == x)}
  36. SB:HasWhileBlock := .T.
  37. SB:FirstKey := ALLTRIM(LIBITEMS->ID+LIBITEMS->Type)
  38. SB:Hooks := { {K_DEL, {|| DelChild()} }, ;
  39.               {K_F2, {|| NewChild()} }, ;
  40.               {K_F4, {|| ArchiveItem()} } }
  41.  
  42. @ 24,0 SAY SPACE(80)
  43. @ 24,2 SAY " F4 = Archive   F2 = New Rec    <DEL> = Delete/Restore Rec    <ESC> = Exit"
  44. SETCOLOR("W+/RG,N/W")
  45.  
  46. SB:Execute()
  47. SB:GoTop()
  48.  
  49. SELECT LIBITEMS
  50. RESTSCREEN(,,,,BUScreen)
  51. RETURN  // from VEPieces
  52.  
  53. *******************************************************************************
  54. *   Function ArchiveItem will toggle the Archive status bit of a media item.
  55. *
  56. *******************************************************************************
  57. FUNCTION ArchiveItem
  58. LOCAL APosition
  59.  
  60. IF EMPTY(PIECES->Date_Arc)
  61.   PIECES->Date_Arc := DATE()
  62. ELSE
  63.   IF YesNo("This Piece is already Archived, Clear the Archive Date Out?")
  64.     PIECES->Date_Arc := CTOD("  /  /  ")
  65.   ENDIF
  66. ENDIF
  67. RETURN 1  // refresh current row's data only
  68.  
  69.