form1.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7710
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9330
   LinkTopic       =   "Form1"
   ScaleHeight     =   7710
   ScaleWidth      =   9330
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      Height          =   6135
      Left            =   240
      ScaleHeight     =   6075
      ScaleWidth      =   8595
      TabIndex        =   1
      Top             =   360
      Width           =   8655
   End
   Begin VB.CommandButton Command1 
      Caption         =   "转换为灰度"
      Height          =   495
      Left            =   4080
      TabIndex        =   0
      Top             =   6840
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetPixel Lib "gdi32" _
     (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" _
     (ByVal hdc As Long, ByVal x As Long, _
      ByVal Y As Long, ByVal crColor As Long) As Long
Private tmpPic As Picture

Private Sub Form_Load()
Dim mypic As Variant
Picture1.ScaleMode = 3
'设为Pixel
Picture1.AutoRedraw = True
'设定所有Pixel的改变不立即在pictureBox上显示
Picture1.Picture = LoadPicture(App.Path + "\mypic.bmp")
'为图片框载入图片
Set tmpPic = Picture1.Picture
End Sub

Private Sub Command1_click()
Dim width5  As Long, heigh5 As Long, rgb5 As Long
Dim hdc5 As Long, i As Long, j As Long
Dim bBlue As Long, bRed As Long, bGreen As Long
Dim Y As Long
width5 = Picture1.ScaleWidth
heigh5 = Picture1.ScaleHeight
hdc5 = Picture1.hdc
For i = 1 To width5
   For j = 1 To heigh5
       rgb5 = GetPixel(hdc5, i, j)
       bBlue = Blue(rgb5)
       bRed = Red(rgb5)
       bGreen = Green(rgb5)
       Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
       rgb5 = RGB(Y, Y, Y)
       SetPixelV hdc5, i, j, rgb5
   Next j
 Next i
Set Picture1.Picture = Picture1.Image
'此时才真正显示Picture
End Sub

Private Function Red(ByVal mlColor As Long) As Long
    Red = mlColor And &HFF
End Function
Private Function Green(ByVal mlColor As Long) As Long
    Green = (mlColor \ &H100) And &HFF
End Function
Private Function Blue(ByVal mlColor As Long) As Long
    Blue = (mlColor \ &H10000) And &HFF
End Function