?? usefuls.bas
字號:
Dim lPos As Long
Dim lNewString As String
' if it contains a quote, we need to substitute this with ""
If Len(pString) = 0 Then
ConvertStringToValidCSVFormat = ""
Exit Function
End If
If Len(pString) = 1 Then
If pString = Chr(34) Then
ConvertStringToValidCSVFormat = Chr(34) & Chr(34) & Chr(34) & Chr(34)
Exit Function
End If
End If
lNewString = Chr(34)
For lPos = 1 To Len(pString)
If Mid(pString, lPos, 1) = Chr(34) Then
lNewString = lNewString & Chr(34)
End If
lNewString = lNewString & Mid(pString, lPos, 1)
Next
lNewString = lNewString & Chr(34)
ConvertStringToValidCSVFormat = lNewString
End Function
' Useful when retrieving rows from database
Public Function GRON(Var As Variant) As String
If IsNull(Var) Then
GRON = ""
Else
GRON = Var
End If
End Function
' Search and Replace
Public Function QSAR(ByVal pString As String, ByVal pSearch As String, Optional ByVal pReplace As String = "", Optional pCompare As Long = vbBinaryCompare, Optional GlobalReplace As Boolean = True) As String
Dim lLen1 As Long
Dim lLen2 As Long
Dim lStartFind As Long
Dim lFoundLoc As Long
Dim ltmpString As String
lLen1 = Len(pString)
lLen2 = Len(pSearch)
lStartFind = 1
ltmpString = ""
Do
lFoundLoc = InStr(lStartFind, pString, pSearch, pCompare)
If lFoundLoc = 0 Then
Exit Do
End If
ltmpString = ltmpString & Mid(pString, lStartFind, lFoundLoc - lStartFind) & pReplace
If lStartFind = 1 And GlobalReplace = False Then
lStartFind = lFoundLoc + lLen2
Exit Do
End If
lStartFind = lFoundLoc + lLen2
Loop
ltmpString = ltmpString & Mid(pString, lStartFind, lLen1 - lStartFind + 1)
QSAR = ltmpString
End Function
' Note that this ONLY supports the formats %s, \n and \t
Public Function PrintF(FormatString As String, ParamArray PA() As Variant)
Dim Param As Variant
Dim OutputString As String
OutputString = FormatString
For Each Param In PA
OutputString = QSAR(OutputString, "%s", Param, , False)
Next
OutputString = QSAR(OutputString, "\n", vbCrLf, , True)
OutputString = QSAR(OutputString, "\t", vbTab, , True)
Debug.Print OutputString
End Function
' Note that this ONLY supports the formats %s, \n and \t
Public Function FPrintF(FileNumber As Long, FormatString As String, ParamArray PA() As Variant)
Dim Param As Variant
Static OutputString As String
OutputString = OutputString & FormatString
For Each Param In PA
OutputString = QSAR(OutputString, "%s", Param, , False)
Next
OutputString = QSAR(OutputString, "\n", vbCrLf, , True)
OutputString = QSAR(OutputString, "\t", vbTab, , True)
If Right(OutputString, 2) = vbCrLf Then
Print #FileNumber, Mid(OutputString, 1, Len(OutputString) - 2)
OutputString = ""
End If
End Function
'-------------------------------------------
' Conversion functions
'-------------------------------------------
Public Function LengthUnitConvert(InitialValue As Double, InitialUnit As LengthUnits, FinalUnit As LengthUnits) As Double
Dim Mili As Double
Select Case InitialUnit
' Metric
Case Micrometres
Mili = InitialValue * 0.001
Case Milimetres
Mili = InitialValue
Case Centimetres
Mili = InitialValue * 10
Case Metres
Mili = InitialValue * 1000
Case Kilometres
Mili = InitialValue * 1000000
' Common Imperial
Case Inches
Mili = InitialValue * 25.4
Case Feet
Mili = InitialValue * 25.4 * 12
Case Yards
Mili = InitialValue * 25.4 * 36
Case Miles
Mili = InitialValue * 25.4 * 36 * 1760
' Nautical and horse racing
Case NauticalMiles
Mili = InitialValue * 25.4 * 36 * 6080
Case CableLengths
Mili = InitialValue * 25.4 * 12 * 600
Case Chains
Mili = InitialValue * 25.4 * 12 * 66
Case Fathoms
Mili = InitialValue * 25.4 * 12 * 6
Case Furlongs
Mili = InitialValue * 25.4 * 12 * 660
Case Hands
Mili = InitialValue * 25.4 * 4
Case Degrees
Mili = InitialValue * 25.4 * 36 * 6080 * 60
Case Minutes
Mili = InitialValue * 25.4 * 36 * 6080 ' yes, same as nautical mile
Case Seconds
Mili = InitialValue * 25.4 * 36 * (6080 / 60)
' Computer
Case Dots
Mili = InitialValue * 25.4 / 300
Case Points
Mili = InitialValue * 25.4 / 72
Case RadixDots
Mili = InitialValue * 25.4 / 1200
Case Twips
Mili = InitialValue * 25.4 / 1440
Case PlotterUnits
Mili = InitialValue * 25.4 / 1016
' Scientific
' Case Angstroms
' Mili = InitialValue * 1 / 10000000000#
Case LightYears
Mili = InitialValue * 1000 * 9.4 * 10 ^ 15
' Old and Biblical
Case Cubits
Mili = InitialValue * 25.4 * 18
Case RoyalEgyptianCubits
Mili = InitialValue * 25.4 * 21
Case Ells
Mili = InitialValue * 25.4 * 45
Case Palms
Mili = InitialValue * 127
Case Reeds
Mili = InitialValue * 1520
Case Span
Mili = InitialValue * 25.4 * 9
End Select
Select Case FinalUnit
' Metric
Case Micrometres
LengthUnitConvert = Mili / 0.001
Case Milimetres
LengthUnitConvert = Mili
Case Centimetres
LengthUnitConvert = Mili / 10
Case Metres
LengthUnitConvert = Mili / 1000
Case Kilometres
LengthUnitConvert = Mili / 1000000
' Common Imperial
Case Inches
LengthUnitConvert = Mili / 25.4
Case Feet
LengthUnitConvert = Mili / (25.4 * 12)
Case Yards
LengthUnitConvert = Mili / (25.4 * 36)
Case Miles
LengthUnitConvert = Mili / (25.4 * 36 * 1760)
' Nautical and horse racing
Case NauticalMiles
LengthUnitConvert = Mili / (25.4 * 36 * 6080)
Case CableLengths
LengthUnitConvert = Mili / (25.4 * 12 * 600)
Case Chains
LengthUnitConvert = Mili / (25.4 * 12 * 66)
Case Fathoms
LengthUnitConvert = Mili / (25.4 * 12 * 6)
Case Furlongs
LengthUnitConvert = Mili / (25.4 * 12 * 660)
Case Hands
LengthUnitConvert = Mili / (25.4 * 4)
Case Degrees
LengthUnitConvert = Mili / (25.4 * 36 * 6080 * 60)
Case Minutes
LengthUnitConvert = Mili / (25.4 * 36 * 6080) ' yes, same as nautical mile
Case Seconds
LengthUnitConvert = Mili / (25.4 * 36 * (6080 / 60))
' Computer
Case Dots
LengthUnitConvert = Mili / (25.4 / 300)
Case Points
LengthUnitConvert = Mili / (25.4 / 72)
Case RadixDots
LengthUnitConvert = Mili / (25.4 / 1200)
Case Twips
LengthUnitConvert = Mili / (25.4 / 1440)
Case PlotterUnits
LengthUnitConvert = Mili / (25.4 / 1016)
' Scientific
' Case Angstroms
' LengthUnitConvert = Mili / (1 / 10000000000#)
Case LightYears
LengthUnitConvert = Mili / (1000 * 9.4 * 10 ^ 15)
' Old and Biblical
Case Cubits
LengthUnitConvert = Mili / (25.4 * 18)
Case RoyalEgyptianCubits
LengthUnitConvert = Mili / (25.4 * 21)
Case Ells
LengthUnitConvert = Mili / (25.4 * 45)
Case Palms
LengthUnitConvert = Mili / 127
Case Reeds
LengthUnitConvert = Mili / 1520
Case Span
LengthUnitConvert = Mili / (25.4 * 9)
End Select
End Function
'-------------------------------------------
' Timing functions
'-------------------------------------------
' Function can time accurately to microseconds (1/1000000th of a second)
' Tis slow though. Have to convert 64bit unsigned integer to Decimal within Variant. Yuk
' When VB7 arrives, with it's 64bit long variable, I'll be able to write this to be a tad quicker(!)
Public Function TimerElapsed(Optional 礢 As Long = 0, Optional UsePerformanceTimer As Boolean = True) As Boolean
Static StartTime As Variant ' Decimal
Static PerformanceFrequency As LongLong
Static EndTime As Variant ' Decimal
Dim CurrentTime As LongLong
Dim Dec As Variant
If 礢 > 0 Then
' Initialize
If UsePerformanceTimer = True Then
If QueryPerformanceFrequency(PerformanceFrequency) Then
' Performance Timer available
If QueryPerformanceCounter(CurrentTime) Then
Else
' Performance timer is available, but is not responding
CurrentTime.HighPart = 0
CurrentTime.LowPart = timeGetTime
PerformanceFrequency.HighPart = 0
PerformanceFrequency.LowPart = 1000
End If
Else
' Performance timer is not available.
CurrentTime.HighPart = 0
CurrentTime.LowPart = timeGetTime
PerformanceFrequency.HighPart = 0
PerformanceFrequency.LowPart = 1000
End If
Else
' Do not need to use performance timer
CurrentTime.HighPart = 0
CurrentTime.LowPart = timeGetTime
PerformanceFrequency.HighPart = 0
PerformanceFrequency.LowPart = 1000
End If
' Work out start time...
' Convert to DECIMAL
Dec = CDec(CurrentTime.LowPart)
' make this UNSIGNED
If Dec < 0 Then
Dec = CDec(Dec + (2147483648# * 2))
End If
' Add higher value
StartTime = CDec(Dec + (CurrentTime.HighPart * 2147483648# * 2))
' Put performance frequency into Dec variable
Dec = CDec(PerformanceFrequency.LowPart)
' Convert to unsigned
If Dec < 0 Then
Dec = CDec(Dec + (2147483648# * 2))
End If
' Add higher value
Dec = CDec(Dec + (PerformanceFrequency.HighPart * 2147483648# * 2))
' Work out end time from this
EndTime = CDec(StartTime + 礢 * Dec / 1000000)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -