menu.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    =   3540
   ClientLeft      =   1536
   ClientTop       =   2232
   ClientWidth     =   6984
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   295
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   582
   Begin VB.PictureBox wdPicture 
      Height          =   2772
      Left            =   3600
      ScaleHeight     =   227
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   257
      TabIndex        =   11
      Top             =   480
      Width           =   3132
   End
   Begin VB.PictureBox WSPicture 
      AutoRedraw      =   -1  'True
      Enabled         =   0   'False
      Height          =   2772
      Left            =   240
      ScaleHeight     =   227
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   257
      TabIndex        =   10
      Top             =   480
      Width           =   3132
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   4560
      Top             =   4560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.PictureBox WIPicture2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   2760
      ScaleHeight     =   27
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   27
      TabIndex        =   9
      Top             =   720
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.PictureBox WIPicture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   2040
      ScaleHeight     =   27
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   27
      TabIndex        =   8
      Top             =   720
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.Frame Frame2 
      Caption         =   "目的图像"
      Height          =   2172
      Left            =   4920
      TabIndex        =   2
      Top             =   840
      Visible         =   0   'False
      Width           =   1572
      Begin VB.HScrollBar WDHScrol 
         Enabled         =   0   'False
         Height          =   270
         Left            =   240
         TabIndex        =   7
         Top             =   3600
         Width           =   3495
      End
      Begin VB.VScrollBar WDVScrol 
         Enabled         =   0   'False
         Height          =   3255
         Left            =   3600
         TabIndex        =   6
         Top             =   120
         Width           =   255
      End
      Begin VB.PictureBox WDPicture1 
         Height          =   3255
         Left            =   -3240
         ScaleHeight     =   267
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   287
         TabIndex        =   3
         Top             =   720
         Width           =   3495
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "源图像"
      Height          =   2052
      Left            =   1080
      TabIndex        =   0
      Top             =   1080
      Visible         =   0   'False
      Width           =   1452
      Begin VB.HScrollBar WSHScrol 
         Enabled         =   0   'False
         Height          =   270
         Left            =   240
         TabIndex        =   5
         Top             =   3600
         Width           =   3495
      End
      Begin VB.VScrollBar WSVScrol 
         Enabled         =   0   'False
         Height          =   3255
         Left            =   3720
         TabIndex        =   4
         Top             =   360
         Width           =   270
      End
      Begin VB.PictureBox WSPicture1 
         AutoRedraw      =   -1  'True
         Enabled         =   0   'False
         Height          =   3255
         Left            =   240
         ScaleHeight     =   267
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   287
         TabIndex        =   1
         Top             =   360
         Width           =   3495
      End
   End
   Begin VB.Label Label2 
      Caption         =   "目标图像"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   3600
      TabIndex        =   13
      Top             =   120
      Width           =   1572
   End
   Begin VB.Label Label1 
      Caption         =   "源图像"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   600
      TabIndex        =   12
      Top             =   120
      Width           =   1572
   End
   Begin VB.Menu FileMenu 
      Caption         =   "文件(&F)"
      NegotiatePosition=   3  'Right
      Begin VB.Menu fileopen 
         Caption         =   "打开文件(&O)"
         Shortcut        =   ^O
      End
      Begin VB.Menu FileClose 
         Caption         =   "关闭文件(&E)"
         Enabled         =   0   'False
         Shortcut        =   ^E
      End
      Begin VB.Menu FileSep1 
         Caption         =   "-"
      End
      Begin VB.Menu FileSaveas 
         Caption         =   "文件另存为(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu FileSep2 
         Caption         =   "-"
      End
      Begin VB.Menu FilePrint 
         Caption         =   "打印(&P)"
         Enabled         =   0   'False
         Shortcut        =   ^P
      End
      Begin VB.Menu FilePrintSetting 
         Caption         =   "打印设置(&U)"
         Enabled         =   0   'False
         Shortcut        =   ^U
      End
      Begin VB.Menu FileSep3 
         Caption         =   "-"
      End
      Begin VB.Menu RunTimeFiles 
         Caption         =   "RunTimeFiles"
         Index           =   0
         Visible         =   0   'False
      End
      Begin VB.Menu FileSep4 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu FileExit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu HuiMenu 
      Caption         =   "灰度处理(&H)"
      Visible         =   0   'False
      Begin VB.Menu HuiImage 
         Caption         =   "灰度图象"
      End
      Begin VB.Menu ComProLight 
         Caption         =   "亮度处理"
      End
      Begin VB.Menu HuiSep1 
         Caption         =   "-"
      End
      Begin VB.Menu HuiRectChart 
         Caption         =   "灰度直方图"
      End
      Begin VB.Menu HuiSep2 
         Caption         =   "-"
      End
      Begin VB.Menu HuiTwoImage 
         Caption         =   "二值图象"
      End
   End
   Begin VB.Menu ComProMenu 
      Caption         =   "普通处理"
      Visible         =   0   'False
      Begin VB.Menu ComProSmooth 
         Caption         =   "柔化处理"
      End
      Begin VB.Menu ComProSharpen 
         Caption         =   "锐化处理"
      End
      Begin VB.Menu ComProEmboss 
         Caption         =   "浮雕处理"
      End
      Begin VB.Menu ComProDiffuse 
         Caption         =   "扩散处理"
      End
      Begin VB.Menu ComProSolarize 
         Caption         =   "曝光处理"
      End
      Begin VB.Menu ComSep1 
         Caption         =   "-"
      End
      Begin VB.Menu ComProCustomFilter 
         Caption         =   "定制过滤器"
      End
   End
   Begin VB.Menu LineMenu 
      Caption         =   "线性卷积"
      Visible         =   0   'False
      Begin VB.Menu LineLow 
         Caption         =   "低通滤波"
      End
      Begin VB.Menu LineHigh 
         Caption         =   "高通滤波"
      End
      Begin VB.Menu LineSep1 
         Caption         =   "-"
      End
      Begin VB.Menu LineKernel 
         Caption         =   "定制卷积核"
      End
   End
   Begin VB.Menu FeMenu 
      Caption         =   "频域处理(&F)"
      Visible         =   0   'False
      Begin VB.Menu FeFft 
         Caption         =   "傅立叶变换"
      End
      Begin VB.Menu FeSep1 
         Caption         =   "-"
      End
      Begin VB.Menu FeHigh 
         Caption         =   "高通滤波"
         Enabled         =   0   'False
      End
      Begin VB.Menu FeLow 
         Caption         =   "低通滤波"
         Enabled         =   0   'False
      End
      Begin VB.Menu FeDai 
         Caption         =   "带通滤波"
         Enabled         =   0   'False
      End
      Begin VB.Menu FeSep2 
         Caption         =   "-"
      End
      Begin VB.Menu FeIFft 
         Caption         =   "傅立叶反变换"
      End
   End
   Begin VB.Menu IndusMenu 
      Caption         =   "工业图象处理"
      Begin VB.Menu IndusSign 
         Caption         =   "二值处理"
      End
      Begin VB.Menu IndusSep1 
         Caption         =   "-"
      End
      Begin VB.Menu IndusArea 
         Caption         =   "面积测量"
      End
      Begin VB.Menu IndusCircle 
         Caption         =   "周长测量"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public RuntimeNumber As Integer      '动态文件数
