面积计算.frm

计算面积公式源代码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "图像处理小程序"
   ClientHeight    =   4512
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   7128
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   376
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   594
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command11 
      Caption         =   "退出"
      Height          =   435
      Left            =   3600
      TabIndex        =   7
      Top             =   3840
      Width           =   915
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   3840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame2 
      Caption         =   "目的图像"
      Height          =   3192
      Left            =   3600
      TabIndex        =   5
      Top             =   360
      Width           =   3120
      Begin VB.PictureBox Pdes 
         AutoRedraw      =   -1  'True
         Height          =   2700
         Left            =   120
         ScaleHeight     =   221
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   231
         TabIndex        =   6
         Top             =   360
         Width           =   2820
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "源图像"
      Height          =   3192
      Left            =   285
      TabIndex        =   3
      Top             =   360
      Width           =   3156
      Begin VB.PictureBox Psou 
         AutoRedraw      =   -1  'True
         Height          =   2700
         Left            =   210
         ScaleHeight     =   221
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   229
         TabIndex        =   4
         Top             =   315
         Width           =   2796
      End
   End
   Begin VB.CommandButton Command8 
      Caption         =   "扫描标号"
      Height          =   435
      Left            =   4920
      TabIndex        =   2
      Top             =   3840
      Width           =   915
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "读位图"
      Height          =   435
      Left            =   2160
      TabIndex        =   1
      Top             =   3840
      Width           =   915
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开文件"
      Height          =   435
      Left            =   720
      TabIndex        =   0
      Top             =   3840
      Width           =   915
   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 ReadFlag As Boolean
Private Sub Command1_Click()                                 '打开文件模块
  With CommonDialog1
    .DialogTitle = "请选择图像"
    .CancelError = True
    .InitDir = App.Path
    .Filter = "Image(*.BMP;*.GIF;*.JPG;*.DIB)|*.BMP;*.GIF;*.JPG;*.DIB"
    .Flags = &H4
    .ShowOpen
    If Len(.FileName) = 0 Then
       Exit Sub
    End If
  End With
  
  Form1.Psou.Picture = LoadPicture(CommonDialog1.FileName)
  ReadFlag = False
End Sub

Private Sub Command10_Click()                                '阈值计算2模块
  Dim YuVal As Integer
  Dim Hui() As Integer
  Dim I As Integer, J As Integer
  Dim Width As Integer, Height As Integer

  If ReadFlag = False Then
     MsgBox "请先读位图再处理图像!", vbInformation, "提示"
     Exit Sub
  End If
  
  Width = Form1.Psou.ScaleWidth: Height = Form1.Psou.ScaleHeight
  If Width > 256 Then Width = 256
  If Height > 256 Then Height = 256
  
  ReDim Hui(Width - 1, Height - 1) As Integer
  
  Screen.MousePointer = 11
  
  For I = 0 To (Width - 1)
    For J = 0 To (Height - 1)
    Hui(I, J) = CInt((ImageIn(0, I, J) + ImageIn(1, I, J) + ImageIn(2, I, J)) / 3)
    Next J
  Next I
  YuVal = WYuFuction2(Hui, Width, Height)
  MsgBox "阈值:" & YuVal, , "计算结果"
  
  Screen.MousePointer = 0
End Sub

Private Sub Command11_Click()                                '退出模块
  Unload Form1
  End
End Sub

Private Sub Command2_Click()                                 '读位图模块
  Dim Width As Long, Height As Long
  Dim ReadPixel As Long
  Dim R As Integer, G As Integer, B As Integer
  Dim I As Long, J As Long
  
  
  Width = Form1.Psou.ScaleWidth: Height = Form1.Psou.ScaleHeight
  If Width > 256 Then Width = 256
  If Height > 256 Then Height = 256
  ReDim ImageIn(2, Width - 1, Height - 1)
  
  Screen.MousePointer = 11
  
  For I = 0 To (Width - 1)
    For J = 0 To (Height - 1)
     ReadPixel = Psou.Point(I, J)
     R = ReadPixel Mod 256
     G = (ReadPixel And &HFF00FF00) \ 256
     B = (ReadPixel And &HFF0000) \ 65536
     ImageIn(0, I, J) = R
     ImageIn(1, I, J) = G
     ImageIn(2, I, J) = B
    Next J
  Next I
    
  Screen.MousePointer = 0
  ReadFlag = True
End Sub




