[VBnet Helpers] Pure VB: Handy Macros to Convert Numeric Data Types


	Visual Basic Helper Routines Pure VB: Handy Macros to Convert Numeric Data Types

Posted:	Sunday November 28, 1999
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows NT4
OS restrictions:	None
Author:	MSDN, VBnet - Randy Birch

Prerequisites

32-bit VB.

Code

Add the following functions to a form or BAS module, and declare as appropriate:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function HiByte(ByVal wParam As Integer) As Byte
  
  'note: VB4-32 users should declare this function As Integer
   HiByte = (wParam And &HFF00&) \ (&H100)
 
End Function


Public Function LoByte(ByVal wParam As Integer) As Byte

  'note: VB4-32 users should declare this function As Integer
   LoByte = wParam And &HFF&    

End Function

Public Function HiWord(wParam As Long) As Integer

   If wParam And &H80000000 Then
      HiWord = (wParam \ 65535) - 1
   Else
      HiWord = wParam \ 65535
   End If

End Function


Public Function LoWord(wParam As Long) As Integer

   If wParam And &H8000& Then
      LoWord = &H8000& Or (wParam And &H7FFF&)
   Else
      LoWord = wParam And &HFFFF&
   End If

End Function


Public Function LoWordCM(wParam As Long) As Integer

  'using API
   CopyMemory LoWordCM, wParam, 2
  
End Function

Public Function LShiftWord(ByVal w As Integer, ByVal c As Integer) As Integer

   Dim dw As Long
   dw = w * (2 ^ c)
   If dw And &H8000& Then
      LShiftWord = CInt(dw And &H7FFF&) Or &H8000&
   Else
      LShiftWord = dw And &HFFFF&
   End If

End Function


Public Function RShiftWord(ByVal w As Integer, ByVal c As Integer) As Integer

   Dim dw As Long
   If c = 0 Then
      RShiftWord = w
   Else
      dw = w And &HFFFF&
      dw = dw \ (2 ^ c)
      RShiftWord = dw And &HFFFF&
   End If

End Function

Public Function MakeWord(ByVal bHi As Byte, ByVal bLo As Byte) As Integer

   If bHi And &H80 Then
      MakeWord = (((bHi And &H7F) * 256) + bLo) Or &H8000&
   Else
      MakeWord = (bHi * 256) + bLo
   End If

End Function


Public Function MakeDWord(wHi As Integer, wLo As Integer) As Long

   If wHi And &H8000& Then
      MakeDWord = (((wHi And &H7FFF&) * 65536) Or _
                    (wLo And &HFFFF&)) Or &H80000000
   Else
      MakeDWord = (wHi * 65535) + wLo
   End If

End Function

Public Function MAKELONG(wLow As Long, wHigh As Long) As Long

  MAKELONG = LoWord(wLow) Or (&H10000 * LoWord(wHigh))
  
End Function


Public Function MAKELPARAM(wLow As Long, wHigh As Long) As Long

 'Combines two integers into a long integer
  MAKELPARAM = MAKELONG(wLow, wHigh)
  
End Function

Comments

PayPal Link