-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathHelper.bas
108 lines (85 loc) · 3.49 KB
/
Helper.bas
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Attribute VB_Name = "Helper"
Option Explicit
'Konstantendeklationen für Registry.cls
'Registrierungsdatentypen
Public Const REG_SZ As Long = 1 ' String
Public Const REG_BINARY As Long = 3 ' Binär Zeichenfolge
Public Const REG_DWORD As Long = 4 ' 32-Bit-Zahl
'Vordefinierte RegistrySchlüssel (hRootKey)
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_NONE = 0
Public Const ERR_FILESTREAM = &H1000000
Public Const ERR_OPENFILE = vbObjectError + ERR_FILESTREAM + 1
Public i, j As Integer
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (src As Any, ByVal dest As Any, ByVal Length&)
Public Declare Sub MemCopyStrToLng Lib "kernel32" Alias "RtlMoveMemory" (src As Long, ByVal dest As String, ByVal Length&)
Public Declare Sub MemCopyLngToStr Lib "kernel32" Alias "RtlMoveMemory" (ByVal src As String, dest As Long, ByVal Length&)
Public Declare Sub MemCopyLngToInt Lib "kernel32" Alias "RtlMoveMemory" (src As Long, ByVal dest As Integer, ByVal Length&)
Public Declare Sub MemCopyRefToRef Lib "kernel32" Alias "RtlMoveMemory" (src As Any, dest As Any, ByVal Length&)
Public Function HexvaluesToString$(Hexvalues$)
Dim tmpchar
For Each tmpchar In Split(Hexvalues)
HexvaluesToString = HexvaluesToString & Chr("&h" & tmpchar)
Next
End Function
Function Max(ParamArray values())
Dim item
For Each item In values
Max = IIf(Max < item, item, Max)
Next
End Function
Function Min(ParamArray values())
Dim item
Min = &H7FFFFFFF
For Each item In values
Min = IIf(Min > item, item, Min)
Next
End Function
Function limit(value, upperLimit, Optional lowerLimit = 0)
'limit = IIf(Value > upperLimit, upperLimit, IIf(Value < lowerLimit, lowerLimit, Value))
If (value > upperLimit) Then _
limit = upperLimit _
Else _
If (value < lowerLimit) Then _
limit = lowerLimit _
Else _
limit = value
End Function
Function RangeCheck(ByVal value&, Max&, Optional Min& = 0, Optional ErrText, Optional ErrSource$) As Boolean
RangeCheck = (Min <= value) And (value <= Max)
If (RangeCheck = False) And (IsMissing(ErrText) = False) Then err.Raise vbObjectError, ErrSource, ErrText
End Function
Public Function H8(ByVal value As Long)
H8 = Right(String(1, "0") & Hex(value), 2)
End Function
Public Function H16(ByVal value As Long)
H16 = Right(String(3, "0") & Hex(value), 4)
End Function
Public Function H32(ByVal value As Long)
H32 = Right(String(7, "0") & Hex(value), 8)
End Function
Public Function Dec3$(ByVal value$)
Dec3 = Right(String(3, "0") & value, 3)
End Function
Public Function Dec2$(ByVal value$)
Dec2 = Right(String(3, "0") & value, 2)
End Function
Public Function Swap(ByRef A, ByRef B)
Swap = B
B = A
A = Swap
End Function
'////////////////////////////////////////////////////////////////////////
'// BlockAlign_l - Erzeugt einen linksbündigen BlockString
'//
'// Beispiel1: BlockAlign_l("Summe",7) -> " Summe"
'// Beispiel2: BlockAlign_l("Summe",4) -> "umme"
Public Function BlockAlign_l(RawString, Blocksize) As String
'String kürzen lang wenn zu
RawString = Left(RawString, Blocksize)
'mit Leerzeichen auffüllen
BlockAlign_l = Space(Blocksize - Len(RawString)) & RawString
End Function