图像载入Picture前缩放/灰度处理

Question

　　图像载入Picture前缩放OK了，灰度处理还不会，网上找的代码都是截入Picture后再灰度，有没有载入前先处理成灰度的代码，请各位大帮帮忙。
Option ExplicitPrivate Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Type BITMAP '14 bytes
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End TypePrivate Sub Form_Load()
    Picture1.Picture = LoadPicture(App.Path & "\b.bmp")
End SubPrivate Sub Command1_Click()
    Dim Pic As Picture, BMP As BITMAP
    Dim hdc As Long, hmemDC As Long    Set Pic = LoadPicture(App.Path & "\b.bmp")
    GetObject Pic.Handle, Len(BMP), BMP
    hmemDC = CreateCompatibleDC(hdc)
    SelectObject hmemDC, Pic.Handle    StretchBlt Picture1.hdc, 0, 0, BMP.bmWidth * 3, BMP.bmHeight * 3, hmemDC, 0, 0, BMP.bmWidth, BMP.bmHeight, vbSrcCopy    DeleteDC hmemDC
    Picture1.Refresh
End Sub

Answer 1

灰阶图像Option Explicit
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
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 Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type
Private Type BITMAPINFO
   bmiHeader As BITMAPINFOHEADER
   bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC 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 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 LongPrivate Sub Command1_Click()
   Dim WidthSrc As Long, HeightSrc As Long
   Dim PixelsSrc() As Byte
   Dim Bitmap_Info As BITMAPINFO
   Dim x&, y&, i&, Ret&, C As Byte
   WidthSrc = 800
   HeightSrc = 600
   With Bitmap_Info.bmiHeader
      .biSize = 40
      .biWidth = WidthSrc
      .biHeight = -HeightSrc
      .biPlanes = 1
      .biBitCount = 32
      .biCompression = BI_RGB
      .biSizeImage = WidthSrc * HeightSrc * 4
   End With
   ReDim PixelsSrc(1 To 4, 1 To WidthSrc, 1 To HeightSrc) As Byte
   Ret = GetDIBits(Picture1.hdc, Picture1.Picture, 0, HeightSrc, PixelsSrc(1, 1, 1), Bitmap_Info, DIB_RGB_COLORS)
   For y = 1 To HeightSrc
      For x = 1 To WidthSrc
         C = (9798& * PixelsSrc(3, x, y) + 19235& * PixelsSrc(2, x, y) + 3735& * PixelsSrc(1, x, y)) \ 32768
         PixelsSrc(1, x, y) = C
         PixelsSrc(2, x, y) = C
         PixelsSrc(3, x, y) = C
      Next
   Next
   SetDIBitsToDevice Me.hdc, 0, 0, WidthSrc, HeightSrc, 0, 0, 0, HeightSrc, PixelsSrc(1, 1, 1), Bitmap_Info, DIB_RGB_COLORS
End Sub

Answer 2

1楼的不是从文件载入时灰度。
加载到Picture后灰度网上有很多