home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / snip0693.zip / ALERT.PRG < prev    next >
Text File  |  1992-09-06  |  2KB  |  106 lines
  1.  *
  2.  * show choices and wait for user to choose one
  3.  *
  4.  FUNCTION ALERT(param1,param2,param3)
  5.  *-----------------------------------------------------------------------------*
  6.   LOCAL row:=12,mess:='',prompts:={'OK'},mess_a:={}
  7.   LOCAL a,b,c,d,original
  8.   LOCAL max:=0,box_width:=0,x,y,choice:=0,prompt_width,max_mess:=0
  9.   LOCAL scr_buff,cur_color
  10.  
  11.   ALERT__(param1,@row,@mess,@prompts)
  12.   ALERT__(param2,@row,@mess,@prompts)
  13.   ALERT__(param3,@row,@mess,@prompts)
  14.  
  15.   original:=ACLONE(prompts)
  16.  
  17.   a:=row
  18.   c:=a+4
  19.  
  20.   DO WHILE !EMPTY(mess)
  21.     AADD(mess_a,STRIP_STRING(@mess,';'))
  22.   ENDDO
  23.   c+=IF(LEN(mess_a)==0,-1,LEN(mess_a)) - 1
  24.  
  25.   AEVAL(mess_a,{ |v| max_mess:=MAX(max_mess,LEN(v)) })
  26.  
  27.   AEVAL(prompts,{ |v| max:=MAX(max,LEN(v)) })
  28.   max+=4
  29.   prompt_width:=(max*LEN(prompts))+((LEN(prompts)+1)*2)+4
  30.   box_width:=MAX(max_mess+6,prompt_width)
  31.  
  32.   AEVAL(prompts,{ |v,s| prompts[s]:=PADC(v,max) })
  33.  
  34.   b:=(80-box_width)/2
  35.   d:=b+box_width-1
  36.  
  37.   cur_color:=SETCOLOR()
  38.   IF ISCOLOR()
  39.     SETCOLOR("+W/R,+W/B")
  40.   ELSE
  41.     SETCOLOR("N/W,+W/N")
  42.   ENDIF
  43.   scr_buff:=SAVESCREEN(a,b,c,d)
  44.   @ a,b,c,d BOX "VD7:=DS: "
  45.   FOR x:=1 TO LEN(mess_a)
  46.     @ a+x,(80-LEN(mess_a[x]))/2 SAY mess_a[x]
  47.   NEXT
  48.  
  49.   DO WHILE choice==0
  50.     y:=b+4+(box_width-prompt_width)/2
  51.     FOR x:=1 TO LEN(prompts)
  52.       @ c-1,y PROMPT prompts[x]
  53.       y+=max+2
  54.     NEXT
  55.     MENU TO choice
  56.   ENDDO
  57.  
  58.   RESTSCREEN(a,b,c,d,scr_buff)
  59.   SETCOLOR(cur_color)
  60.  
  61.   RETURN choice
  62.  
  63.  *-----------------------------------------------------------------------------*
  64.  *
  65.  * assign parameters to its slots
  66.  *
  67.  STATIC FUNCTION ALERT__(param,row,mess,array)
  68.  *-----------------------------------------------------------------------------*
  69.  
  70.   DO CASE
  71.     CASE VALTYPE(param)=='N'
  72.       row:=param
  73.     CASE VALTYPE(param)=='C'
  74.       mess:=param
  75.     CASE VALTYPE(param)=='A'
  76.       array:=ACLONE(param)
  77.   ENDCASE
  78.  
  79.   RETURN NIL
  80.  
  81.  *-----------------------------------------------------------------------------*
  82.  *
  83.  * extract token from passed string
  84.  *
  85.  FUNCTION STRIP_STRING(string,schr,elem)
  86.  *-----------------------------------------------------------------------------*
  87.   LOCAL x,nstr:='',chr
  88.  
  89.   IF elem # NIL
  90.     FOR x:=1 TO elem-1
  91.       STRIP_STRING(@string,schr)
  92.     NEXT
  93.   ENDIF
  94.  
  95.   FOR x:=1 TO LEN(string)
  96.     chr:=SUBSTR(string,x,1)
  97.     IF chr $ schr
  98.       EXIT
  99.     ENDIF
  100.     nstr+=chr
  101.   NEXT
  102.  
  103.   string:=RIGHT(string,MAX(LEN(string)-x,0))
  104.  
  105.   RETURN nstr
  106.