main.frm

一个图象处理的小软件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmMain 
   Caption         =   "图像处理程序(@rmj2000)"
   ClientHeight    =   4920
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   8625
   LinkTopic       =   "Form1"
   ScaleHeight     =   4920
   ScaleWidth      =   8625
   StartUpPosition =   3  '窗口缺省
   Begin ComctlLib.ProgressBar ProgressBar1 
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   4440
      Width           =   8655
      _ExtentX        =   15266
      _ExtentY        =   661
      _Version        =   327682
      Appearance      =   1
   End
   Begin VB.PictureBox Pic2 
      Height          =   3960
      Left            =   4560
      ScaleHeight     =   260
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   276
      TabIndex        =   1
      Top             =   360
      Width           =   4200
   End
   Begin VB.PictureBox Pic1 
      Height          =   3960
      Left            =   120
      ScaleHeight     =   260
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   276
      TabIndex        =   0
      Top             =   360
      Width           =   4200
      Begin VB.Image Image1 
         Height          =   3855
         Left            =   0
         Top             =   0
         Width           =   4095
      End
   End
   Begin MSComDlg.CommonDialog CmDlg1 
      Left            =   120
      Top             =   4440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label2 
      Height          =   255
      Left            =   4920
      TabIndex        =   7
      Top             =   120
      Width           =   1695
   End
   Begin VB.Label Label1 
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   7200
      TabIndex        =   6
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label5 
      Caption         =   "当前"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   6720
      TabIndex        =   5
      Top             =   120
      Width           =   375
   End
   Begin VB.Label Label4 
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   1320
      TabIndex        =   4
      Top             =   120
      Width           =   3495
   End
   Begin VB.Label Label3 
      Caption         =   "当前文件路径"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   1095
   End
   Begin VB.Menu File 
      Caption         =   "文件(&F)"
      Begin VB.Menu input 
         Caption         =   "打开(&O)"
      End
      Begin VB.Menu save 
         Caption         =   "保存(&S)"
         Enabled         =   0   'False
      End
      Begin VB.Menu popo 
         Caption         =   "-"
      End
      Begin VB.Menu clear 
         Caption         =   "清除(&D)"
         Enabled         =   0   'False
      End
      Begin VB.Menu end 
         Caption         =   "结束(&E)"
      End
   End
   Begin VB.Menu Edit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu copy 
         Caption         =   "复制(&C)"
         Enabled         =   0   'False
      End
      Begin VB.Menu trim 
         Caption         =   "剪切(&T)"
         Enabled         =   0   'False
      End
      Begin VB.Menu paste 
         Caption         =   "粘贴(&P)"
         Enabled         =   0   'False
      End
      Begin VB.Menu hengline 
         Caption         =   "-"
      End
      Begin VB.Menu zoom 
         Caption         =   "缩放(&H)"
         Enabled         =   0   'False
      End
      Begin VB.Menu dldc 
         Caption         =   "淡入淡出"
         Enabled         =   0   'False
      End
   End
   Begin VB.Menu Image 
      Caption         =   "图像处理(&I)"
      Begin VB.Menu gray 
         Caption         =   "灰度(&G)"
         Begin VB.Menu gray1 
            Caption         =   "灰度"
         End
         Begin VB.Menu grayzft 
            Caption         =   "直方图"
            Enabled         =   0   'False
         End
      End
      Begin VB.Menu nihong 
         Caption         =   "霓红(&N)"
      End
      Begin VB.Menu fudiao 
         Caption         =   "浮雕(&F)"
      End
      Begin VB.Menu t 
         Caption         =   "-"
      End
      Begin VB.Menu nifan 
         Caption         =   "逆反(&Z)"
      End
      Begin VB.Menu xiangqian 
         Caption         =   "镶嵌(&X)"
      End
      Begin VB.Menu juanji 
         Caption         =   "卷积(&J)"
      End
      Begin VB.Menu d 
         Caption         =   "-"
      End
      Begin VB.Menu rotate 
         Caption         =   "旋转(&X)"
      End
      Begin VB.Menu uncolor 
         Caption         =   "伪彩色(&W)"
      End
      Begin VB.Menu pinghua 
         Caption         =   "平滑(&Y)"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
  
 Public Sub pcopy(picx As Object, x0 As Single, y0 As Single, xx As Single, yy As Single)
 Pic1.Cls
 'a = bitblt(Pic1.hDC, 0, 0, xx, yy, picx.hDC, x0, y0, &HCC0020)
 Clipboard.clear
 Clipboard.SetData Pic1.Image
 w1 = xx
 h1 = yy
 End Sub
 


