home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / dbr11.zip / DBRDEMO.PRG next >
Text File  |  1993-07-11  |  8KB  |  307 lines
  1. /*
  2.     Demo program for dbReport
  3.  
  4.       by: Raymond J. Kuyvenhoven
  5.     date: 14 May 1993
  6. */
  7.  
  8. #include "Box.ch"
  9.  
  10. *
  11. *--------------------------------------------------
  12. FUNCTION Demo ()
  13. *--------------------------------------------------
  14. *
  15. LOCAL nChoice
  16. LOCAL cOutputFile
  17. LOCAL lDone := .f.
  18. LOCAL cColor
  19. LOCAL cMsg
  20.  
  21. CLS
  22. cColor := SETCOLOR ("W+/RB")
  23. cMsg := dbReportVersion ()
  24. @ 2, Center (cMsg) SAY cMsg COLOR ("W+/N")
  25. cMsg := "Demo Program"
  26. @ 3, Center (cMsg) SAY cMsg COLOR ("W+/N")
  27. SETCOLOR ("W+/N")
  28. @ 07, 0 CLEAR
  29. WHILE !lDone
  30.   SETCOLOR ("W+/RB")
  31.   SET MESSAGE TO 23 CENTER
  32.   @ 08, 35 , 15, 46 BOX B_DOUBLE_SINGLE + SPACE(1) COLOR ("GR+/RB")
  33.   @ 09, 36 PROMPT " Report 1 " MESSAGE {||HelpMsg ("List of people by lastname")}
  34.   @ 10, 36 PROMPT " Report 2 " MESSAGE {||HelpMsg ("Employee salaries by company & lastname")}
  35.   @ 11, 36 PROMPT " Report 3 " MESSAGE {||HelpMsg ("Invoices")}
  36.   @ 12, 36 PROMPT " Report 4 " MESSAGE {||HelpMsg ("List of people grouped by country, province/state")}
  37.   @ 13, 36 PROMPT " Report 5 " MESSAGE {||HelpMsg ("Report 3 to file: dbReport.DAT")}
  38.   @ 14, 36 PROMPT " Quit     " MESSAGE {||HelpMsg ("Quit " + dbReportVersion ())}
  39.   MENU TO nChoice
  40.   //
  41.   DO CASE
  42.     CASE nChoice == 1
  43.        cOutputFile := NIL  // "Test1.OUT"
  44.        Report ("Person", "Person1", "Test1.FMT", cOutputFile)
  45.     CASE nChoice == 2
  46.        cOutputFile := NIL  // "Test2.OUT"
  47.        Report ("Person", "Person2", "Test2.FMT", cOutputFile)
  48.     CASE nChoice == 3
  49.        cOutputFile := NIL  // "Test3.OUT"
  50.        InvReport (cOutputFile)
  51.     CASE nChoice == 4
  52.        cOutputFile := NIL  // "Test4.OUT"
  53.        Report ("Person", "Person4", "Test4.FMT", cOutputFile)
  54.     CASE nChoice == 5
  55.        cOutputFile := "dbReport.DAT"
  56.        Report ("Person", "Person4", "Test4.FMT", cOutputFile)
  57.     CASE (nChoice == 6) .OR. (nChoice == 0)
  58.        lDone := .t.
  59.   ENDCASE
  60. END
  61. FinalMessage ()
  62. SETCOLOR (cColor)
  63. @ MAXROW()-1, 0 SAY ""
  64. RETURN NIL
  65.  
  66. *
  67. *--------------------------------------------------
  68. STATIC FUNCTION InvReport (cOutputFile)
  69. *--------------------------------------------------
  70. *
  71. LOCAL aDataDict
  72.  
  73. aDataDict := InvoiceDD ()
  74. dbUSEAREA (,,"Invoice")
  75. SELECT ("Invoice")
  76. dbSETINDEX ("Invoice")
  77. dbUSEAREA (.t.,,"Person")
  78. dbSETINDEX ("Person3")
  79. dbReport ("Test3.FMT", { |lFirstCall| GetInvoice (lFirstCall)}, aDataDict, cOutputFile)
  80. dbCLOSEALL ()
  81. RETURN NIL
  82.  
  83. *
  84. *--------------------------------------------------
  85. STATIC FUNCTION Report (cDbfFile, cIndexFile, cFormatFile, cOutputFile)
  86. *--------------------------------------------------
  87. *
  88. LOCAL aDataDict
  89.  
  90. aDataDict := CreateDataDictionary ()
  91. dbUSEAREA (,,cDbfFile)
  92. dbSETINDEX (cIndexFile)
  93. dbReport (cFormatFile, { |lFirstCall| GetRecord (lFirstCall)}, aDataDict, cOutputFile)
  94. dbCLOSEAREA ()
  95. RETURN NIL
  96.  
  97. *
  98. *--------------------------------------------------
  99. STATIC FUNCTION GetRecord (lFirstCall)
  100. *--------------------------------------------------
  101. *
  102. LOCAL aRecord
  103.  
  104. SELECT ("PERSON")
  105. IF lFirstCall
  106.   dbGOTOP ()
  107.   IF !EOF ()
  108.     aRecord := LoadArray ()
  109.   ELSE
  110.     aRecord := NIL
  111.   END
  112. ELSE
  113.   dbSKIP ()
  114.   IF !EOF ()
  115.     aRecord := LoadArray ()
  116.   ELSE
  117.     aRecord := NIL
  118.   END
  119. END
  120. RETURN aRecord
  121.  
  122.  
  123. *
  124. *--------------------------------------------------
  125. STATIC FUNCTION LoadArray ()
  126. *--------------------------------------------------
  127. *
  128. LOCAL nIdx
  129. LOCAL aBuffer := {}
  130. LOCAL cTemp
  131.  
  132. FOR nIdx := 1 TO FCOUNT()
  133.   AADD (aBuffer, FIELDGET(nIdx))
  134. NEXT
  135. cTemp := ALLTRIM (FIELDGET(2)) + ", " + ALLTRIM (FIELDGET (1))
  136. AADD (aBuffer, cTemp)
  137. RETURN aBuffer
  138.  
  139. *
  140. *--------------------------------------------------
  141. STATIC FUNCTION CreateDataDictionary ()
  142. *--------------------------------------------------
  143. *
  144. LOCAL aArray := {}
  145.  
  146. AADD (aArray, "FirstName")
  147. AADD (aArray, "LastName")
  148. AADD (aArray, "Street")
  149. AADD (aArray, "City")
  150. AADD (aArray, "Province")
  151. AADD (aArray, "Country")
  152. AADD (aArray, "PostalCode")
  153. AADD (aArray, "Company")
  154. AADD (aArray, "HiredDate")
  155. AADD (aArray, "Married")
  156. AADD (aArray, "Age")
  157. AADD (aArray, "Salary")
  158. AADD (aArray, "PersonNum")
  159. AADD (aArray, "Combined")
  160. RETURN aArray
  161.  
  162. *
  163. *--------------------------------------------------
  164. STATIC FUNCTION GetInvoice (lFirstCall)
  165. *--------------------------------------------------
  166. *
  167. LOCAL aRecord
  168.  
  169. SELECT ("Invoice")
  170. IF lFirstCall
  171.   dbGOTOP ()
  172.   IF !EOF ()
  173.     SELECT ("Person")
  174.     dbSEEK (Invoice->PersonNum, .f.)
  175.     aRecord := LoadInvoice ()
  176.   ELSE
  177.     aRecord := NIL
  178.   END
  179. ELSE
  180.   dbSKIP ()
  181.   IF !EOF ()
  182.     SELECT ("Person")
  183.     dbSEEK (Invoice->PersonNum, .f.)
  184.     aRecord := LoadInvoice ()
  185.   ELSE
  186.     aRecord := NIL
  187.   END
  188. END
  189. RETURN aRecord
  190.  
  191.  
  192. *
  193. *--------------------------------------------------
  194. STATIC FUNCTION LoadInvoice ()
  195. *--------------------------------------------------
  196. *
  197. LOCAL nIdx
  198. LOCAL aBuffer := {}
  199. LOCAL cTemp
  200.  
  201. cTemp := ALLTRIM (Person->Last) + ", " + ALLTRIM (Person->First)
  202.  
  203. AADD (aBuffer, cTemp)
  204. AADD (aBuffer, Person->Street)
  205. AADD (aBuffer, Person->City)
  206. AADD (aBuffer, Person->State)
  207. AADD (aBuffer, Person->Country)
  208. AADD (aBuffer, Person->Zip)
  209. AADD (aBuffer, Invoice->Descript)
  210. AADD (aBuffer, Invoice->Quantity)
  211. AADD (aBuffer, Invoice->Price)
  212. RETURN aBuffer
  213.  
  214.  
  215. *
  216. *--------------------------------------------------
  217. STATIC FUNCTION InvoiceDD ()
  218. *--------------------------------------------------
  219. *
  220. LOCAL aArray := {}
  221.  
  222. AADD (aArray, "Name")
  223. AADD (aArray, "Street")
  224. AADD (aArray, "City")
  225. AADD (aArray, "Province")
  226. AADD (aArray, "Country")
  227. AADD (aArray, "PostalCode")
  228. AADD (aArray, "Description")
  229. AADD (aArray, "Quantity")
  230. AADD (aArray, "Price")
  231. RETURN aArray
  232.  
  233. *
  234. *--------------------------------------------------
  235. STATIC FUNCTION HelpMsg (cMsg)
  236. *--------------------------------------------------
  237. *
  238. LOCAL cSaveClr
  239. LOCAL nRow
  240.  
  241. nRow := MAXROW() - 1
  242. cSaveClr := SETCOLOR ("N/BG")
  243. @ nRow, 0 CLEAR TO nRow, MAXCOL()
  244. @ nRow, Center (cMsg) SAY cMsg
  245. SETCOLOR (cSaveClr)
  246. RETURN ""
  247.  
  248. *
  249. *--------------------------------------------------
  250. STATIC FUNCTION Center (cMsg)
  251. *--------------------------------------------------
  252. *
  253. LOCAL nLineLength
  254. nLineLength := MAXCOL()+1
  255. RETURN ((nLineLength -  LEN(cMsg)) / 2 )
  256.  
  257. *
  258. *--------------------------------------------------
  259. STATIC FUNCTION FinalMessage ()
  260. *--------------------------------------------------
  261. *
  262. LOCAL cMessage
  263.  
  264. SETCOLOR ("W+/N")
  265. CLS
  266. cMessage := dbReportVersion ()
  267. @ 02, Center (cMessage) SAY cMessage COLOR "RB+/N"
  268. cMessage := "Copyright (c) 1993" 
  269. @ ROW()+2, Center (cMessage) SAY cMessage COLOR "W/N"
  270. cMessage := "Raymond J. Kuyvenhoven"
  271. @ ROW()+1, Center (cMessage) SAY cMessage
  272. cMessage := "MAILING ADDRESS"
  273. @ ROW()+3, Center (cMessage) SAY cMessage COLOR "GR+/N"
  274. cMessage := "-----------------"
  275. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "GR+/N"
  276. cMessage := "131 Britten Close" 
  277. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "BG+/N"
  278. cMessage := "Hamilton, Ontario"
  279. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "BG+/N"
  280. cMessage := "L9C 4K1"
  281. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "BG+/N"
  282. cMessage := "EMAIL"
  283. @ ROW()+3, Center (cMessage) SAY cMessage COLOR "GR+/N"
  284. cMessage := "-------"
  285. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "GR+/N"
  286. cMessage := "Internet: rn.3333@rose.com"
  287. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "G+/N"
  288. cMessage := "RoseNet: Ray Kuyvenhoven@CRS"
  289. @ ROW()+1, Center (cMessage) SAY cMessage COLOR "G+/N"
  290. cMessage := "$35.00 for registered version"
  291. @ ROW()+3, Center (cMessage) SAY cMessage COLOR "R+/N"
  292. RETURN NIL
  293.  
  294.  
  295. //  If you are using Clipper 5.01a uncomment the following procedure
  296. //  to eliminate the link warning you will recieve when linking with
  297. //  Clipper 5.2 compiled code.
  298.  
  299. /*
  300. //
  301. //--------------------------------------------------------------
  302.    PROCEDURE Clipper520 ()
  303. //--------------------------------------------------------------
  304. //
  305. RETURN
  306. */
  307.