module1.bas

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

Attribute VB_Name = "Module1"
Dim i As Integer
Dim j As Integer
Public COLtmp(0 To 260, 0 To 260) As Long
Public COLtmpGound(0 To 127, 0 To 127) As Long
Public COL(-10 To 260, -10 To 260) As Long
Public diff(-10 To 260, -10 To 260) As Single
Public spe(-10 To 260, -10 To 260) As Single
Dim ShadeS As RGBQUAD



Private Type BITMAPINFOHEADER
 biSize           As Long
 biWidth          As Long
 biHeight         As Long
 biPlanes         As Integer
 biBitCount       As Integer
 biCompression    As Long
 biSizeImage      As Long
 biXPelsPerMeter  As Long
 biYPelsPerMeter  As Long
 biClrUsed        As Long
 biClrImportant   As Long
End Type

Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Public rgbBlue As Single
Public rgbGreen As Single
Public rgbRed As Single

Public rgbBlue2 As Single
Public rgbGreen2 As Single
Public rgbRed2 As Single

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
End Type
Private Const DIB_RGB_COLORS As Long = 0

Private Bits() As RGBQUAD
Private BInfo As BITMAPINFO
Private lngHDC As Long
Private lngImageHandle As Long

Public tim As Long
Public asb As Single

Public Sub mai()

lngHDC = frmMain.picRay.hdc
lngImageHandle = frmMain.picRay.Image.Handle
With BInfo.bmiHeader
  .biSize = 40
  .biWidth = frmMain.picRay.ScaleWidth
  .biHeight = frmMain.picRay.ScaleHeight
  .biPlanes = 1
  .biBitCount = 32
  .biCompression = 0
  .biClrUsed = 0
  .biClrImportant = 0
  .biSizeImage = frmMain.picRay.ScaleWidth * frmMain.picRay.ScaleHeight
End With
With frmMain.picRay
  ReDim Bits(0 To BInfo.bmiHeader.biWidth - 1, 0 To BInfo.bmiHeader.biHeight - 1)
End With

End Sub


Public Sub sha()



For i = 0 To BmpWidth - 1
  For j = 0 To BmpHeight - 1
    rgbRed = (COL(i, j) And &HFF) * diff(i, j) + spe(i, j)
    rgbGreen = (Int(COL(i, j) / 256) And &HFF) * diff(i, j) + spe(i, j)
    rgbBlue = (Int(COL(i, j) / 65536) And &HFF) * diff(i, j) + spe(i, j)
    If rgbRed > 255 Then rgbRed = 255
    If rgbGreen > 255 Then rgbGreen = 255
    If rgbBlue > 255 Then rgbBlue = 255

    Bits(i, j).rgbRed = CByte(rgbRed)
    Bits(i, j).rgbGreen = CByte(rgbGreen)
    Bits(i, j).rgbBlue = CByte(rgbBlue)

  Next
Next

DoEvents

With frmMain.picRay
  SetDIBits lngHDC, lngImageHandle, 0, BInfo.bmiHeader.biHeight, Bits(0, 0), BInfo, DIB_RGB_COLORS
  .Refresh
End With


End Sub