home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / alert / aldemo.prg next >
Encoding:
Text File  |  1992-03-05  |  6.5 KB  |  185 lines
  1. *:*********************************************************************
  2. *:
  3. *: Procedure file: C:\DEVELOP\LIBRARY\ALDEMO.PRG
  4. *:
  5. *:         System: Replacement for Clipper's Alert Function
  6. *:         Author: Bil Simser
  7. *:      Copyright (c) 1992, Ewe-Nique Creations
  8. *:  Last modified: 03/05/92     13:28
  9. *:
  10. *:  Procs & Fncts: DISPLAYALERT()
  11. *:               : LISTASARRAY()
  12. *:
  13. *:          Calls: DISPLAYALERT()     (function  in ALDEMO.PRG)
  14. *:
  15. *:  This is a simple, yet pretty good looking replacement for Clipper's
  16. *:  ALERT() function. I felt that it wasn't the greatest (as most of us
  17. *:  know) and really shouldn't be relied upon that much anyway. So here's
  18. *:  a replacement for it, or just a simple msg box that will return the
  19. *:  number of the selection the user made.
  20. *:  
  21. *:  Feel free to modify it as you see fit and use it in your application.
  22. *:  I seem to be building a repertoire of source code here of nifty
  23. *:  black box functions, so perhaps a library is in the works. (Oh no! Not
  24. *:  ANOTHER library!) If you do use it, please at least mention where you
  25. *:  got the original concept from please...
  26. *:  
  27. *:  Anyways, the function is COMPLETELY compatible with Clipper's own
  28. *:  Alert and expects that the string you pass will be split with a semi-colon
  29. *:  for each line. Here are the parameters.
  30. *:  
  31. *:  DISPLAYALERT(cString, aOptions, cColors, nRow, cCol, nHeader)
  32. *:  
  33. *:  Where:
  34. *:
  35. *:  cString is the string to pass. Must be split with a ";" (just like ALERT())
  36. *:  
  37. *:  aOptions is any valid array of options. If not passed, will default to "Ok"
  38. *:  
  39. *:  cColors is the color string for the box. Will default to "N+/BG" if not there
  40. *:  
  41. *:  nRow is the starting row for the box
  42. *:  
  43. *:  nCol is the starting colomn for the box
  44. *:  
  45. *:  (NOTE: The box will be centered vertically and horizontally if not passed)
  46. *:  
  47. *:  cHeader is a string to display at the top of the screen. If not passed or
  48. *:  the string is too big to fit, it will default to "Select"
  49. *:  
  50. *:  To bypass any options just pass NIL or leave it blank..
  51. *:  
  52. *:  Compile: CLIPPER ALDEMO /N /W /dTEST <-- To see the demo
  53. *:  
  54. *:  Link:    BLINKER FI ALDEMO, SHADOW
  55. *:  
  56. *:  Any modifications, ideas or if you just want to chat Clipper, give me a
  57. *:  call! I write tax software for a living, but I can be a fun guy...
  58. *:  
  59. *:  Documented 03/05/92 at 13:30                SNAP!  version 5.00
  60. *:*********************************************************************
  61. #ifdef TEST
  62.     CLS
  63.     HITE_FIL := 25
  64.     ST_ROW := 0
  65.     OLDCOLOR := SETCOLOR()
  66.     SET COLOR TO "bg/gr+"
  67.     DO WHILE HITE_FIL > 0
  68.        HITE_FIL := HITE_FIL - 1
  69.        @ ST_ROW, 0 SAY REPLICATE("Σ",79)
  70.        ST_ROW := ST_ROW +1
  71.     ENDDO
  72.     SET COLOR TO OLDCOLOR
  73.     AOPT := {"Good","Bad","Ugly"}
  74.     CHOICE = DISPLAYALERT("This is a test;of the Display Alert Function", AOPT, , , ,"This is the Header!")
  75.     DISPLAYALERT("You selected " + AOPT[choice])
  76.     SET COLOR TO
  77.     CLS
  78. #endif
  79.  
  80. *!*********************************************************************
  81. *!
  82. *!       Function: DISPLAYALERT()
  83. *!
  84. *!      Called by: ALDEMO.PRG                        
  85. *!
  86. *!          Calls: LISTASARRAY()      (function  in ALDEMO.PRG)
  87. *!               : DISPBEGIN()        (function  in ?)
  88. *!               : PADC()             (function  in ?)
  89. *!               : DISPEND()          (function  in ?)
  90. *!
  91. *!*********************************************************************
  92. FUNCTION DISPLAYALERT(CSTRING, AOPTIONS, CCOLORS, NROW, NCOL, CHEADER)
  93.  
  94. /* Setup variables... */
  95. LOCAL CSCREEN, ASTRING := {}
  96. LOCAL NLENGTH := 0, NLINES, NWIDE, NTOP, NLEFT, NBOTT, NRIGHT, NWIDTH := 0
  97. LOCAL COLDCOLOR := SETCOLOR()
  98.  
  99. /* Set Enviroment */
  100. SET WRAP ON
  101. SET CURSOR OFF
  102.  
  103. /* Parse the string into an array to determine the size of the box */
  104. ASTRING := LISTASARRAY(CSTRING, ";")
  105.  
  106. /* Determine longest line in array */
  107. FOR I = 1 TO LEN(ASTRING)
  108.    IF LEN(ASTRING[i]) > NLENGTH
  109.       NLENGTH := LEN(ASTRING[i])
  110.    ENDIF
  111. NEXT
  112.  
  113. /* Process options passed or set default to "Ok" if none */
  114. IF(AOPTIONS != NIL, IF(VALTYPE(AOPTIONS) == "C", AOPTIONS := LISTASARRAY(AOPTIONS, ","),;
  115. AOPTIONS := AOPTIONS), ;
  116.    AOPTIONS := {"Ok"})
  117.  
  118. /* Determine the number of lines in the box and postion of box */
  119. NLINES := LEN(ASTRING) + 4
  120. NWIDE  := NLENGTH + 4
  121. IF(NROW == NIL, NTOP   := INT((MAXROW() - NLINES) / 2), NTOP := NROW)
  122. IF(NCOL == NIL, NLEFT  := INT((MAXCOL() - NWIDE) / 2), NLEFT := NCOL)
  123. NBOTT  := NTOP + NLINES
  124. NRIGHT := NLEFT + NWIDE
  125.  
  126. /* Create the buttons and position them in the box */
  127. FOR I = 1 TO LEN(AOPTIONS)
  128.    NWIDTH := NWIDTH + LEN(AOPTIONS[i])
  129. NEXT
  130. NFREESPACE := NWIDE - NWIDTH
  131. NBETWEEN   := INT(NFREESPACE / (LEN(AOPTIONS) + 1))
  132. NBPOS       := NLEFT + NBETWEEN
  133.  
  134. /* Begin the Display! */
  135. DISPBEGIN()
  136. CSCREEN := SAVESCREEN(NTOP, NLEFT, NBOTT + 1, NRIGHT + 2)
  137. @ NTOP, NLEFT SAY " ■ " COLOR "N/W+"
  138. @ NTOP, NLEFT + 3 SAY SPACE(NWIDE - 2) COLOR "W+/N"
  139. @ NTOP, NLEFT + 4 SAY IF(EMPTY(CHEADER), "Select", IF(LEN(CHEADER) > (NWIDE - 3), "Select", CHEADER)) COLOR "W+/N"
  140. IF(CCOLORS == NIL, SETCOLOR("N+/bg"), SETCOLOR(CCOLORS))
  141. SCROLL(NTOP + 1, NLEFT, NBOTT, NRIGHT)
  142.  
  143. /* Display the text */
  144. FOR I = 1 TO LEN(ASTRING)
  145.    NTPOS := NLEFT + INT((NWIDE - LEN(ASTRING[i])) / 2)
  146.    @ NTOP + 1 + I, NTPOS SAY ASTRING[i]
  147. NEXT
  148.  
  149. /* Display the options */
  150. FOR I = 1 TO LEN(AOPTIONS)
  151.    @ NBOTT - 1, NBPOS PROMPT "" + PADC(AOPTIONS[i],LEN(AOPTIONS[i]) + 2) + ""
  152.    @ NBOTT, NBPOS + 1 SAY REPLICATE("▀", (LEN(AOPTIONS[i]) + 4)) COLOR "N/bg"
  153.    @ NBOTT - 1, NBPOS + LEN(AOPTIONS[i]) + 4 SAY "▄" COLOR "N/bg"
  154.    NBPOS := NBPOS + NBETWEEN + LEN(AOPTIONS[i])
  155. NEXT
  156. SHADOW(NTOP + 1, NLEFT + 1, NBOTT, NRIGHT)
  157. DISPEND()
  158. MENU TO NOPT
  159. SETCOLOR(COLDCOLOR)
  160. RESTSCREEN( NTOP, NLEFT, NBOTT + 1, NRIGHT + 2, CSCREEN)
  161.  
  162. /* Re-set Enviroment */
  163. SET WRAP OFF
  164. SET CURSOR ON
  165.  
  166. RETURN NOPT
  167.  
  168. *!*********************************************************************
  169. *!
  170. *!       Function: LISTASARRAY()
  171. *!
  172. *!      Called by: DISPLAYALERT()     (function  in ALDEMO.PRG)
  173. *!
  174. *!*********************************************************************
  175. FUNCTION LISTASARRAY(CLIST, CDELIMITER )
  176. LOCAL NPOS, ALIST := {}                           // Define an empty array
  177.  
  178. DO WHILE (NPOS := AT(CDELIMITER, CLIST)) != 0
  179.    AADD(ALIST, SUBSTR(CLIST, 1, NPOS - 1))        // Add a new element
  180.    CLIST := SUBSTR(CLIST, NPOS + 1)
  181. ENDDO
  182. AADD(ALIST, CLIST)                                // Add final element
  183. RETURN ALIST                                      // Return the array
  184. *: EOF: ALDEMO.PRG
  185.