Листинг 1
Attribute VB_Name = "MKxCVxTS"
Sub main()
'
' Пример обращения к функциям MKx$, CVx
' в стиле "a-la" MS Basic for DOS (QB/PDS/VBDOS)
IntValue% = 12345
x$ = MKI$(IntValue%)
MsgBox Str$(CVI(x$)), , "Integer"
'
LongValue& = 12345678
x$ = MKL$(LongValue&)
MsgBox Str$(CVL(x$)), , "Long"
'
SingleValue! = 123.45
x$ = MKS$(SingleValue!)
MsgBox Str$(CVS(x$)), , "Single"
'
DoubleValue# = 1.2345
x$ = MKD$(DoubleValue#)
MsgBox Str$(CVD(x$)), , "Double"
'
End Sub
===============================================================
Attribute VB_Name = "MKxCVx32"
#If Win32 Then
Public Declare Sub HMemCpy Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, _
ByVal Length As Long)
#Else
Declare Sub HMemCpy Lib "kernel" (hpvDest As Any, _
hpvSource As Any, ByVal cbCopy As Long)
#End If
'
' Реализация функций CVx/MKx$ с помощью обращения к
' функциям Windows API -- HmemCpy или RtlMoveMemory
' (копирование заданного числа байт из одной области
' памяти в другую)
'
' ПРИМЕЧАНИЕ. Передача строковой переменной по значению
' (ByVal) означает, что в функцию HMemCpy передается
' адрес не описателя, а самой строки
'
Function CVD(x$) As Double
HMemCpy Temp#, ByVal x$, 8
CVD = Temp#
End Function
Function CVI(x$) As Integer
HMemCpy Temp%, ByVal x$, 2
CVI = Temp%
End Function
Function CVL(x$) As Long
HMemCpy Temp&, ByVal x$, 4
CVL = Temp&
End Function
Function CVS(x$) As Single
HMemCpy Temp!, ByVal x$, 4
CVS = Temp!
End Function
Function MKD$(x#)
Dim Temp As String * 8
HMemCpy ByVal Temp, x#, 8
MKD$ = Temp
End Function
Function MKI$(x%)
Dim Temp As String * 2
HMemCpy ByVal Temp, x%, 2
MKI$ = Temp
End Function
Function MKL$(x&)
Dim Temp As String * 4
HMemCpy ByVal Temp, x&, 4
MKL$ = Temp
End Function
Function MKS$(x!)
Dim Temp As String * 4
HMemCpy ByVal Temp, x!, 4
MKS$ = Temp
End Function