home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / snip0693.zip / SHALERT.PRG < prev    next >
Text File  |  1992-09-06  |  5KB  |  134 lines
  1. /(*
  2. Syntax 
  3.  
  4.     SHAlert(<aMessage>,[<aOptions>],[<cBoxColor>],[<cOptColor>]) -> nChoice 
  5.  
  6. Arguments 
  7.  
  8.     <aMessage> is an array of character strings less to display in a pop-up 
  9.     box on the screen one above the other and centred both vertically and  
  10.     Horizontally.  
  11.  
  12.     <aOptions> is an array of character strings to be used as prompts.  The 
  13.     elements will be displayed across the screen with two spaces between them. 
  14.     If this parameter is not included, the only option will be "Continue". 
  15.      
  16.     <cBoxColor> is a color string to use for the pop-up box. 
  17.      
  18.     <cOptColor> is the color string to use for the options on the bottom line. 
  19.  
  20. Returns 
  21.  
  22.     SHAlert() returns the number of the option the user selected. 
  23.  
  24.      
  25. Description 
  26.  
  27.     Use to pop up a message to the user and allow them to select from an 
  28.     array of choices, or simply select continue.  Good for error messages. 
  29.  
  30.     Use instead of clipper's Alert() function which has defficiencies and 
  31.     some parameters are undocumented so may not exist in future releases. 
  32.     Also improves color handling. 
  33.      
  34. Example 
  35.      
  36.     This example is for a user who has requested access to a file which does 
  37.     not exist. 
  38.      
  39.     Do While .T. 
  40.       If .not. File(cFileName := GetFileNam()) 
  41.         If SHAlert({"The file you selected does not exist." ,; 
  42.                      "Would you like to look for it again?"} ,; 
  43.                      {"Look Again","Quit"}) == 2 
  44.           Exit 
  45.         EndIf 
  46.       Else 
  47.         Exit 
  48.       EndIf 
  49.     EndDo 
  50.     : 
  51.     Return 
  52. */
  53.  
  54. /* 
  55. +-----------------------------------------------------------------------------+ 
  56. |   Function to replace Alert.                                                | 
  57. +-----------------------------------------------------------------------------+ 
  58. */ 
  59. Function SHAlert(aMessage,aOptions,cBoxColor,cOptColor) 
  60. Local nBoxHeight          ,; 
  61.       nBoxTop             ,; 
  62.       nBoxWidth           ,; 
  63.       nBoxLeft            ,; 
  64.       cScreen             ,; 
  65.       cColor := SetColor(),; 
  66.       nChoice             ,; 
  67.       aPosition := {}     ,; 
  68.       nWidth              ,; 
  69.       I                   ,; 
  70.       nLineWidth          ,; 
  71.       lEscape := Set(_SET_ESCAPE),; 
  72.       cPrinterTo := Set(_SET_PRINTFILE),; 
  73.       lPrinterOn := Set(_SET_PRINTER)  ,; 
  74.       lConsole   := Set(_SET_CONSOLE)  ,; 
  75.       cDevice    := Set(_SET_DEVICE) 
  76. If aMessage == Nil .or. ValType(aMessage) <> "A" 
  77.   Return 0 
  78. EndIf 
  79. If aOptions == Nil .or. ValType(aOptions) <> "A" 
  80.   aOptions := {"Continue"} 
  81. EndIf 
  82. If cBoxColor == Nil .or. ValType(cBoxColor) <> "C" 
  83.   cBoxColor := SetColor() 
  84. EndIf 
  85. If cOptColor == Nil .or. ValType(cBoxColor) <> "C" 
  86.   cOptColor := cBoxColor 
  87. EndIf 
  88. SetColor(cBoxColor) 
  89. Set Escape Off 
  90. Set Device to Screen 
  91. Set Console On 
  92. Set Print Off 
  93. nBoxHeight := Len(aMessage) + 3 
  94. nBoxTop    := Int((MaxRow() - nBoxHeight)/2) 
  95. nWidth := 0 
  96. AEVal(aOptions,{| nCurrWidth | nWidth += Len(nCurrWidth) + 4}) 
  97. nBoxWidth  := AMaxStrLen(aMessage) + 4 
  98. If nBoxWidth < nWidth + 4 
  99.   nBoxWidth := nWidth + 4 
  100. EndIf 
  101. nBoxLeft   := Int((MaxCol() - nBoxWidth)/2) 
  102. cScreen    := SaveScreen(nBoxTop,nBoxLeft,nBoxTop + nBoxHeight + 1,; 
  103.                          nBoxLeft + nBoxWidth + 2) 
  104. @ nBoxTop,nBoxLeft to nBoxTop + nBoxHeight,nBoxLeft + nBoxWidth 
  105. @ nBoxTop + 1,nBoxLeft + 1 clear to nBoxTop + nBoxHeight - 1,; 
  106.   nBoxLeft + nBoxWidth - 1 
  107. // comment the following lines out if you do not have FUNCKY 
  108. SetAttr(nBoxTop+1,nBoxLeft+nBoxWidth+1,nBoxTop+nBoxHeight,nBoxLeft+nBoxWidth+2,;
  109.  
  110.         7) 
  111. SetAttr(nBoxTop+nBoxHeight+1,nBoxLeft+2,nBoxTop+nBoxHeight+1,nBoxLeft+; 
  112.         nBoxWidth+2,7) 
  113. For I := 1 to Len(aMessage) 
  114.   nLineWidth := Len(aMessage[i]) 
  115.   @ nBoxTop + I,Int((MaxCol() - nLineWidth)/2) Say aMessage[i] 
  116. Next 
  117. SetColor(cOptColor) 
  118. ASize(aPosition,Len(aOptions)) 
  119. aPosition[1] := Int((MaxCol() - nWidth)/2) + 2 
  120. @ nBoxTop + nBoxHeight - 1,aPosition[1] Prompt " " + aOptions[1] + " " 
  121. For I := 2 to Len(aOptions) 
  122.   aPosition[i] := aPosition[i - 1] + Len(aOptions[i - 1]) + 4 
  123.   @ nBoxTop + nBoxHeight - 1,aPosition[i] Prompt " " + aOptions[i] + " " 
  124. Next 
  125. Menu to nChoice 
  126. RestScreen(nBoxTop,nBoxLeft,nBoxTop+nBoxHeight+1,nBoxLeft+nBoxWidth+2,cScreen) 
  127. SetColor(cColor) 
  128. Set(_SET_ESCAPE,lEscape) 
  129. Set(_SET_PRINTFILE,cPrinterTo,.T.) 
  130. Set(_SET_PRINTER,lPrinterOn) 
  131. Set(_SET_CONSOLE,lConsole) 
  132. Set(_SET_DEVICE,cDevice) 
  133. Return nChoice 
  134.