home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a054 / 1.img / GETPRGS.EXE / GETS07.PRG < prev    next >
Encoding:
Text File  |  1992-03-08  |  3.1 KB  |  140 lines
  1. // Gets07.prg
  2. //
  3. // Example illustrating issuing gets from database
  4. // Save in our own array of GET objects - edit to memvars. Use
  5. // 7 element cargo array
  6. // Use WHEN clause as .F. if say without GET - otherwise have GET
  7. // on NULL field which is bad
  8.  
  9. #include "Inkey.ch"
  10.  
  11. FUNCTION Gets07
  12.  
  13. FIELD ScrName, FldNum
  14. LOCAL aScreen1
  15.  
  16.   USE Screens NEW
  17.   IF !File("Screens.ntx")
  18.     INDEX ON Upper(ScrName) + Str(FldNum, 3) TO Screens
  19.   ELSE
  20.     SET INDEX TO Screens
  21.   ENDIF
  22.   USE Test NEW SHARED
  23.   aScreen1 := BuildScreen("TEST")
  24.   ReadScreen(aScreen1)
  25.   GetFldRefresh(aScreen1)
  26.   ReadScreen(aScreen1)
  27.  
  28. RETURN NIL
  29.  
  30. #define GC_SAY_ROW    1
  31. #define GC_SAY_COL    2
  32. #define GC_SAY_TEXT   3
  33. #define GC_SAY_PICT   4
  34. #define GC_SAY_COLOR  5
  35. #define GC_FLD_GSB    6
  36. #define GC_FLD_VALUE  7
  37.  
  38. FUNCTION BuildScreen(cScrName)
  39.  
  40. FIELD ScrName, SayRow, SayCol, SayString, ;
  41.       SayPict, SayColor IN Screens
  42.  
  43. FIELD GetRow,  GetCol, GetFld, GetPict, ;
  44.       GetWhen, GetValid, GetColor IN Screens
  45.  
  46. LOCAL nGets  := 0
  47. LOCAL i
  48. LOCAL aGets := {}
  49. LOCAL oGet
  50.  
  51.   Screens -> (DbSeek(cScrName))
  52.   DO WHILE cScrName == Trim(Upper(Screens -> ScrName))
  53.     nGets++
  54.     Aadd(aGets, GetNew())
  55.     oGet := aGets[nGets]
  56.     IF Empty(SayColor)
  57.       oGet:cargo := {SayRow, SayCol, Trim(SayString), ;
  58.                      Trim(SayPict), NIL, NIL, NIL}
  59.     ELSE
  60.       oGet:cargo := {SayRow, SayCol, Trim(SayString), ;
  61.                      Trim(SayPict), Trim(SayColor), NIL, NIL}
  62.     ENDIF
  63.  
  64.     IF Empty(GetFld)
  65.       oGet:preBlock := {|| .F. }
  66.     ELSE
  67.       oGet:cargo[GC_FLD_GSB]   := FieldBlock(GetFld)
  68.       oGet:cargo[GC_FLD_VALUE] := Eval(oGet:cargo[GC_FLD_GSB])
  69.       oGet:block    := Oblk(oGet)
  70.       oGet:row      := GetRow
  71.       oGet:col      := GetCol
  72.       oGet:picture  := Trim(GetPict)
  73.  
  74.       IF !Empty(GetColor)
  75.         oGet:colorSpec := GetColor
  76.       ENDIF
  77.  
  78.       IF !Empty(GetWhen)
  79.         oGet:preBlock := &GetWhen
  80.       ENDIF
  81.  
  82.       IF !Empty(GetValid)
  83.         oGet:postBlock := &GetValid
  84.       ENDIF
  85.     ENDIF
  86.  
  87.     Screens -> (DbSkip(1))
  88.   ENDDO
  89.  
  90. RETURN aGets
  91.  
  92.  
  93. FUNCTION ReadScreen(aScreen)
  94.  
  95. LOCAL i
  96. LOCAL oGet
  97. LOCAL nGets := Len(aScreen)
  98.  
  99.   CLEAR SCREEN
  100.   FOR i := 1 TO nGets
  101.     oGet := aScreen[i]
  102.     DevPos(oGet:cargo[GC_SAY_ROW], oGet:cargo[GC_SAY_COL])
  103.     DevOutPict(oGet:cargo[GC_SAY_TEXT],  ;
  104.                oGet:cargo[GC_SAY_PICT], ;
  105.                oGet:cargo[GC_SAY_COLOR])
  106.     IF oGet:block != NIL
  107.       oGet:display()
  108.     ENDIF
  109.   NEXT
  110.  
  111.   ReadModal(aScreen)
  112.   IF LastKey() != K_ESC .AND. Updated()
  113.     IF Rlock()
  114.       FOR i := 1 TO nGets
  115.         oGet := aScreen[i]
  116.         IF oGet:block != NIL
  117.           Eval(oGet:cargo[GC_FLD_GSB], oGet:cargo[GC_FLD_VALUE])
  118.     ENDIF
  119.       NEXT
  120.       UNLOCK
  121.     ENDIF
  122.   ENDIF
  123.  
  124. RETURN NIL
  125.  
  126. FUNCTION Oblk(oGet)
  127.  
  128. RETURN {|x| iif(x == NIL, oGet:cargo[GC_FLD_VALUE], ;
  129.                           oGet:cargo[GC_FLD_VALUE] := x) }
  130.  
  131.  
  132. FUNCTION GetFldRefresh(aGets)
  133.  
  134.   Aeval(aGets, ;
  135.        {|oGet| iif(oGet:block != NIL,  ;
  136.                oGet:cargo[GC_FLD_VALUE] := Eval(oGet:cargo[GC_FLD_GSB]), ;
  137.                NIL)})
  138.  
  139. RETURN NIL
  140.