Private Sub clear_Click()
Pic2.Cls
End Sub

Private Sub copy_Click()
pcopy Screen.ActiveControl, x1select + 1, y1select + 1, x2select - x1select - 1, y2select - y1select - 1
End Sub

Private Sub Dir1_Change()
Dir1.Path = fdir
Dir1.Refresh
End Sub

Private Sub dldc_Click()
frmdldc.Show vbModal

End Sub

Private Sub end_Click()
End
End Sub

Private Sub Form_Load()
frmMain.Top = 300
frmMain.Left = 3000
Pic1.ScaleMode = 3
Pic2.ScaleMode = 3
Image1.Stretch = True
Label4.Caption = "无图像！"
Label1.Caption = "无任何处理！"
Label1.FontItalic = True
Label1.FontBold = True
End Sub

Private Sub fudiao_Click()
Label1.Caption = "浮雕处理"
Pic2.Cls
Screen.MousePointer = 11
ProgressBar1.Min = 0
ProgressBar1.Max = Pic1.ScaleWidth
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
n = 0
For i = 0 To Pic2.ScaleHeight
     For j = 0 To Pic2.Width
     c = Pic1.Point(j, i)
     r1 = (c And &HFF)
     g1 = (c And 65280) \ 256
     b1 = (c And &HFF0000) \ 65536
     cc = Pic1.Point(j - 1, i - 1)
     r2 = (cc And &HFF)
     g2 = (cc And 65280) \ 256
     b2 = (cc And &HFF0000) \ 65536
     rr = r1 - r2 + 128
     gg = g1 - g2 + 128
     bb = b1 - b2 + 128
 If rr < 0 Then rr = 0
 If rr > 255 Then rr = 255
     If gg < 0 Then gg = 0
     If gg > 255 Then gg = 255
     If bb < 0 Then bb = 0
     If bb > 255 Then bb = 255
     Pic2.PSet (j, i), RGB(rr, gg, bb)
Next j
ProgressBar1.Value = n
n = n + 1
Next i
ProgressBar1.Visible = False
Screen.MousePointer = 0
End Sub



Private Sub gray1_Click()
Dim i, j As Integer
Dim c, r, g, b, X, n As Long
grayzft.Visible = True
grayzft.Enabled = True
Label1.Caption = "灰度处理"
Pic2.Cls
Screen.MousePointer = 11
ProgressBar1.Min = 0
ProgressBar1.Max = Pic1.ScaleWidth
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
n = 0
For i = 0 To Pic2.ScaleWidth
For j = 0 To Pic2.ScaleHeight
c = Pic1.Point(i, j)
r = c And &HFF
g = (c And &HFF00) \ 256
b = (c And &HFF0000) \ 65536
X = 0.31 * r + 0.59 * b + 0.11 * b
'X = (g + r + b) / 3
Pic2.PSet (i, j), RGB(X, X, X)
Next j
ProgressBar1.Value = n
n = n + 1
Next i
ProgressBar1.Visible = False
Screen.MousePointer = 0
End Sub

Private Sub grayzft_Click()
frmgrayzft.Show vbModal
End Sub

Private Sub input_Click()
save.Visible = True
save.Enabled = True
clear.Visible = True
clear.Enabled = True
zoom.Visible = True
zoom.Enabled = True
dldc.Visible = True
dldc.Enabled = True
CmDlg1.DialogTitle = "打开图像文件"
'CmDlg1.Filter = "位图(*.bmp)|*.bmp"
CmDlg1.ShowOpen
Image1.Picture = LoadPicture(CmDlg1.FileName)
'DoEvents
'Pic1.PaintPicture Pic1.Picture, 0, 0, Pic1.ScaleWidth, Pic1.ScaleHeight
Label4.Caption = CmDlg1.FileName
Label4.ForeColor = RGB(0, 0, 255)
End Sub



