-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathutil.bas
More file actions
70 lines (59 loc) · 2.31 KB
/
Copy pathutil.bas
File metadata and controls
70 lines (59 loc) · 2.31 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Attribute VB_Name = "util"
Private Type RGBColor
r As Byte
G As Byte
B As Byte
End Type
Private Function fgConvertColor(COR As Long) As RGBColor
Dim tmpCor As RGBColor, tmpCor2 As String, i As Integer
tmpCor2 = Hex$(COR)
If Len(tmpCor2) < 6 Then tmpCor2 = String(6 - Len(tmpCor2), "0") & tmpCor2
tmpCor.r = CByte(CHex(Right(tmpCor2, 2)))
tmpCor.G = CByte(CHex(Mid(tmpCor2, 3, 2)))
tmpCor.B = CByte(CHex(Left(tmpCor2, 2)))
fgConvertColor = tmpCor
End Function
Public Function fgCompareCores(cor1 As Long, cor2 As Long) As Long
'Debug.Print cor1
Dim RGBcor1 As RGBColor, RGBcor2 As RGBColor
RGBcor1 = fgConvertColor(cor1)
RGBcor2 = fgConvertColor(cor2)
fgCompareCores = fgABSDiff(RGBcor1.r, RGBcor2.r) + fgABSDiff(RGBcor1.G, RGBcor2.G) + fgABSDiff(RGBcor1.B, RGBcor2.B)
End Function
Public Function fgABSDiff(ByVal val1 As Byte, ByVal val2 As Byte) As Long
If val1 > val2 Then
fgABSDiff = CLng(val1 - val2)
Else
fgABSDiff = CLng(val2 - val1)
End If
End Function
Public Function fgCoresProximas(cor1 As Long, cor2 As Long) As Boolean
fgCoresProximas = (fgCompareCores(cor1, cor2) <= 10)
End Function
'Purpose : Converts a Hex string value to a long
'Inputs : sHex The hex value to convert to a long. eg. "H1" or "&H1".
'Outputs : Returns the numeric value of a string containing a hex value.
'Notes :
Public Function CHex(sHex As String) As Long
Dim iNegative As Integer, sPrefixH As String
On Error Resume Next
iNegative = CBool(Left$(sHex, 1) = "-")
sPrefixH = IIf(InStr(1, sHex, "H", vbTextCompare), "", "H")
If iNegative Then
'Negative number
If Mid$(sHex, 2, 1) = "&" Then
CHex = CLng("&" & sPrefixH & Mid$(sHex, 3)) * iNegative
Else
'Append the ampersand to enable CLng to convert the value
CHex = CLng("&" & sPrefixH & Mid$(sHex, 2)) * iNegative
End If
Else
'Positive number
If Left$(sHex, 1) = "&" Then
CHex = CLng("&" & sPrefixH & Mid$(sHex, 2))
Else
'Append the ampersand to enable CLng to convert the value
CHex = CLng("&" & sPrefixH & sHex)
End If
End If
End Function