home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a054 / 1.img / GETPRGS.EXE / GETS06.PRG < prev    next >
Encoding:
Text File  |  1992-03-08  |  1.9 KB  |  82 lines
  1.     // Gets06.prg
  2.     //
  3.     // Example illustrating issuing gets from database
  4.     // Edit to Memvar
  5.  
  6.     MEMVAR GetList
  7.  
  8.     #include "Inkey.ch"
  9.  
  10.     FUNCTION Gets06
  11.  
  12.     FIELD ScrName, FldNum
  13.  
  14.       USE Screens NEW
  15.       IF !File("Screens.ntx")
  16.         INDEX ON Upper(ScrName) + Str(FldNum, 3) TO Screens
  17.       ELSE
  18.         SET INDEX TO Screens
  19.       ENDIF
  20.       USE Test NEW SHARED
  21.       ReadScreen("TEST")
  22.  
  23.     RETURN NIL
  24.  
  25.  
  26.     FUNCTION ReadScreen(cScrName)
  27.  
  28.     FIELD ScrName, SayRow, SayCol, SayString, ;
  29.           SayPict, SayColor IN Screens
  30.  
  31.     FIELD GetRow,  GetCol, GetFld, GetPict, ;
  32.           GetWhen, GetValid, GetColor IN Screens
  33.  
  34.     LOCAL aTemps := {}
  35.     LOCAL aGsbs  := {}
  36.     LOCAL nGets  := 0
  37.     LOCAL i
  38.  
  39.       CLEAR SCREEN
  40.       Screens -> (DbSeek(cScrName))
  41.       DO WHILE cScrName == Trim(Upper(Screens -> ScrName))
  42.         IF Empty(SayColor)
  43.           @ SayRow, SayCol SAY Trim(SayString) PICTURE Trim(SayPict)
  44.         ELSE
  45.           @ SayRow, SayCol SAY Trim(SayString) PICTURE Trim(SayPict) ;
  46.             COLOR Trim(SayColor)
  47.         ENDIF
  48.  
  49.         IF !Empty(GetFld)
  50.           nGets++
  51.           Aadd(aGsbs,  FieldBlock(GetFld))
  52.           Aadd(aTemps, Eval(aGsbs[nGets]))
  53.           @ GetRow, GetCol GET aTemps[nGets] PICTURE Trim(GetPict)
  54.  
  55.           IF !Empty(GetColor)
  56.             Atail(GetList):colorDisp(GetColor)
  57.           ENDIF
  58.  
  59.           IF !Empty(GetWhen)
  60.             Atail(GetList):preBlock := &GetWhen
  61.           ENDIF
  62.  
  63.           IF !Empty(GetValid)
  64.             Atail(GetList):postBlock := &GetValid
  65.           ENDIF
  66.         ENDIF
  67.  
  68.         Screens -> (DbSkip(1))
  69.       ENDDO
  70.       READ
  71.  
  72.       IF LastKey() != K_ESC .AND. Updated()
  73.         IF Rlock()
  74.           FOR i := 1 TO nGets
  75.             Eval(aGsbs[i], aTemps[i])
  76.           NEXT
  77.           UNLOCK
  78.         ENDIF
  79.       ENDIF
  80.  
  81.     RETURN NIL
  82.