Private Sub Command8_Click()                                 '扫描标号
  Const RUN_MAX As Integer = 2000
  Const LB_MAX As Integer = 400
  Dim I As Integer, J As Integer
  Dim R As Integer, G As Integer, B As Integer
  Dim DReadPixel As Long
  Dim WTag As Integer
  Dim WBiaoRead() As Integer
  Dim Width As Integer, Height As Integer
  Dim WColor As Integer
  Dim WFlag As Boolean
  Dim Rn As Integer, La As Integer, N As Integer
  Dim WArea(LB_MAX) As Long
  Dim WSx(RUN_MAX) As Integer, WSy(RUN_MAX) As Integer, WEx(RUN_MAX) As Integer
  Dim WLb(RUN_MAX) As Integer, WK(RUN_MAX) As Integer, WKK(RUN_MAX) As Integer
  Dim No As Integer
  Dim X As Integer, Y As Integer

  If ReadFlag = False Then
     MsgBox "请先读位图再处理图像!", vbInformation, "提示"
     Exit Sub
  End If
  
  Width = Form1.Psou.ScaleWidth: Height = Form1.Psou.ScaleHeight
  If Width > 256 Then Width = 256
  If Height > 256 Then Height = 256
  
  ReDim WBiaoRead(Width - 1, Height - 1) As Integer
  
  Screen.MousePointer = 11

  For I = 0 To (Width - 1)                               '读象素点
    For J = 0 To (Height - 1)
     R = ImageIn(0, I, J)
     G = ImageIn(1, I, J)
     B = ImageIn(2, I, J)
     WBiaoRead(I, J) = CInt((R + G + B) / 3)
    Next J
  Next I
  
  '从左到右标号
  La = 1
  Rn = 0
  For I = 0 To Height - 1
      WBiaoRead(Width - 1, I) = 0
      WFlag = False
      For J = 0 To Width - 1
        If (WFlag = False) And (WBiaoRead(J, I) = 0) Then
          WLb(Rn) = La
          WSx(Rn) = J
          WSy(Rn) = I
          WFlag = True
        ElseIf (WFlag = True) And WBiaoRead(J, I) <> 0 Then
          WEx(Rn) = J - 1
          WFlag = False
          Rn = Rn + 1
          La = La + 1
        End If
      Next J
   Next I
   
  '从左上到右下标号
  For I = 0 To Rn - 1
     For J = 0 To Rn - 1
       If (WSy(I) - 1) = WSy(J) Then
           If ((WSx(J) - 1) <= WSx(I) And (WEx(J) + 1) >= WSx(I)) Then
               WLb(I) = WLb(J)
           ElseIf ((WSx(J) - 1) <= WEx(I) And (WEx(J) + 1) >= WEx(I)) Then
               WLb(I) = WLb(J)
           ElseIf ((WSx(I) - 1) <= WSx(J) And (WEx(I) + 1) >= WEx(J)) Then
               WLb(I) = WLb(J)
           End If
        End If
     Next J
  Next I
  
  '从右下到左上标号
  For I = Rn - 1 To 0
     For J = Rn - 1 To 0
       If (WSy(I) - 1) = WSy(J) Then
           If ((WSx(J) - 1) <= WSx(I) And (WEx(J) + 1) >= WSx(I)) Then
               WLb(J) = WLb(I)
           ElseIf ((WSx(J) - 1) <= WEx(I) And (WEx(J) + 1) >= WEx(I)) Then
               WLb(J) = WLb(I)
           ElseIf ((WSx(I) - 1) <= WSx(J) And (WEx(I) + 1) >= WSx(J)) Then
               WLb(J) = WLb(I)
           ElseIf ((WSx(I) - 1) <= WEx(J) And (WEx(I) + 1) >= WEx(J)) Then
               WLb(J) = WLb(I)
           End If
        End If
     Next J
  Next I
  
  
  For I = 0 To Rn - 1
     WK(I) = -1
  Next I
  
  For I = 0 To 400 - 1
     WKK(I) = 0
  Next I
  
  For I = 0 To Rn - 1
     WK(WLb(I)) = WLb(I)
  Next I
  
  No = 0
  For I = 0 To Rn - 1
    If WK(I) <> -1 Then
       WKK(No) = WK(I)
       No = No + 1
    End If
  Next I
  
  For I = 0 To No - 1
     WK(WKK(I)) = I + 1
  Next I
  
  For I = 0 To Rn - 1
     WLb(I) = WK(WLb(I))
  Next I
  
  For I = 0 To Rn - 1
     WArea(WLb(I)) = WArea(WLb(I)) + (WEx(I) - WSx(I) + 1)
  Next I
  
   For I = 0 To Rn - 1                                  '标号变颜色
    If WArea(WLb(I)) > 100 Then
      For J = WSx(I) To WEx(I)
        WColor = WLb(I)
        Pdes.PSet (J, WSy(I)), QBColor(WColor Mod 15)
      Next J
    Else
      For J = WSx(I) To WEx(I)
       Pdes.PSet (J, WSy(I)), RGB(255, 255, 255)
      Next J
    End If
  Next I

  X = Pdes.ScaleLeft: Y = Pdes.ScaleTop
  Pdes.FillStyle = 0
  J = 0
  For I = 1 To No
    If WArea(I) > 100 Then
      J = J + 1
      Pdes.Line (X + 5, Y + 10)-(X + 15, Y + 20), QBColor(I Mod 15), BF
      Pdes.CurrentX = X + 20
      Pdes.CurrentY = Y + 10
      Pdes.Print "面积" & J & ":" & Format(WArea(I))
      Y = Y + 15
    End If
  Next I

  Pdes.Refresh
  Screen.MousePointer = 0
  
End Sub

Private Sub Command9_Click()                                 '阈值计算1
  If ReadFlag = False Then
     MsgBox "请先读位图再处理图像!", vbInformation, "提示"
     Exit Sub
  End If
End Sub

Private Sub Form_Initialize()                                '初始化模块
  ReadFlag = False
End Sub