Public SourceX, SourceY As Integer   '源滚动条
Public DestX, DestY As Integer       '目的滚动条
Public WNumber As Long               '标号数目
Dim WSignArray() As Long     '图象标号的数组
Dim WCompareString(5) As String      '作为动态显示文件名的存储数组
Dim area1 As Variant

Private Sub FileClose_Click()         '文件关闭部分
 '  MsgBox "添加关闭文件和维护动态菜单"
 RuntimeNumber = RuntimeNumber - 1
 If (RuntimeNumber = 0) Then
 
    RunTimeFiles(RuntimeNumber).Visible = False  '动态显示部分
    FileSep4.Visible = False
    FileClose.Enabled = False
    WSHScrol.Enabled = False
    WSVScrol.Enabled = False
    
    WCompareString(RuntimeNumber) = ""     '数组部分
    
    Form1.Frame2.Caption = WDString        '标题为“目的图象”

    WSPicture.Picture = LoadPicture()      '图象处理部分
    WIPicture1.Picture = LoadPicture()
    wdPicture.Picture = LoadPicture()
    
    WSaveFileFlag = False                  '可以存盘的标志为假
 Else
    WSaveFileFlag = False                  '可以存盘的标志为假
    Unload RunTimeFiles(RuntimeNumber)
    WCompareString(RuntimeNumber) = ""
    
    Form1.Frame2.Caption = WDString         '标题为“目的图象”
    wdPicture.Picture = LoadPicture()       '目的图象为空

    '显示上一个图象部分
    SourceX = 0: SourceY = 0      '源滚动部分的初值
    WSHScrol.Value = 0: WSVScrol.Value = 0
    Call DisplayPicture1(WCompareString(RuntimeNumber - 1), WSPicture, WIPicture1, WIPicture2, WSHScrol, WSVScrol, Form1)
 End If
End Sub

Private Sub FileExit_Click()    '文件退出
  MsgBox "exit"

End Sub

Private Sub FileOpen_Click()       '打开文件部分
  Dim WFilename As String    '每次打开文件名
  Dim WStringCompare
  Static WFileoldname As String '保留打开文件名
 
  Dim I As Integer
  Dim Wcompare As Boolean

  CommonDialog1.InitDir = App.Path
  CommonDialog1.Filter = "Image(*.BMP;*.GIF;*.JPG;*.DIB)|*.BMP;*.GIF;*.JPG;*.DIB"
  CommonDialog1.Action = 1
  WFilename = CommonDialog1.FileName

  If ((WFilename <> "") And (RuntimeNumber < 4)) Then '如果文件已打开则显示且打开小于5