您所在位置：主题：[讨论]vb图像处理老是说子文件未定义
sai222
[专家分：0] 发布于 2009-03-27 17:15:00
Private Sub Command1_Click()
CDl.Filter = "所有文件(*.*)|*.*|JPG文件(*.jpg)|*.jpg|位图文件(*.bmp)|*.bmp" '设置过滤
CDl.InitDir = "c:\program files\plus!\thems"
CDl.ShowOpen '打开文件选择对话框
If CDl.FileName <> "" Then
p2.Picture = LoadPicture(CDl.FileName)
End If
hh = p2.Width - P1.Width '图片是否超出宽度
vv = p2.Height - P1.Height
If hh > 0 Then
HS.Visible = True
HS.Max = hh
Else
p2.Top = 0
p2.Left = 0
HS.Visible = False
End If
If vv > 0 Then
VS.Visible = True
VS.Max = vv
Else
p2.Left = 0
p2.Top = 0
VS.Visible = False
End If
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Command4_Click()
With p2
.AutoRedraw = True
.AutoSize = True
.ScaleMode = 3
.BorderStyle = 0
DibGet .hdc, 0, 0, .ScaleWidth, .ScaleHeight
End With
CopyData InPutHei, InPutWid
With p4
.AutoRedraw = True
.AutoSize = True
.ScaleMode = 3
.BorderStyle = 0
DIBPut .hdc, InPutWid, InPutHei
.Refresh
End With
End Sub
Private Sub HS_scroll()
p2.Left = -HS.Value
End Sub
Private Sub VS_scroll()
p2.Top = -VS.Value
End Sub
定义
'过程中用到的全局变量:
Private Const Bits As Long = 32 '颜色深度，这里把所有图像都按照32位来处理
Public Done As Boolean '用于标记一个过程是否结束
Public TimeGet As Long '用于记录输入过程处理所花费的时间
Public TimePut As Long '用于记录输出过程处理所花费的时间
Dim ColVal() As Byte '用于存放从DIB输入的像素值
Dim ColOut() As Byte '用于存放向DIB输出的像素值
Dim InPutHei As Long '用于记录输入图像的高度
Dim InPutWid As Long '用于记录输入图像的宽度
Dim bi24BitInfo As BitMapInfo '定义BMP信息
'获取像素 DibGet()
'图像输出 DIBPut()
'Copy 数组 CopyData()
'用于存放从DIB输入的像素值(获取的像素数组) ColVal()
'注 第一维: 0= B 值 1= G 值 2= R 值 3= Alpha
' 第二维: X 值
' 第三维: Y 值
'删除一个DC
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'删除一个对象
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'选择当前对象
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
'获取DIB
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 timeGetTime Lib "winmm.dll" () 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 Long
'内存操作
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
'数据结构定义:
Private Type BitMapInfoHeader '文件信息头——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
'Copy 数组
Public Sub CopyData(ByVal W As Long, ByVal H As Long)
Dim Length As Long
Dim I As Long
Dim L As Long
I = Bits \ 8
L = I - 1
Length = (W + 1&) * (H + 1&) * I
ReDim ColOut(L, W, H)
CopyMemory ColOut(0, 0, 0), ColVal(0, 0, 0), Length
End Sub
'获取像素
Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long)
Dim iBitmap As Long
Dim iDC As Long
Dim I As Long
Dim W As Long
Dim H As Long
On Error GoTo ErrLine
Done = False
TimeGet = timeGetTime
InPutWid = XEnd - XBegin
InPutHei = YEnd - YBegin
W = InPutWid + 1
H = InPutHei + 1
I = (Bits \ 8) - 1
ReDim ColVal(I, InPutWid, InPutHei)
With bi24BitInfo.bmiHeader
.biBitCount = Bits
.biCompression = 0&
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = W
.biHeight = H
End With
iBitmap = GetCurrentObject(IdSource, 7&)
GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&
DeleteObject iBitmap
Done = True
TimeGet = timeGetTime - TimeGet
Exit Sub
ErrLine:
MsgBox "错误号:" & Err.Number & ":" & Err.Description
End Sub
'图像输出
Private Sub DIBPut(ByVal IdDestination As Long, Width As Long, Height As Long)
Dim W As Long
Dim H As Long
Dim LineBytes As Long
On Error GoTo ErrLine
Done = False
TimePut = timeGetTime
W = Width + 1
H = Height + 1
With bi24BitInfo.bmiHeader
.biWidth = W
.biHeight = H
LineBytes = ((W * Bits + 31) And &HFFFFFFE0) \ 8
.biSizeImage = LineBytes * H
End With
SetDIBitsToDevice IdDestination, 0, 0, W, H, 0, 0, 0, H, ColOut(0, 0, 0), bi24BitInfo, 0
Done = True
TimePut = timeGetTime - TimePut
Exit Sub
On Error GoTo 0
ErrLine:
MsgBox Err.Description
End Sub
老是说是未定义子文件，然后指向Private Sub Command4_Click()
CDl.Filter = "所有文件(*.*)|*.*|JPG文件(*.jpg)|*.jpg|位图文件(*.bmp)|*.bmp" '设置过滤
CDl.InitDir = "c:\program files\plus!\thems"
CDl.ShowOpen '打开文件选择对话框
If CDl.FileName <> "" Then
p2.Picture = LoadPicture(CDl.FileName)
End If
hh = p2.Width - P1.Width '图片是否超出宽度
vv = p2.Height - P1.Height
If hh > 0 Then
HS.Visible = True
HS.Max = hh
Else
p2.Top = 0
p2.Left = 0
HS.Visible = False
End If
If vv > 0 Then
VS.Visible = True
VS.Max = vv
Else
p2.Left = 0
p2.Top = 0
VS.Visible = False
End If
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Command4_Click()
With p2
.AutoRedraw = True
.AutoSize = True
.ScaleMode = 3
.BorderStyle = 0
DibGet .hdc, 0, 0, .ScaleWidth, .ScaleHeight
End With
CopyData InPutHei, InPutWid
With p4
.AutoRedraw = True
.AutoSize = True
.ScaleMode = 3
.BorderStyle = 0
DIBPut .hdc, InPutWid, InPutHei
.Refresh
End With
End Sub
Private Sub HS_scroll()
p2.Left = -HS.Value
End Sub
Private Sub VS_scroll()
p2.Top = -VS.Value
End Sub
定义
'过程中用到的全局变量:
Private Const Bits As Long = 32 '颜色深度，这里把所有图像都按照32位来处理
Public Done As Boolean '用于标记一个过程是否结束
Public TimeGet As Long '用于记录输入过程处理所花费的时间
Public TimePut As Long '用于记录输出过程处理所花费的时间
Dim ColVal() As Byte '用于存放从DIB输入的像素值
Dim ColOut() As Byte '用于存放向DIB输出的像素值
Dim InPutHei As Long '用于记录输入图像的高度
Dim InPutWid As Long '用于记录输入图像的宽度
Dim bi24BitInfo As BitMapInfo '定义BMP信息
'获取像素 DibGet()
'图像输出 DIBPut()
'Copy 数组 CopyData()
'用于存放从DIB输入的像素值(获取的像素数组) ColVal()
'注 第一维: 0= B 值 1= G 值 2= R 值 3= Alpha
' 第二维: X 值
' 第三维: Y 值
'删除一个DC
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
'删除一个对象
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'选择当前对象
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
'获取DIB
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 timeGetTime Lib "winmm.dll" () 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 Long
'内存操作
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
'数据结构定义:
Private Type BitMapInfoHeader '文件信息头——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
'Copy 数组
Public Sub CopyData(ByVal W As Long, ByVal H As Long)
Dim Length As Long
Dim I As Long
Dim L As Long
I = Bits \ 8
L = I - 1
Length = (W + 1&) * (H + 1&) * I
ReDim ColOut(L, W, H)
CopyMemory ColOut(0, 0, 0), ColVal(0, 0, 0), Length
End Sub
'获取像素
Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long)
Dim iBitmap As Long
Dim iDC As Long
Dim I As Long
Dim W As Long
Dim H As Long
On Error GoTo ErrLine
Done = False
TimeGet = timeGetTime
InPutWid = XEnd - XBegin
InPutHei = YEnd - YBegin
W = InPutWid + 1
H = InPutHei + 1
I = (Bits \ 8) - 1
ReDim ColVal(I, InPutWid, InPutHei)
With bi24BitInfo.bmiHeader
.biBitCount = Bits
.biCompression = 0&
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = W
.biHeight = H
End With
iBitmap = GetCurrentObject(IdSource, 7&)
GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&
DeleteObject iBitmap
Done = True
TimeGet = timeGetTime - TimeGet
Exit Sub
ErrLine:
MsgBox "错误号:" & Err.Number & ":" & Err.Description
End Sub
'图像输出
Private Sub DIBPut(ByVal IdDestination As Long, Width As Long, Height As Long)
Dim W As Long
Dim H As Long
Dim LineBytes As Long
On Error GoTo ErrLine
Done = False
TimePut = timeGetTime
W = Width + 1
H = Height + 1
With bi24BitInfo.bmiHeader
.biWidth = W
.biHeight = H
LineBytes = ((W * Bits + 31) And &HFFFFFFE0) \ 8
.biSizeImage = LineBytes * H
End With
SetDIBitsToDevice IdDestination, 0, 0, W, H, 0, 0, 0, H, ColOut(0, 0, 0), bi24BitInfo, 0
Done = True
TimePut = timeGetTime - TimePut
Exit Sub
On Error GoTo 0
ErrLine:
MsgBox Err.Description
End Sub
老是说是未定义子文件，然后指向Private Sub Command4_Click()