module2.bas

Scanin geomedia web map supermap TerraVista生成视景数据库 VirtuoZo数字摄影测量系统 集思宝G516-专业GIS数据采集器 激光测距仪手册

Attribute VB_Name = "Module2"

Public Type BmpRGB
'图像阵列颜色点
  Blue As Byte                  '蓝
  Green As Byte                 '绿
  Red As Byte                   '红
  '图像阵列是由下至上，由左至右
End Type


Public Bmp_Bmp() As BmpRGB '球
Public Bmp_Gound() As BmpRGB '地面

Public BmpWidth As Long
Public BmpHeight As Long


' General utility functions
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
' Graphics related functions
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long


' Non-DIB bitmap type
Public Type BITMAP
bmType As Long                         ' Type of bitmap
bmWidth As Long                        ' Width
bmHeight As Long                       ' Height
bmWidthBytes As Long                   ' Width in bytes
bmPlanes As Integer                    ' # planes
bmBitsPixel As Integer                 ' bit depth
bmBits As Long                         ' memory pointer
End Type

Dim L_objVBImage    As StdPicture
Dim L_udtBD         As BITMAP
Dim L_bytTmp()      As Byte
Dim L_lngIndex      As Long
Private I_bytBn1()   As Byte
      

Public Sub GetBmpFile(Filename As String, ByRef Bmp() As BmpRGB)

  
Set L_objVBImage = LoadPicture(Filename)
' 获取信息
GetObject L_objVBImage.Handle, Len(L_udtBD), L_udtBD
BmpWidth = L_udtBD.bmWidth
BmpHeight = L_udtBD.bmHeight
'分配空间
ReDim Bmp(1 To L_udtBD.bmWidth, 1 To L_udtBD.bmHeight)
                                   
'复制内存
CopyMemory Bmp(1, 1), ByVal (L_udtBD.bmBits), L_udtBD.bmWidth * L_udtBD.bmHeight * 3

End Sub