home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / common.bas < prev    next >
Encoding:
BASIC Source File  |  1998-12-19  |  3.4 KB  |  106 lines
  1. Attribute VB_Name = "modCommonProcs"
  2. Option Explicit
  3.  
  4. '-------------------------------------------------'
  5. 'This Checks a File to see if it exists or not    '
  6. '-------------------------------------------------'
  7. Public Function CheckFile(Path As String) As Boolean
  8.     CheckFile = True 'Assume Success
  9.     On Error Resume Next
  10.     Dim Disregard As Long
  11.     Disregard = FileLen(Path)
  12.     If Err <> 0 Then CheckFile = False
  13. End Function
  14.  
  15. '-------------------------------------------------'
  16. 'This Checks a path to see if it exists or not.   '
  17. '-------------------------------------------------'
  18. Public Property Get CheckPath(Path As String) As Boolean
  19.     CheckPath = True 'Assume Success
  20.     On Error Resume Next
  21.     ChDir Path
  22.     If Err <> 0 Then CheckPath = False
  23. End Property
  24.  
  25. '-------------------------------------------------'
  26. 'This is used in case you want to open a file     '
  27. 'with the 'Binary' Option without having the old  '
  28. 'Data There(m_lngLoop Know it is possible to kill it but  '
  29. 'This checks for validity first.)                 '
  30. '-------------------------------------------------'
  31. Public Function MakeFileEmpty(Path As String) As Boolean
  32.     Dim FreeFile
  33.     If Not CheckFile(Path) Then _
  34.         MakeFileEmpty = False _
  35.         : Exit Function
  36.     On Error Resume Next
  37.     Open Path For Output As #1
  38.         If Err <> 0 Then _
  39.             MakeFileEmpty = False _
  40.             : Exit Function
  41.     Close #1
  42. End Function
  43.  
  44. '-------------------------------------------------'
  45. 'This Procedure Was Wrote To Return a Filename    '
  46. 'Without Having to use The 'If' Statment in the   '
  47. 'Procedures that need the correct Filename        '
  48. 'Returned                                         '
  49. '-------------------------------------------------'
  50. Public Function MakeFileName(FileName As String, Path As String) As String
  51.     Dim strBckSlash$
  52.     If Not Right(Path, 1) = "\" Then
  53.         strBckSlash$ = "\"
  54.     End If
  55.     MakeFileName = Path$ & strBckSlash & FileName
  56. End Function
  57.  
  58. Public Function CheckString(Collection As Collection, Text) As Boolean
  59.     Dim m_lngLoop As Long
  60.     For m_lngLoop = 1 To Collection.Count
  61.         If LCase(Collection(m_lngLoop)) = LCase(Text) Then CheckString = True
  62.     Next
  63. End Function
  64.  
  65. Public Sub EndApp()
  66.     Dim Form As Form
  67.     For Each Form In Forms
  68.         Unload Form
  69.     Next
  70. End Sub
  71.  
  72. Public Sub DoUntilNotVisible(Form As Form)
  73.     Form.Show 0
  74.     Do Until Not Form.Visible
  75.         DoEvents
  76.     Loop
  77. End Sub
  78. Public Function GetMatchCount(ByVal Text As String, ByVal Search4 As String) As Long
  79.     Dim cnt As Long, m_lngLoop As Long
  80.     For m_lngLoop = 1 To Len(Text)
  81.         If Mid(Text, m_lngLoop, Len(Search4)) = Search4 Then
  82.             cnt = cnt + 1
  83.         End If
  84.     Next
  85.     GetMatchCount& = cnt
  86. End Function
  87.  
  88. Public Function WrapText(ByVal Text As String, ByVal WrapLength As Single, ByVal TextWidFunctObj As Object) As String
  89.     Dim txtObj As Object, sText As String, m_lngLoop As Long, OutText As String
  90.     Dim TP1 As Long, TP2 As Long 'Text Location Variables.
  91.     sText = Text
  92.     TP1 = 1
  93.     Set txtObj = TextWidFunctObj
  94.      For m_lngLoop = 1 To Len(Text)
  95.         TP2 = TP2 + 1
  96.         If txtObj.TextWidth(Mid(sText, TP1, TP2)) >= WrapLength Then
  97.                OutText = OutText & Mid(sText, TP1, TP2) & vbCrLf
  98.                TP1 = m_lngLoop
  99.                TP2 = 0
  100.         End If
  101.      Next
  102.     OutText = OutText & Mid(sText, TP1)
  103.     WrapText = OutText
  104. End Function
  105.  
  106.