sam16.bas

来自「星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V」· BAS 代码 · 共 69 行

BAS
69
字号
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



⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?