form1.frm

在VB里调入显示图像

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   9045
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   13230
   LinkTopic       =   "Form1"
   ScaleHeight     =   603
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   882
   Begin VB.PictureBox Picture5 
      AutoSize        =   -1  'True
      Height          =   1575
      Left            =   8640
      ScaleHeight     =   101
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   101
      TabIndex        =   7
      Top             =   240
      Width           =   1575
   End
   Begin VB.PictureBox Picture4 
      AutoSize        =   -1  'True
      Height          =   1575
      Left            =   8520
      ScaleHeight     =   101
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   109
      TabIndex        =   6
      Top             =   2640
      Width           =   1695
   End
   Begin VB.PictureBox Picture3 
      AutoSize        =   -1  'True
      Height          =   1695
      Left            =   5880
      ScaleHeight     =   109
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   5
      Top             =   240
      Width           =   1815
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   615
      Left            =   5880
      TabIndex        =   4
      Top             =   6480
      Width           =   2055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   615
      Left            =   3000
      TabIndex        =   3
      Top             =   6480
      Width           =   2295
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   360
      TabIndex        =   2
      Top             =   6480
      Width           =   2295
   End
   Begin VB.PictureBox Picture2 
      AutoSize        =   -1  'True
      Height          =   1695
      Left            =   5880
      ScaleHeight     =   109
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   1
      Top             =   2640
      Width           =   1815
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      Height          =   4335
      Left            =   360
      ScaleHeight     =   285
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   317
      TabIndex        =   0
      Top             =   240
      Width           =   4815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
  Picture1.Picture = LoadPicture(App.Path & "\1.bmp")
    Me.Picture1.AutoRedraw = True
    PICW = Me.Picture1.ScaleWidth
    PICH = Me.Picture1.ScaleHeight
    GETDIBS Me.Picture1.Image
    Dim i As Long
    Dim j As Long
    Dim m As Integer, a As Integer, b As Integer, c As Integer, d As Integer, x As Single
    Dim n As Integer
    Dim GX As Double, PX As Double, PY As Double
    Dim GY As Double
    Dim g As Double
    Dim π As Single
    Dim ChangeGray As Integer
    Dim P(1 To 400, 1 To 400) As Double
    Dim θ(1 To 400, 1 To 400) As Double
    ReDim PalBGR4(1 To 4, 1 To PICW, 1 To PICH)
    ReDim PalBGR5(1 To 4, 1 To PICW, 1 To PICH)
    π = 3.1415926
    'Call FillMemory(PalBGR4(1, 1, 1), PICW * PICH * 4, 255)
    For i = 1 To PICW
        For j = 1 To PICH
            ChangeGray = 0.299 * palbgr(1, i, j) + 0.587 * palbgr(2, i, j) + 0.114 * palbgr(3, i, j)
            PalBGR4(1, i, j) = ChangeGray
            PalBGR4(2, i, j) = ChangeGray
            PalBGR4(3, i, j) = ChangeGray
        Next j
    Next i
   '高斯卷积
    For i = 2 To PICW - 1
        For j = 2 To PICH - 1
                
            PalBGR4(1, i, j) = (PalBGR4(1, i - 1, j + 1) + PalBGR4(1, i, j + 1) * 2 + PalBGR4(1, i + 1, j + 1) + PalBGR4(1, i - 1, j) * 2 + PalBGR4(1, i, j) * 4 + PalBGR4(1, i + 1, j) * 2 + PalBGR4(1, i - 1, j - 1) + PalBGR4(1, i, j - 1) * 2 + PalBGR4(1, i + 1, j - 1)) / 16
            PalBGR4(2, i, j) = PalBGR4(1, i, j)
            PalBGR4(3, i, j) = PalBGR4(1, i, j)
                
            
        Next j
    Next i
    For i = 2 To PICW - 1
        For j = 2 To PICH - 1
        a = PalBGR4(1, i + 1, j - 1)
        b = PalBGR4(1, i - 1, j)
        e = PalBGR4(1, i - 1, j + 1)
        f = PalBGR4(1, i - 1, j - 1)
        c = PalBGR4(1, i + 1, j + 1)
        d = PalBGR4(1, i + 1, j)
        g = PalBGR4(1, i, j + 1)
        h = PalBGR4(1, i, j - 1)
        PX = (c - e + d - b + a - f) / 3
        PY = (e - f + g - h + c - a) / 3
        P(i, j) = Sqr(PX ^ 2 + PY ^ 2)
        If PX <> 0 Then
            θ(i, j) = Atn(PY / PX)
        ElseIf PX = 0 And PY <> 0 Then
            θ(i, j) = π / 2
        End If
        Next j
    Next i
    '对梯度幅值进行非极大值抑制
    
    For i = 2 To PICW - 1
        For j = 2 To PICH - 1
        If θ(i, j) >= -22.5 * π / 180 And θ(i, j) <= 22.5 * π / 180 Then
            If P(i, j) <= P(i - 1, j) Or P(i, j) <= P(i + 1, j) Then
                PalBGR4(1, i, j) = 0
                PalBGR4(2, i, j) = 0
                PalBGR4(3, i, j) = 0
            End If
        ElseIf θ(i, j) > 22.5 * π / 180 And θ(i, j) <= 67.5 * π / 180 Then
            If P(i, j) <= P(i + 1, j + 1) Or P(i, j) <= P(i - 1, j - 1) Then
                PalBGR4(1, i, j) = 0
                PalBGR4(2, i, j) = 0
                PalBGR4(3, i, j) = 0
            End If
        ElseIf θ(i, j) > 67.5 * π / 180 And θ(i, j) < π / 2 Or θ(i, j) > -π / 2 And θ(i, j) < -67.5 * π / 180 Then
            If P(i, j) <= P(i, j + 1) Or P(i, j) <= P(i, j - 1) Then
                PalBGR4(1, i, j) = 0
                PalBGR4(2, i, j) = 0
                PalBGR4(3, i, j) = 0
            End If
        ElseIf θ(i, j) >= -67.5 * π / 180 And θ(i, j) < -22.5 * π / 180 Then
            If P(i, j) <= P(i - 1, j + 1) Or P(i, j) <= P(i - 1, j + 1) Then
                PalBGR4(1, i, j) = 0
                PalBGR4(2, i, j) = 0
                PalBGR4(3, i, j) = 0
            End If
        End If
        Next j
    Next i
    For i = 1 To PICW
        For j = 1 To PICH
        If PalBGR4(1, i, j) < 100 Then
            PalBGR4(1, i, j) = 0
            PalBGR4(2, i, j) = 0
            PalBGR4(3, i, j) = 0
        End If
        Next j
    Next i

    
    ShowPalBGR Picture1
