lvbo.frm

计算面积公式源代码

VERSION 5.00
Begin VB.Form Form6 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form6"
   ClientHeight    =   2460
   ClientLeft      =   4485
   ClientTop       =   4020
   ClientWidth     =   3060
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form6"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2460
   ScaleWidth      =   3060
   Begin VB.Frame Frame2 
      Caption         =   "系数"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   1800
      TabIndex        =   12
      Top             =   240
      Width           =   855
      Begin VB.TextBox Text2 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   120
         MaxLength       =   1
         TabIndex        =   13
         Top             =   240
         Width           =   615
      End
   End
   Begin VB.CommandButton WLvPro 
      Caption         =   "处 理"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   240
      TabIndex        =   11
      Top             =   1920
      Width           =   855
   End
   Begin VB.CommandButton WLvCan 
      Caption         =   "取 消"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   1800
      TabIndex        =   10
      Top             =   1920
      Width           =   855
   End
   Begin VB.Frame Frame1 
      Caption         =   "卷积核"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1455
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1335
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   8
         Left            =   840
         MaxLength       =   1
         TabIndex        =   9
         Top             =   960
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   7
         Left            =   480
         MaxLength       =   1
         TabIndex        =   8
         Top             =   960
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   6
         Left            =   120
         MaxLength       =   1
         TabIndex        =   7
         Top             =   960
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   5
         Left            =   840
         MaxLength       =   1
         TabIndex        =   6
         Top             =   600
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   4
         Left            =   480
         MaxLength       =   1
         TabIndex        =   5
         Top             =   600
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   3
         Left            =   120
         MaxLength       =   1
         TabIndex        =   4
         Top             =   600
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   2
         Left            =   840
         MaxLength       =   1
         TabIndex        =   3
         Top             =   240
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   1
         Left            =   480
         MaxLength       =   1
         TabIndex        =   2
         Top             =   240
         Width           =   375
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Index           =   0
         Left            =   120
         MaxLength       =   1
         TabIndex        =   1
         Top             =   240
         Width           =   375
      End
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WLvHe(8) As Integer
Dim WSi As Integer
Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
  If (KeyCode = 109) Then     '如果键为“-”则长度为二
      Text1(Index).MaxLength = 2
      Exit Sub
  End If
  
  '如果键不为数字和不为回车则...
  If ((KeyCode < 48) Or (KeyCode > 57)) And (KeyCode <> 13) Then
     Text1(Index).Text = ""
     Text1(Index).MaxLength = 1
     Text1(Index).SetFocus
     Exit Sub
  End If
     
  '如果为回车则...
  If (KeyCode = 13) Then
     If Text1(Index).Text = "-" Then  '如果只键入”-“后回车则...
        Text1(Index).Text = ""
        Text1(Index).MaxLength = 1
        Text1(Index).SetFocus
        Exit Sub
     End If
     WLvHe(Index) = Val(Text1(Index).Text)
     If (Index + 1) = 9 Then
        Text2.SetFocus
     Else
        Text1(Index + 1).SetFocus
     End If
  End If
End Sub

Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
  If ((KeyCode < 48) Or (KeyCode > 57)) And (KeyCode <> 13) Then
      Text2.Text = ""
      Text2.SetFocus
      Exit Sub
  End If
  If KeyCode = 13 Then
    WSi = Val(Text2.Text)
    Text1(0).SetFocus
    WLvPro.Enabled = True
  End If
End Sub

Private Sub WLvCan_Click()
 Dim I As Integer
 For I = 0 To 8
   WLvHe(I) = 0
   Text1(I).Text = ""
 Next I
 WSi = 0
 Text1(0).SetFocus
 WLvPro.Enabled = False
End Sub