Private Sub juanji_Click()
frmjjpro.Show vbModal
End Sub

Private Sub nifan_Click()
Label1.Caption = "逆反处理"
Pic2.Cls
Screen.MousePointer = 11
ProgressBar1.Min = 0
ProgressBar1.Max = Pic1.ScaleWidth
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
n = 0
For i = 0 To Pic2.ScaleWidth
     For j = 0 To Pic2.ScaleHeight
     c = Pic1.Point(j, i)
     r1 = (c And &HFF)
     g1 = (c And 65280) \ 256
     b1 = (c And &HFF0000) \ 65536
     rr = 255 - r1
     gg = 255 - g1
     bb = 255 - b1
     If rr < 0 Then rr = 0
     If rr > 255 Then rr = 255
     If gg < 0 Then gg = 0
     If gg > 255 Then gg = 255
     If bb < 0 Then bb = 0
     If bb > 255 Then bb = 0
 Pic2.PSet (j, i), RGB(rr, rr, rr)
 Next j

ProgressBar1.Value = n
n = n + 1
Next i
ProgressBar1.Visible = False
Screen.MousePointer = 0
End Sub

Private Sub nihong_Click()
Label1.Caption = "霓虹处理"
Pic2.Cls
Screen.MousePointer = 11
ProgressBar1.Min = 0
ProgressBar1.Max = Pic1.ScaleWidth
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
n = 0
For i = 0 To Pic2.ScaleHeight
For j = 0 To Pic2.ScaleWidth
c = Pic1.Point(j, i)
             r1 = (c And &HFF)
             g1 = (c And 65280) \ 256
             b1 = (c And &HFF0000) \ 65536
             cc = Pic1.Point(j + 1, i)
             r2 = (cc And &HFF)
             g2 = (cc And 65280) \ 256
             b2 = (cc And &HFF0000) \ 65536
             cd = Pic1.Point(j, i + 1)
             r3 = (cd And &HFF)
             g3 = (cd And 65280) \ 256
             b3 = (cd And &HFF0000) \ 65536
             rr1 = (r1 - r2) ^ 2: rr2 = (r1 - r3) ^ 2: rr = 2 * (rr1 + rr2) ^ 0.5
             gg1 = (g1 - g2) ^ 2: gg2 = (g1 - g3) ^ 2: gg = 2 * (gg1 + gg2) ^ 0.5
             bb1 = (b1 - b2) ^ 2: bb2 = (b1 - b3) ^ 2: bb = 2 * (bb1 + bb2) ^ 0.5
 If rr < 0 Then rr = 0
 If rr > 255 Then rr = 255
     If gg < 0 Then gg = 0
     If gg > 255 Then gg = 255
     If bb < 0 Then bb = 0
     If bb > 255 Then bb = 255
     Pic2.PSet (j, i), RGB(rr, gg, bb)
 Next j


ProgressBar1.Value = n
n = n + 1
Next i
ProgressBar1.Visible = False
Screen.MousePointer = 0
End Sub

Private Sub pinghua_Click()
Dim rr, gg, bb As Single
Label1.Caption = "平滑处理"
Pic2.Cls
ProgressBar1.Visible = True
blocksize = 3
n = 0
ProgressBar1.Max = Pic2.ScaleWidth
ProgressBar1.Min = 0
ProgressBar1.Value = 0
Screen.MousePointer = 11
For i = 0 To Pic2.ScaleHeight '- Int(blocksize / 2)
 For j = 0 To Pic2.ScaleWidth
     rx = 0: gx = 0: bx = 0:
     For k1 = -Int(blocksize / 2) To Int(blocksize / 2)
   For k2 = -Int(blocksize / 2) To Int(blocksize / 2)
     c = Pic1.Point(j + k1, i + k2)
     r = (c And &HFF)
     g = (c And 65280) \ 256
     b = (c And &HFF0000) \ 65536
     rx = rx + r
     gx = gx + g
     bx = bx + b
   Next k2
     Next k1
     rr = rx / (blocksize ^ 2)
     gg = gx / (blocksize ^ 2)
     bb = bx / (blocksize ^ 2)
     If rr < 0 Then rr = 0
     If rr > 255 Then rr = 255
     If gg < 0 Then gg = 0
     If gg > 255 Then gg = 255
     If bb < 0 Then bb = 0
     If bb > 255 Then bb = 255
     Pic2.PSet (j, i), RGB(rr, gg, bb)
 Next j
 ProgressBar1.Value = n