End Sub


Private Sub Command2_Click()
Dim i As Integer, j As Integer
Dim m10 As Double, m00 As Double, m01 As Double, x0 As Double, y0 As Double
    Picture1.Picture = LoadPicture(App.Path & "\121.bmp")
    Me.Picture1.AutoRedraw = True
    PICW = Me.Picture1.ScaleWidth
    PICH = Me.Picture1.ScaleHeight
    GETDIBS Me.Picture1.Image
    Call ChangeImage(palbgr)
    
    
    Call HDBYJC(PalBGR3)
    
        

    ShowPalBGR_hd Picture3
    
End Sub

Private Sub Command3_Click()

Picture1.Picture = LoadPicture(App.Path & "\2.bmp")
    Me.Picture1.AutoRedraw = True
    PICW = Me.Picture1.ScaleWidth
    PICH = Me.Picture1.ScaleHeight
    GETDIBS Me.Picture1.Image
     
 'ReDim PalBGR3(1 To 4, 1 To PICW, 1 To PICH)
 'Call FillMemory(PalBGR3(1, 1, 1), PICW2 * PICH2 * 4, 255)
 Call ChangeImage(palbgr)
 ShowPalBGR_RE Picture2
 Call ChangeImage(palbgr)
 Call HDBYJC(PalBGR3)
  'ShowPalBGR_hd Picture3
 ShowPalBGR_RE Picture3
 Call ChangeImage(palbgr)
 ShowPalBGR_RE Picture4
 Call ChangeImage(palbgr)
 ShowPalBGR_RE Picture5
     
End Sub