home *** CD-ROM | disk | FTP | other *** search
/ PC-Online 1998 February / PCOnline_02_1998.iso / filesbbs / dos / dbonlin2.exe / ORDER.ZIP / WINDOWS.PRG < prev   
Encoding:
Text File  |  1995-02-08  |  2.5 KB  |  152 lines
  1. procedure button
  2.   parameters y,x,string
  3.   private hotkey
  4.  
  5.   hotkey = at('~',string)
  6.  
  7.   if (hotkey>0)
  8.      string =stuff(string,hotkey,1,'')
  9.   endif
  10.  
  11.   set color to w+/g
  12.   @ y,x say string
  13.   set color to n/w
  14.   ?? '▄'
  15.   @ y+1,x+1 say replicate('▀',len(string))
  16.  
  17.   if (hotkey>0)
  18.      set color to gr+/g
  19.      @ y,x+hotkey-1 say substr(string,hotkey,1)
  20.   endif
  21.  
  22.  
  23. return
  24.  
  25.  
  26. procedure Xcenter
  27.   parameters y, str
  28.  
  29.   @ y,40-len(str)/2 say str
  30. return
  31.  
  32.  
  33. procedure IntWindow
  34.   parameters y1,x1,y2,x2,title
  35.  
  36.   do FrameIntWin with y1,x1,y2,x2
  37.   do ClearIntWin with y1,x1,y2,x2,title
  38.  
  39. return
  40.  
  41. Procedure FrameIntWin
  42.   parameters y1,x1,y2,x2
  43.  
  44.   if iscolor()
  45.     set color to n+/w
  46.   endif
  47.   @ y1,x1 say replicate('▄',x2-x1+1)
  48.   i=y1+1
  49.   do while i<y2
  50.     @ i,x1 say '█'
  51.     i=i+1
  52.   enddo
  53.   if iscolor()
  54.     set color to w+/w
  55.   endif
  56.   @ y2,x1 say replicate('▀',x2-x1+1)
  57.   i=y1+1
  58.   do while i<y2
  59.     @ i,x2 say '█'
  60.     i=i+1
  61.   enddo
  62.  
  63.  
  64. Procedure ClearIntWin
  65.   parameters y1,x1,y2,x2,title
  66.  
  67. *  title1=' '
  68.  
  69.   if (len(title)>0)
  70.      set color to w+/rb
  71.      title1 = space ((x2-x1-len(title))/2)+title + space((x2-x1-len(title))/2)
  72.      @ y1+1,x1+1 say left (title1,x2-x1-1)
  73.   endif
  74.  
  75. *  ? title1
  76. *  ? x2-x1-1
  77. *  ? left(title1,x2-x1-1)
  78. *  wait
  79.  
  80.   set color to W+/BG
  81.  
  82.   if len(title)>0
  83.     @ y1+2,x1+1 clear to y2-1,x2-1
  84.   else
  85.     @ y1+1,x1+1 clear to y2-1,x2-1
  86.   endif
  87. return
  88.  
  89.  
  90. procedure XWindow
  91.   parameters y1,x1,y2,x2,heading
  92.  
  93.   if iscolor()
  94.     set color to w+/w
  95.   endif
  96.   @ y1,x1 say '█'+ replicate('▀',x2-x1-1)
  97.   set color to n+/w
  98.   ??'▄'
  99.   set color to w+/w
  100.   i=y1+1
  101.   do while i<y2
  102.     @ i,x1 say '█'
  103.     i=i+1
  104.   enddo
  105.   if iscolor()
  106.     set color to w+/w
  107.   endif
  108.   @ y2,x1 say '▀'
  109.   if iscolor()
  110.     set color to w+/w
  111.   endif
  112.   @ y1+1,x1+1 clear to y2-1,x2-1
  113.   if iscolor()
  114.     set color to n+/w
  115.   endif
  116.   @ y2,x1+1 say replicate('▄',x2-x1)
  117.   i=y1+1
  118.   set color to n+/n
  119.   do while i<=y2
  120.     @ i,x2 say '█'
  121.     i=i+1
  122.   enddo
  123.   if (len(heading)>0)
  124.     set color to w+/w
  125.     @ y1+1,(x1+x2+1-len(heading))/2 say heading
  126.   endif
  127. return
  128.  
  129. procedure flatWindow
  130.   parameters y1,x1,y2,x2
  131.  
  132.   if iscolor()
  133.     set color to w+/b
  134.   endif
  135.   @ y1,x1 clear to y2,x2
  136.   @ y1,x1 say '┌'
  137.   ?? replicate ('─',x2-x1-1)
  138.   ?? '┐'
  139.   @ y2,x1 say '└'
  140.   ?? replicate ('─',x2-x1-1)
  141.   ?? '┘'
  142.   i=y1+1
  143.   do while i<y2
  144.     @ i,x1 say '│'
  145.     @ i,x2 say '│'
  146.     i=i+1
  147.   enddo
  148. **  @ y2,x1+1 clear to y2,x2
  149. **  @ y1+1,x2 clear to y2,x2
  150. return
  151.  
  152.