|
|
请问下面程序想实现在左边图片框中鼠标单击任一点蓝色区域实现在右边图片框把与刚才点选的那一点相连续的所有点变成绿色，为什么会出现“实时错误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
|
|
发表于 2020-1-7 18:40:01