当前位置:编程学习 > VB >>

帮忙看看呀,图像处理问题

请问下面程序想实现在左边图片框中鼠标单击任一点蓝易做图域实现在右边图片框把与刚才点选的那一点相连续的所有点变成绿色,为什么会出现“实时错误28,堆栈空间溢出”的错误呢?谢谢各位了。代码如下:

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6285
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6285
   ScaleWidth      =   9000
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.PictureBox pic2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   2295
      Left            =   5640
      ScaleHeight     =   149
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   173
      TabIndex        =   1
      Top             =   120
      Width           =   2655
   End
   Begin VB.PictureBox pic1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   4830
      Left            =   120
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   318
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   356
      TabIndex        =   0
      Top             =   120
      Width           =   5400
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private 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 Type

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Dim picBits() As Byte
Dim picInfoD As BITMAP '调入处理后图像所用的信息
Dim BytesperPixel As Integer

'get bitmap info
Private Function GetBI(pic As PictureBox, picBits() As Byte)
    Dim i As Long
    
    With pic
        GetObject .Image, Len(picInfoD), picInfoD
        BytesperPixel = picInfoD.bmBitsPixel \ 8
        ReDim picBits(1 To picInfoD.bmWidth * picInfoD.bmHeight * BytesperPixel)
        
        GetBitmapBits .Image, UBound(picBits), picBits(1)
    End With
End Function

'在图像上反选与点击的点连续的图像
Private Function SSMO(x As Single, y As Single, c As Integer)
    'On Error Resume Next
    
    If picBits((y * picInfoD.bmWidth + x) * BytesperPixel + c) = 255 Then
        picBits((y * picInfoD.bmWidth + x) * BytesperPixel + c) = 0
        picBits((y * picInfoD.bmWidth + x) * BytesperPixel + 3 - c) = 255
        DoEvents
        If picBits(((y - 1) * picInfoD.bmWidth + x - 1) * BytesperPixel + c) = 255 Then
            SSMO x - 1, y - 1, c
        End If
        If picBits(((y - 1) * picInfoD.bmWidth + x) * BytesperPixel + c) = 255 Then
            SSMO x, y - 1, c
        End If
        If picBits(((y - 1) * picInfoD.bmWidth + x + 1) * BytesperPixel + c) = 255 Then
            SSMO x + 1, y - 1, c
        End If
        If picBits((y * picInfoD.bmWidth + x - 1) * BytesperPixel + c) = 255 Then
            SSMO x - 1, y, c
        End If
        If picBits((y * picInfoD.bmWidth + x + 1) * BytesperPixel + c) = 255 Then
            SSMO x + 1, y, c
        End If
        If picBits(((y + 1) * picInfoD.bmWidth + x - 1) * BytesperPixel + c) = 255 Then
            SSMO x - 1, y + 1, c
        End If
        If picBits(((y + 1) * picInfoD.bmWidth + x) * BytesperPixel + c) = 255 Then
            SSMO x, y + 1, c
        End If
        If picBits(((y + 1) * picInfoD.bmWidth + x + 1) * BytesperPixel + c) = 255 Then
            SSMO x + 1, y + 1, c
        End If
    End If
    Exit Function
End Function

Private Sub Form_Load()
    pic2.Width = pic1.Width
    pic2.Height = pic1.Height
    GetBI pic1, picBits()
End Sub

Private Sub pic1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    SSMO x, y, 1
    SetBitmapBits pic2.Image, UBound(picBits), picBits(1)
End Sub
补充:VB ,  基础类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,