home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a044 / 3.ddi / MISC / FIRST.PRG < prev    next >
Encoding:
Text File  |  1993-08-31  |  4.1 KB  |  226 lines
  1. #define MAX_WINDOWS 4
  2. #define ACTIVEGETS 1
  3. #define READSAVE 2
  4. #define WAITING 3
  5. #define NORMAL 4
  6.  
  7. #define NO_EVENT -1
  8. #define KEYBD_EVENT 1
  9. #define MENU_EVENT 2
  10. #define SELECTWINDOW_EVENT 3
  11. #define CLOSEWINDOW_EVENT 5
  12. #define BUTTON_EVENT 6
  13.  
  14. #define OPENWINDOW_MENU 1
  15. #define ABOUT_MENU 2
  16.  
  17. set eventmsk to 159
  18.  
  19. set procedure to first
  20.  
  21. set window title to 'First'
  22. public WinCount, state, done, AboutOpen
  23.  
  24. declare winarray[MAX_WINDOWS]
  25.  
  26. *Initialize window array
  27. x = 1
  28. do while x <= MAX_WINDOWS
  29.   winarray[x] = .f.
  30.   inc x
  31. enddo
  32. WinCount = 0
  33. done = .f.
  34. AboutOpen = .f.
  35.  
  36. create popup menu 'Window' from "Open" at 1,1
  37. create popup menu 'Help' from "About" at 1,1
  38. create pulldown menu "mainmenu" from 'Window', 'Help'
  39. set menu to "mainmenu"
  40. create button '   Quit   ' at 20,43
  41. create window 'Event Info' from 19, 2 to 21, 40
  42.  
  43.  
  44.  
  45. *Here is our event loop
  46. myevent = -1
  47.  
  48. do while myevent <> 0
  49.   myevent = GetEvent(NORMAL,0)
  50.   me = myevent
  51.   myevent = TranslateEvent(myevent)
  52.  
  53.   if myevent <> -1 
  54.       actwind = window ()
  55.       select window 'Event Info'
  56.       @ 0,1 say "Event      = "
  57.       @ 1,1 say "Translated = "
  58.       @ 0,13 say me
  59.       @ 1,13 say myevent
  60.       select window actwind
  61.       noev = 0
  62.   endif
  63.  
  64.   do ProcessEvent with myevent
  65. enddo
  66. return
  67.  
  68.  
  69. **********************************
  70. function TranslateEvent(ievent)
  71. **********************************
  72. parameter ievent
  73.  
  74.   if done
  75.     return(0)
  76.   endif
  77.   do case
  78.     case ievent = CLOSEWINDOW_EVENT .and. window() = 'CONSOLE'
  79.       return(0)
  80.     case ievent = BUTTON_EVENT
  81.       return(0)
  82.     otherwise
  83.       return(ievent)
  84.   endcase
  85.  
  86.  
  87. **********************************
  88. function GetEvent
  89. **********************************
  90. parameter emode, getstart
  91.  
  92.   do case
  93.     case emode = ACTIVEGETS
  94.       if getstart > 0
  95.         read starting with getstart
  96.       else
  97.         read
  98.       endif
  99.     case emode = READSAVE
  100.       read save
  101.     case emode = WAITING
  102.       @ 0,0 say
  103.       wait ""
  104.     otherwise
  105.       return(chkevent())
  106.   endcase
  107. return(event())
  108.  
  109.  
  110. **********************************
  111. procedure ProcessEvent
  112. **********************************
  113. parameter ievent
  114.  
  115. do case
  116.   case ievent = NO_EVENT
  117.     return
  118.   case ievent = MENU_EVENT
  119.     if hmenu() = OPENWINDOW_MENU
  120.       do OpenAWindow
  121.     else
  122.       do About
  123.     endif
  124.   case ievent = CLOSEWINDOW_EVENT
  125.     do CloseAWindow
  126.   case ievent = SELECTWINDOW_EVENT
  127.     do SelectAWindow
  128.   otherwise
  129.     return
  130. endcase
  131. return
  132.  
  133.  
  134. **********************************
  135. procedure OpenAWindow
  136. **********************************
  137.  
  138. x = FindWindowSlot()
  139. offset = 1 + x * 2
  140. winarray[x] = .t.
  141. do UpdateAbout with WinCount + 1
  142. set window type to 33
  143. create window 'Window '+str(x,1) from offset, offset + 2;
  144.                  to offset + 8, offset + 52
  145. inc WinCount
  146. if WinCount > 3
  147.   disable menu 1,1
  148. endif
  149. return
  150.  
  151.  
  152. **********************************
  153. procedure CloseAWindow
  154. **********************************
  155. private w
  156.  
  157. w = window()
  158. if w = 'CONSOLE'
  159.   done = .t.
  160.   return
  161. endif
  162. if w = 'About'
  163.   AboutOpen = .f.
  164.   close window 'About'
  165.   enable menu 2,1
  166.   return
  167. endif
  168. if WinCount > 3
  169.   enable  menu 1,1
  170. endif
  171. do UpdateAbout with wincount - 1
  172. x = val(substr(w,8,1))
  173. winarray[x] = .f.
  174. close window w
  175. dec WinCount
  176. return
  177.  
  178.  
  179. **********************************
  180. procedure SelectAWindow
  181. **********************************
  182.  
  183. select window window()
  184. return
  185.  
  186.  
  187. **********************************
  188. function FindWindowSlot
  189. **********************************
  190.  
  191. x = 1
  192. do while x <= MAX_WINDOWS
  193.   if winarray[x] = .f.
  194.     return(x)
  195.   endif
  196.   inc x
  197. enddo
  198.  
  199.  
  200. ***********************
  201. procedure About
  202. ***********************
  203.  
  204. set window type to 33
  205. create window 'About' from 19,59 to 22,77
  206. AboutOpen = .t.
  207. **center("Example",0,0,18,9)
  208. center("Open Windows:",1,0,18,0)
  209. do UpdateAbout with wincount
  210. disable menu 2,1
  211. return
  212.  
  213.  
  214. **********************************
  215. procedure UpdateAbout
  216. **********************************
  217. parameter count
  218.  
  219. if .not. AboutOpen
  220.   return
  221. endif
  222. select window 'About'
  223. @ 2,0 say space (18) 
  224. center(str(count,1),2,0,18,0)
  225. return
  226.