Private Sub WLvPro_Click()
 Dim WSize As Integer
 Dim I As Integer, J As Integer
 Dim N1 As Integer, N2 As Integer
 Dim WWidth As Integer, WHeight As Integer
 Dim RSum As Single, GSum As Single, BSum As Single
 Dim WSBmp As Long
 Dim WSBmpDc As Long
 Dim N As Integer
 Dim WI() As Integer
 Dim WLv(2, 2) As Single
 
 For I = 0 To 2
  For J = 0 To 2
     WLv(I, J) = WLvHe(I * 2 + J)
     If WSi <> 0 Then WLv(I, J) = WLv(I, J) / WSi
  Next J
 Next I
 
 
 WSize = 3      '卷积核为3*3
 WWidth = Form1.WIPicture1.ScaleWidth + WSize - 1
 WHeight = Form1.WIPicture1.ScaleHeight + WSize - 1
 Screen.MousePointer = 11         '显示鼠标为漏斗状
  
 Form2.ProgressBar1.Min = 0                 '进度条的情况
 Form2.ProgressBar1.Max = 2 * Form1.WIPicture1.ScaleWidth
 Form6.Hide
 Form2.Show
 Form2.Caption = "定制滤波在处理..."
 Form1.Enabled = False
 Form2.ProgressBar1.Value = Form2.ProgressBar1.Min '进度条的情况
  
  N = 0                          '进度条初值
 
 ReDim WI(2, WWidth - 1, WHeight - 1)
 For I = 2 To WWidth - 1
   For J = 2 To WHeight - 1
     WI(0, I, J) = WImage(0, I - 2, J - 2)
     WI(1, I, J) = WImage(1, I - 2, J - 2)
     WI(2, I, J) = WImage(2, I - 2, J - 2)
   Next J
   N = N + 1
   Form2.ProgressBar1.Value = N
 Next I
 
 WSBmp = CreateCompatibleBitmap(Form1.WIPicture2.hdc, Form1.WIPicture2.ScaleWidth, Form1.WIPicture2.ScaleHeight)
 WSBmpDc = CreateCompatibleDC(Form1.WIPicture2.hdc)
 SelectObject WSBmpDc, WSBmp

 BitBlt WSBmpDc, 0, 0, Form1.WIPicture2.ScaleWidth, Form1.WIPicture2.ScaleHeight, Form1.WIPicture2.hdc, 0, 0, &HCC0020
 
 
 For I = 2 To WWidth - 1
  For J = 2 To WHeight - 1
    RSum = 0: GSum = 0: BSum = 0
    For N1 = I - 2 To I
      For N2 = J - 2 To J
        RSum = RSum + WI(0, N1, N2) * WLv(I - N1, J - N2)
        GSum = GSum + WI(1, N1, N2) * WLv(I - N1, J - N2)
        BSum = BSum + WI(2, N1, N2) * WLv(I - N1, J - N2)
      Next N2
    Next N1
    SetPixel WSBmpDc, I - 2, J - 2, RGB(Int(Abs(RSum)), Int(Abs(GSum)), Int(Abs(BSum)))
  Next J
  N = N + 1
  Form2.ProgressBar1.Value = N
  DoEvents
 Next I
 
 BitBlt Form1.WIPicture2.hdc, 0, 0, Form1.WIPicture2.ScaleWidth - 1, Form1.WIPicture2.ScaleHeight - 1, WSBmpDc, 0, 0, &HCC0020
 Form2.Hide
 Form1.Enabled = True
 Screen.MousePointer = 0              '鼠标恢复正常
  
  '显示目的图像
 Form1.DestX = 0: Form1.DestY = 0
 Form1.WDHScrol.Value = 0: Form1.WDVScrol.Value = 0
 Call DisplayPicture2(Form1.WDPicture, Form1.WIPicture2, Form1.WDHScrol, Form1.WDVScrol, Form1)
 WSaveFileFlag = True      '可以存盘的标志为真
  
 Form1.Frame2.Caption = WDString & "(定制滤波)"
 Form1.SetFocus
  
 Call DeleteDC(WSBmpDc)
 Call DeleteObject(WSBmp)
End Sub