home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / MARTIN.ZIP / UDF2.PRG < prev    next >
Encoding:
Text File  |  1990-06-02  |  2.8 KB  |  118 lines
  1. *****************************************************************
  2. * UDF2.PRG                                                      *
  3. * Written by Greg Martin                                        *
  4. * These functions may be freely used, but may not be published. *
  5. *****************************************************************
  6.  
  7.  
  8.  
  9. FUNCTION ErrorBox
  10. PARAMETER Output
  11. PRIVATE Temp, TopRow, BottomRow, Longest, LeftCol, RightCol, CList, CLoc, Screen
  12. IF TYPE("m->Output") == "C"
  13.   PRIVATE String, NoOfLines, Token
  14.   String = Output
  15.   NoOfLines = InCount(String, ";") + 1
  16.   DECLARE Output[NoOfLines]
  17.   Token = ""
  18.   FOR Temp = 1 TO NoOfLines
  19.     FirstToken(@String, @Token, ";")
  20.     Output[Temp] = Token
  21.   NEXT Temp
  22. ENDIF
  23. TopRow = 12 - INT((LEN(Output)/2)) - 1
  24. BottomRow = TopRow + LEN(Output) + 1
  25. Longest = 0
  26. FOR Temp = 1 TO LEN(Output)
  27.   IF LEN(Output[Temp]) > Longest
  28.     Longest = LEN(Output[Temp])
  29.   ENDIF
  30. NEXT Temp
  31. LeftCol = 39 - INT(Longest/2) - 2
  32. RightCol = LeftCol + Longest + 3
  33. CList = SETCOLOR()
  34. CLoc = SCursor()
  35. Screen = SAVESCR(TopRow, LeftCol, BottomRow, RightCol)
  36. SET COLOR TO &ERR_color
  37. @ TopRow, LeftCol, BottomRow, RightCol BOX "╔═╗║╝═╚║ "
  38. FOR Temp = 1 TO LEN(Output)
  39.   @ TopRow + Temp, LeftCol + 2 SAY Output[Temp]
  40. NEXT Temp
  41. SET CURSOR OFF
  42. CLEAR TYPEAHEAD
  43. Temp = INKEY(0)
  44. SET CURSOR ON
  45. RESTSCR(Screen)
  46. RCursor(CLoc)
  47. SETCOLOR(CList)
  48. RETURN(Temp)
  49.  
  50.  
  51. FUNCTION SaveScr
  52. PARAMETER TopRow, LeftCol, BottomRow, RightCol
  53. PRIVATE Screen
  54. Screen  = SAVESCREEN(TopRow, LeftCol, BottomRow, RightCol)
  55. Corners = CHR(TopRow) + CHR(LeftCol) + CHR(BottomRow) + CHR(RightCol)
  56. RETURN(Corners + Screen)
  57.  
  58.  
  59. FUNCTION RestScr
  60. PARAMETER Screen
  61. PRIVATE TopRow, LeftCol, BottomRow, RightCol
  62. TopRow    = ASC(SUBSTR(Screen, 1, 1))
  63. LeftCol   = ASC(SUBSTR(Screen, 2, 1))
  64. BottomRow = ASC(SUBSTR(Screen, 3, 1))
  65. RightCol  = ASC(SUBSTR(Screen, 4, 1))
  66. Screen    = SUBSTR(Screen, 5)
  67. RESTSCREEN(TopRow, LeftCol, BottomRow, RightCol, Screen)
  68. RETURN(.t.)
  69.  
  70.  
  71. FUNCTION SCursor
  72. RETURN(STR(ROW(), 2) + STR(COL(), 2))
  73.  
  74.  
  75. FUNCTION RCursor
  76. PARAMETER CLoc
  77. PRIVATE Row, Col
  78. Row = VAL(SUBSTR(CLoc, 1, 2))
  79. Col = VAL(SUBSTR(CLoc, 3, 2))
  80. @ Row, Col SAY ""
  81. RETURN("")
  82.  
  83.  
  84. FUNCTION FirstToken
  85. PARAMETERS String, Token, Delimiter
  86. PRIVATE Loc, Loc2, Temp1, Char
  87. IF .not. TYPE("Delimiter") == "C"
  88.   Delimiter = " ,"
  89. ENDIF
  90. String = AllTrim(String)
  91. IF EMPTY(String)
  92.   Token  = ""
  93.   String = ""
  94.   RETURN(.f.)
  95. ENDIF
  96. Loc = 0
  97. FOR Temp1 = 1 TO LEN(Delimiter)
  98.   Char = SUBSTR(Delimiter, Temp1, 1)
  99.   IF Char $ String
  100.     Loc2 = AT(Char, String)
  101.     IF Loc = 0
  102.       Loc = Loc2
  103.     ELSE
  104.       Loc = Min(Loc, Loc2)
  105.     ENDIF
  106.   ENDIF
  107. NEXT Temp1
  108. IF Loc = 0
  109.   Token  = String
  110.   String = ""
  111.   RETURN(.t.)
  112. ELSE
  113.   Token  = AllTrim(SUBSTR(String, 1, Loc - 1))
  114.   String = AllTrim(SUBSTR(String, Loc + 1))
  115.   RETURN(.t.)
  116. ENDIF
  117.  
  118.