home *** CD-ROM | disk | FTP | other *** search
/ Media Share 13 / mediashare_13.zip / mediashare_13 / ZIPPED / NETWORK / GP25.ZIP / MSGWIN.PRG < prev    next >
Text File  |  1993-12-17  |  7KB  |  332 lines
  1.  
  2. parameters cMsg , xParam2 , cButtons , cReadOptions , cHelpObj
  3.  
  4. private nAspectRatio , cTalkStat , nWidth , nBCount , nBWidth , cOptions , ;
  5.         nMaxBWidth , cScratch , cTemp , nHeight , nVPos , nOldRMarg , nOldLMarg , ;
  6.         lLastWrap , nInvAR , wMsg , lVMode , nXCtr , nYCtr , aButtons , ;
  7.         nLastMemWidth , cLastPrt , nHPos , nHSize , nVOffSet , nDefButton , ;
  8.         cLastWin , cHelp , cHelpEdit , cTHelp , cTHelpEdit , cBorder , lAlertMode , ;
  9.         cTitle , nChoice, n
  10.  
  11.  
  12. if set('TALK') = 'ON'
  13.     set talk off
  14.     cTalkStat = 'ON'
  15. else
  16.     cTalkStat = 'OFF'
  17. endif
  18.  
  19. if empty(cHelpObj)
  20.     cHelpObj = 'DIALOG'
  21. endif
  22. cBorder = 'DOUBLE'
  23. cLastWin = wontop()
  24. cTitle = ''
  25. if empty(cLastWin)
  26.     cLastWin = 'SCREEN'
  27. else
  28.     cLastWin = substr(cLastWin , 1 , at(' ' , cLastWin))
  29. endif
  30. cHelp = on('KEY' , 'F1')
  31. cHelpEdit = on('KEY' , 'SHIFT+F1')
  32. push key clear
  33.  
  34. do case
  35. case 'CALLHELP' $ upper(cHelp)
  36.     cTHelp = 'callHelp with cLastWin, cHelpObj'
  37.     on key label F1 do &cTHelp
  38.     if 'HELPEDIT' $ upper(cHelpEdit)
  39.         cTHelpEdit = 'HelpEdit with cLastWin, cHelpObj'
  40.         on key label SHIFT+f1 do &CTHelpEdit
  41.     endif
  42. otherwise
  43.     if not empty(cHelp)
  44.         on key label F1 &cHelp
  45.     endif
  46.     if not empty(cHelpEdit)
  47.         on key label SHIFT+F1 &cHelpEdit
  48.     endif
  49. endcase
  50.  
  51.  
  52. cLastPrt = set('PRINT')
  53. set print off
  54. wMsg = sys(2015)
  55. nAspectRatio = scols() / srows()
  56. nInvAR = 1 / nAspectRatio
  57. nBCount = 0
  58. nMaxBWidth = 1
  59. lVMode    = .f.
  60. nWidth    = 0
  61. nChoice = 0
  62. nDefButton = 1
  63. nOldRMarg = _rmargin
  64. nOldLMarg = _lmargin
  65. _lmargin  = 2
  66. lLastWrap = _wrap
  67. _wrap = .t.
  68. nHSize = 2
  69. nVSize = 1
  70. nVOffSet = 0
  71. nXCtr = scols() / 2
  72. nYCtr = srows() / 2
  73. lAlertMode = .f.
  74. do case
  75. case type('XPARAM2') = 'L'
  76.     lAlertMode = xParam2
  77. case type('XPARAM2') = 'C'
  78.     if left(alltrim(xParam2) , 1) = '!'
  79.         lAlertMode = .t.
  80.         cTitle = substr(xParam2 , 2)
  81.     else
  82.         cTitle = xParam2
  83.     endif
  84.     if cHelpObj == 'DIALOG'
  85.         cHelpObj = strtran(alltrim(cTitle) , ' ' , '_')
  86.     endif
  87. endcase
  88. nLastMemWidth = set('MEMOWIDTH')
  89. declare aButtons[10]
  90.  
  91. if empty(cReadOptions)
  92.     cReadOptions = ''
  93. else
  94.     cReadOptions = alltrim(cReadOptions)
  95. endif
  96.  
  97. do case
  98. case type('_DOS') = 'U'
  99.     *  No Action.  This case allows 2.0 to use this procedure also
  100. case _DOS
  101. case _Windows
  102.     cBorder = 'SYSTEM'
  103.     nVSize = 1.75
  104.     nHSize = 2
  105.     nVOffset = .75
  106. case _unix
  107. case _mac
  108. endcase
  109. if empty(cButtons)
  110.     cButtons = '@*HT \!  \<OK  '
  111. else
  112.     if left(cButtons , 1) == ';'
  113.         cButtons = '@*VT ' + substr(cButtons , 2)
  114.     endif
  115.     if left(cButtons , 1) != '@'
  116.         cButtons = '@*HT ' + ltrim(cButtons)
  117.     endif
  118. endif
  119.  
  120. cOptions = upper(left(cButtons , at(' ' , cButtons) - 1))
  121. cButtons = substr(cButtons , at(' ' , cButtons) + 1)
  122.  
  123. cScratch = cButtons
  124. * Trim off format commands
  125.  
  126. if right(cScratch , 1) != ';'
  127.     cScratch = cScratch + ';'
  128. endif
  129.  
  130. cButtons = ''
  131.  
  132. do while len(cScratch) > 0
  133.     nBCount = nBCount + 1
  134.  
  135.     cTemp = substr(cScratch , 1 , at(';' , cScratch))
  136.     cScratch = substr(cScratch , len(cTemp) + 1)
  137.  
  138.     cTemp = strtran(cTemp , ';')
  139.  
  140.     if not '\<' $ cTemp
  141.         cTemp = AddHotKey(cTemp)
  142.     endif
  143.  
  144.     cButtons = cButtons + cTemp + ';'
  145.  
  146.     cTemp = strtran(cTemp , '\<')
  147.     cTemp = strtran(cTemp , '\?')
  148.     cTemp = strtran(cTemp , '\\')
  149.     if '\!' $ cTemp
  150.         nDefButton = nBCount
  151.         cTemp = strtran(cTemp , '\!')
  152.     endif
  153.  
  154.     aButtons[nBCount] = upper(alltrim(cTemp))
  155.  
  156.     nBWidth = len(cTemp) + 4
  157.     nMaxBWidth = max(nMaxBWidth , nBWidth)
  158. enddo
  159.  
  160. nBWidth = (nHSize + nMaxBWidth) * nBCount
  161. cButtons = left(cButtons , len(cButtons) - 1)
  162.  
  163. * SET ALT HOT KEYS FOR BUTTONS
  164.  
  165. cTempButt = cButtons
  166. nIndex = at('\<' , cTempButt)
  167. do while nIndex > 0
  168.     cKey = upper(substr(cTempButt , nIndex+2 , 1))
  169.     if ! empty(cKey)
  170.         on key label Alt+&cKey. keyboard "{&cKey}"
  171.     endif
  172.     if nIndex + 2 < len(cTempButt)
  173.         cTempButt = substr(cTempButt , nIndex + 2)
  174.         nIndex = at('\<' , cTempButt)
  175.     else
  176.         nIndex = 0
  177.     endif
  178. enddo
  179.  
  180. *  Ok, now we need to go through and count the number of buttons
  181. *  and get the widest one., and calc the width of our button line
  182.  
  183. nWidth = nBWidth + 2
  184.  
  185. if nWidth + 4 > scols()
  186.     if 'H' $ cOptions
  187.         cOptions = strtran(cOptions , 'H' , 'V')
  188.     else
  189.         if not 'V' $ cOptions
  190.             cOptions = cOptions + 'V'
  191.         endif
  192.     endif
  193. endif
  194.  
  195. if 'V' $ cOptions
  196.     lVMode = .t.
  197.     nHSize = 1
  198. endif
  199.  
  200. * cMsg really holds the message we wish to display
  201. cMsg = strtran(cMsg , '~' , chr(13) + chr(10))
  202.  
  203. if lVMode
  204.     nWidth = 24
  205.     set memowidth to nWidth - 4
  206.     nHeight = nBCount * nVSize * 2
  207.     do while memlines(cMsg) + 1 > nHeight
  208.         nHeight = (nWidth + nMaxBWidth) * nInvAR
  209.         nWidth = nWidth + 4
  210.         set memowidth to nWidth - 4
  211.     enddo
  212.  
  213.     _rmargin = _lmargin + nWidth - 4
  214.     nWidth = nWidth + nMaxBWidth + 4
  215.     nHeight = nHeight + 2.5
  216. else
  217.     *
  218.     * At this point, nWidth has the width of our buttons    
  219.     *
  220.     n=strlen(cMsg)+6
  221.     do case
  222.     case n > (scols()-20)
  223.         nWidth=Max(nWidth,40)
  224.     case nWidth > n
  225.         nWidth=Max(nWidth,40)
  226.     otherwise
  227.         nWidth=max(nWidth,n)
  228.     endcase
  229.     set memowidth to nWidth - 4
  230.     do while ((nWidth - 4) / (memlines(cMsg) + 5)) < (nAspectRatio)
  231.         nWidth = nWidth + 4
  232.         set memowidth to nWidth - 4
  233.     enddo
  234.     nHeight = memlines(cMsg) + 5
  235.     _rmargin = _lmargin + nWidth - 4
  236. endif
  237.  
  238.  
  239.  
  240. define window (wMsg) ;
  241.         from nYCtr - nHeight / 2 , nXCtr - nWidth / 2 ;
  242.         to nYCtr + nHeight / 2 , nXCtr + nWidth / 2 ;
  243.         color scheme (iif(lAlertMode , 7 , 5)) ;
  244.         shadow float &cBorder title cTitle noclose nogrow nozoom
  245.  
  246. activate window (wMsg) noshow
  247. if memlines(cMsg) == 1
  248.     ?padc(cMsg , (_rmargin - _lmargin) )
  249. else
  250.     ? cMsg
  251. endif
  252.  
  253. if lVMode
  254.     nVPos = (nHeight - nVSize * 2 * nBCount) / 2 + nVOffset
  255.     nHPos = wcols() - 2 - nMaxBWidth
  256. else
  257.     nVPos = row() + 2
  258.     nHPos =  ((wcols() - nBWidth) / 2) + iif(nBCount > 1 , 1 , 2)
  259. endif
  260.  
  261. clear typeahead
  262. keyboard chr(32)
  263. = inkey()
  264. clear typeahead
  265. wait clear
  266. cButtons = cOptions + ' ' + cButtons
  267.  
  268. @ nVPos , nHPos get nChoice ;
  269.         picture (cButtons) ;
  270.         size nVSize , nMaxBWidth , nHSize
  271.  
  272. read cycle ;
  273.         modal ;
  274.         with (wMsg) ;
  275.         object (nDefButton) ;
  276.         &cReadOptions
  277.  
  278.  
  279. set memowidth to nLastMemWidth
  280. deactivate window (wMsg)
  281. release window (wMsg)
  282. _rmargin = nOldRMarg
  283. _lmargin = nOldLMarg
  284. _wrap = lLastWrap
  285.  
  286. if cTalkStat = 'ON'
  287.     set talk on
  288. endif
  289.  
  290. if cLastPrt = 'ON'
  291.     set print on
  292. endif
  293.  
  294. pop key
  295.  
  296. if nChoice > 0
  297.     return aButtons[nChoice]
  298. endif
  299. return ''
  300.  
  301. function AddHotKey
  302.  
  303.     parameter cButton
  304.     private n , c
  305.  
  306.     for n = 1 to len(cButton)
  307.         c = substr(cButton , n , 1)
  308.         if isalpha(c) or isdigit(c)
  309.             cButton = substr(cButton , 1 , n - 1) + ;
  310.                     '\<' + substr(cButton , n)
  311.             exit
  312.         endif
  313.     endfor
  314.  
  315. return cButton
  316.  
  317. FUNCTION strlen
  318. Parameter c
  319. private n, nLength, nChar
  320. nLength=0
  321. for n=1 to len(c)
  322.     nChar=asc(substr(c,n,1))
  323.     do case
  324.     case nChar=9
  325.         nLength=nLength+8
  326.     case nChar=10 or nChar=12 or nChar=13
  327.         nLength=nLength+255
  328.     otherwise
  329.         nLength=nLength+1
  330.     endcase
  331. endfor
  332. return nLength