n = n + 1
Next i
Screen.MousePointer = 0
ProgressBar1.Visible = False
End Sub

Private Sub rotate_Click()
frmrotate.Show vbModal
End Sub

Private Sub save_Click()
Pic2.AutoRedraw = True
CmDlg1.ShowSave
CmDlg1.DefaultExt = ".BMP"
CmDlg1.Filter = "Bitmap Image (*.bmp)|*.bmp"
If CmDlg1.FileName <> "" Then
SavePicture Pic2.Image, CmDlg1.FileName
Pic2.AutoRedraw = False
End If
End Sub

Private Sub Timer1_Timer()
lblTime.Caption = Format$(Time, "hh: mm: ss ")
lblTime.ForeColor = RGB(255, 0, 0)
End Sub

Private Sub Timer2_Timer()
For i = 0 To Label1.Left + Label1.Width
Label1.Left = Label1.Left + 1
Next
End Sub

Private Sub uncolor_Click()
Dim colorindex As Integer
Dim graymax, csing As Integer
Label1.Caption = "伪彩色处理"
Pic2.Cls
Screen.MousePointer = 11
ProgressBar1.Min = 0
ProgressBar1.Max = Pic1.ScaleWidth
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
n = 0
graymax = 0
For i = 0 To frmMain.Pic1.ScaleWidth
For j = 0 To frmMain.Pic1.ScaleHeight
c = frmMain.Pic1.Point(i, j)
If c > graymax Then graymax = c
Next j
Next i
For i = 0 To frmMain.Pic1.ScaleWidth
For j = 0 To frmMain.Pic1.ScaleHeight
c = frmMain.Pic1.Point(i, j)
colorindex = 16 * c / graymax
If colorindex > 15 Then colorindex = 15
frmMain.Pic2.PSet (i, j), QBColor(colorindex)
Next j
ProgressBar1.Value = n
n = n + 1
Next i
ProgressBar1.Visible = False
Screen.MousePointer = 0
End Sub
Private Sub xiangqian_Click()
Label1.Caption = "镶嵌处理"
Pic2.Cls
Screen.MousePointer = 11
ProgressBar1.Min = 0
ProgressBar1.Max = Pic1.Width
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.Min
n = 0
For i = 0 To Pic1.ScaleHeight Step 3
For j = 0 To Pic1.ScaleWidth Step 3
X = 0: gx = 0: bx = 0
For k1 = 0 To 5
For k2 = 0 To 5
c = Pic1.Point(j + k2, i + k1)
r1 = (c And &HFF)
g1 = (c And 65280) \ 256
b1 = (c And &HFF0000) \ 65536
rx = rx + r1: gx = gx + g1: bx = bx + b1
Next k2
Next k1
rr = rx / 25
gg = gx / 25
bb = bx / 25
If rr < 0 Then rr = 0
If rr > 255 Then rr = 255
If gg < 0 Then rr = 0
If gg > 255 Then rr = 255
If bb < 0 Then rr = 0
If bb > 255 Then rr = 255
For k1 = 0 To 5
For k2 = 0 To 5
Pic2.PSet (j + k2, i + k1), RGB(rr, gg, bb)
Next k2
Next k1
Next j
n = n + 48
ProgressBar1.Value = n
Next i
ProgressBar1.Visible = False
Screen.MousePointer = 0
End Sub

Private Sub zoom_Click()
frmzoom.Show vbModal
End Sub