home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Tiny_Dev_E1795559192004.psc / BizCard / class / clsTools.cls < prev    next >
Text File  |  2001-09-14  |  4KB  |  146 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsTools"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14.  
  15. Public TStack As New Collection
  16. Public hangle As Long
  17. Const mText = 2
  18.  
  19. ' Class used for string and math function, subs
  20. Function CountChr(ByVal Range As String, ByVal Criteria As String) As Long
  21. Dim I As Integer
  22. Dim Cnt As Long
  23.  
  24. If Len(Trim(Range)) = 0 Then CountIF = 0: Exit Function
  25.  
  26.     Do While I < Len(Range)
  27.         I = I + 1
  28.         If Mid(Range, I, 1) = Criteria Then
  29.             Cnt = Cnt + 1
  30.         End If
  31.         DoEvents
  32.     Loop
  33.     
  34.     CountChr = Cnt
  35.     Cnt = 0
  36.     Range = ""
  37.     Criteria = ""
  38.     
  39. End Function
  40.  
  41. Function StrToVal(StrString As String) As Integer
  42.     ' Converts a string to a integer
  43.     StrToVal = CInt(StrString)
  44. End Function
  45.  
  46. Function StrFormatDateTime(lExpression As String, Optional ByVal lFormat As Variant) As Variant
  47.     StrFormatDateTime = Format(lExpression, lFormat)
  48. End Function
  49.  
  50. Function TColor(ByVal lColor As Integer) As Long
  51.     If lColor < 0 Then
  52.         TColor = 0
  53.         Exit Function
  54.     ElseIf lColor >= 15 Then
  55.         TColor = vbWhite
  56.         Exit Function
  57.     Else
  58.         TColor = QBColor(lColor)
  59.     End If
  60. End Function
  61.  
  62. Function GetEnvVar(sName As String) As String
  63. 'This is used to return the string assigned to an environment variable
  64. Dim iRet As Long, sBuff As String
  65.     sBuff = Space(255)
  66.     iRet = GetEnvironmentVariable(sName, sBuff, 255)
  67.     
  68.     If Not iRet <> 0 Then
  69.         GetEnvVar = ""
  70.         sBuff = ""
  71.         Exit Function
  72.     Else
  73.         GetEnvVar = Left(sBuff, iRet)
  74.         iRet = 0
  75.         sBuff = ""
  76.     End If
  77. End Function
  78.  
  79. Function SetEnvVar(ByVal sName As String, ByVal sValue As String) As Long
  80.     'This is used to set an environment variable
  81.     SetEnvVar = SetEnvironmentVariable(sName, sValue)
  82. End Function
  83.  
  84. Public Sub Swap(a, b)
  85. Dim Temp
  86.     Temp = b
  87.     b = a
  88.     a = Temp
  89.     Temp = 0
  90. End Sub
  91.  
  92. Function Power(ByVal iNum As Variant, ByVal iCount As Variant)
  93.     Power = (iNum * iCount)
  94. End Function
  95.  
  96. Function Prompt(Optional ByVal aPrompt As String, Optional ByVal Title As String) As String
  97.     Prompt = InputBox(aPrompt, Title)
  98. End Function
  99. 'end
  100.  
  101. Function GetClip(Optional ByVal zFormatType As Integer = 1) As String
  102.     If (zFormatType < 1) Or (zFormatType > 2) Then zFormatType = 1
  103.  
  104.     If zFormatType <= 1 Then
  105.         GetClip = Clipboard.GetText(vbCFText)
  106.     End If
  107.     
  108.     If zFormatType = 2 Then
  109.         GetClip = Clipboard.GetText(vbCFRTF)
  110.     End If
  111.     
  112. End Function
  113.  
  114. Function SetClip(ByVal Strbuff As String, Optional ByVal zFormatType As Integer = 1) As Integer
  115.  
  116.     If (zFormatType < 1) Or (zFormatType > 2) Then zFormatType = 1
  117.     Clipboard.Clear
  118.     If zFormatType <= 1 Then
  119.         Clipboard.SetText Strbuff, vbCFText
  120.         SetClip = 1
  121.     End If
  122.     
  123.     If zFormatType = 2 Then
  124.         Clipboard.SetText Strbuff, vbCFRTF
  125.         SetClip = 1
  126.     End If
  127.     
  128. End Function
  129.  
  130. Public Sub SaveSettingA(ByVal tAppName As String, ByVal tSelection As String, ByVal tKey As String, ByVal tSetting As String)
  131.     SaveSetting tAppName, tSelection, tKey, tSetting
  132. End Sub
  133.  
  134. Public Function GetSettingA(ByVal tAppName As String, ByVal tSelection As String, ByVal tKey As String, ByVal tDefault As String) As String
  135.     GetSettingA = GetSetting(tAppName, tSelection, tKey, tDefault)
  136. End Function
  137.  
  138. Public Property Get bsText() As Integer
  139.     bsText = 1
  140. End Property
  141.  
  142. Public Property Get bsRTF() As Integer
  143.     bsRTF = 2
  144. End Property
  145.  
  146.