删除小粒子.frm

计算面积公式源代码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4140
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   3756
   LinkTopic       =   "Form1"
   ScaleHeight     =   345
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   313
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog cdlg1 
      Left            =   1680
      Top             =   1800
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   840
      TabIndex        =   4
      Text            =   "0"
      Top             =   3720
      Width           =   855
   End
   Begin VB.CommandButton Command3 
      Caption         =   "结束"
      Height          =   375
      Left            =   2040
      TabIndex        =   3
      Top             =   3720
      Width           =   1455
   End
   Begin VB.CommandButton Command2 
      Caption         =   "输入图象"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   3120
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "删除"
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Top             =   3120
      Width           =   1455
   End
   Begin VB.PictureBox Picture1 
      Height          =   2895
      Left            =   120
      Picture         =   "删除小粒子.frx":0000
      ScaleHeight     =   237
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   287
      TabIndex        =   0
      Top             =   120
      Width           =   3495
   End
   Begin VB.Label Label1 
      Caption         =   "面积<"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   3840
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim area1 As Variant
Private Sub Command1_Click()
Dim i As Integer, j As Integer
Dim c As Long
Dim r As Integer
Dim p(0 To 300, 0 To 300) As Integer '存储点的灰度值
Dim t As Integer
Dim ltor(0 To 300, 0 To 300) As Integer
Dim area(0 To 300) As Integer
Dim condition As Boolean
Dim count As Integer
Dim min As Integer
Dim max As Integer
'*******************************************************************************
MousePointer = 11
For j = 0 To Picture1.Height
 For i = 0 To Picture1.Width
 c = Picture1.Point(i, j)
 r = (c And &HFF)
    If r = 0 Then
    p(i, j) = 1
    End If
        If r <> 0 Then
        p(i, j) = 0
        End If
 Next
Next
 '******************************************************************************8
count = 1
condition = False
For j = 2 To Picture1.Height
 
 For i = 2 To Picture1.Width
  If (condition = False And p(i, j) = 1) Or (p(i - 1, j) = 1 And p(i, j) = 1) Then
  ltor(i, j) = count
  condition = True
  ElseIf condition = True And p(i, j) = 0 Then
  count = count + 1
  condition = False
  End If

  Next
Next
 
 '*******************************************************************************
For i = 1 To Picture1.Width
 'condition = False
 For j = 1 To Picture1.Height
     If p(i, j) = 1 And p(i + 1, j + 1) = 1 Then
     max = ltor(i + 1, j + 1)
     min = ltor(i, j)
         For t = 0 To Picture1.Width
        If ltor(t, j + 1) = max Then
        ltor(t, j + 1) = min
        End If
        Next
    End If
 Next
 Next
 '*****************************************************
 For i = 1 To Picture1.Width
     For j = 1 To Picture1.Height
         If p(Picture1.Width - i + 1, Picture1.Height - j + 1) = 1 And p(Picture1.Width - i, Picture1.Height - j) = 1 Then
            max = ltor(Picture1.Width - i, Picture1.Height - j)
            min = ltor(Picture1.Width - i + 1, Picture1.Height - j + 1)
            For t = 0 To Picture1.Width
                If ltor(t, Picture1.Height - j) = max Then
                ltor(t, Picture1.Height - j) = min
                End If
            Next
         End If
        
             For t = 1 To 300
            If ltor(i, j) = t Then
            area(t) = area(t) + 1
            End If
        Next
     Next
 Next
'******************************************************
For i = 1 To Picture1.Width
     For j = 1 To Picture1.Height
        For t = 0 To 300
            If area(t) < 100 And ltor(i, j) = t Then
            Picture1.PSet (i, j), RGB(255, 255, 255)
            End If
        Next
    Next
Next
'*******************************************************************************
MousePointer = 0
End Sub


Private Sub Command2_Click()
cdlg1.ShowOpen
Picture1.Picture = LoadPicture(cdlg1.FileName)
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Text1_Change()
area1 = CVar(Text1.Text)
End Sub