sam16.bas

星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V2.0的核心结合而开发成的! 星子行V1.0是单反接正法,星子行V2.0是多反接法,星子行V3.0以上版本都是多反

Attribute VB_Name = "Sam16"

Option Explicit
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BitMapInfo, ByVal wUsage As Long) As Long

Private BmpInfo As BitMapInfo
Private bBytes() As Byte


Public Sub m16xa(bmWidth As Long, bmHeight As Long, bmWidthBytes As Long, _
bmBitsPixel As Long)



Rscreen.Picture1.Move 0, 0, Rscreen.Picture1.ScaleX(bmWidth, 3, 1), Rscreen.Picture1.ScaleY(bmHeight, 3, 1)

If ((bmWidth >= Rscreen.ScaleX(Screen.Width, 1, 3)) And (bmHeight >= Rscreen.ScaleY(Screen.Height, 1, 3))) Then

Rscreen.WindowState = 2

Else

Rscreen.Move 0, 0, Rscreen.Picture1.Width + 200, Rscreen.Picture1.Height + 600
Call Rscreen.vs

End If


Dim Bif As BITMAPFILEHEADERX
Dim Bih As BITMAPINFOHEADER
Dim bmpsize As Long

 
bmpsize = bmWidthBytes * bmHeight
With Bih
  .biBitCount = bmBitsPixel
  .biClrImportant = 0
  .biClrUsed = 0
  .biCompression = BI_RGB
  .biHeight = bmHeight
  .biPlanes = 1
  .biSize = Len(Bih)
  .biSizeImage = bmpsize
  .biWidth = bmWidth
  .biXPelsPerMeter = 0
  .biYPelsPerMeter = 0
End With
With Bif
  .bfOffBits = 54
  .bfReserved1 = .bfReserved2 = 0
  .bfType = IsBitmapFile
  .bfSize = 54 + bmpsize
End With
BmpInfo.bmiHeader = Bih


    
 
End Sub

Public Sub m16xb(bmp16x() As Byte)
Dim ik As Long
ik = SetDIBitsToDevice(formhdc, 0, 0, BmpInfo.bmiHeader.biWidth, BmpInfo.bmiHeader.biHeight, 0, 0, 0, BmpInfo.bmiHeader.biHeight, bmp16x(0), BmpInfo, DIB_RGB_COLORS)

End Sub