formmain.txt

一个用vb的经典的图形编辑程序

Dim cx As Single                                 '用于记下图片的宽度,图像的原宽度用ccx记录
Dim cy As Single                                 '用于记下图片的高度,图像的原高度用ccy记录
Dim px As Single                                 '用于画多边形的变量
Dim py As Single                                 '用于画多边形的变量
Dim Times As Integer                             '用于在画多边形区分第一按下和后来的按下鼠标
Dim px1 As Single                                '用于画多边形的变量
Dim py1 As Single                                '用于画多边形的变量
Dim DrawWide As Integer                          '用于直线的粗细
Dim tmlcolor As Long                             '用于存颜色的混合值
Dim Arrycol() As Long                            '用于存红，绿，蓝的数组
Dim r1 As Long, g1 As Long, b1 As Long           '计算一个像素的红，绿，蓝值
Dim r2 As Long, g2 As Long, b2 As Long              '计算一个像素的红，绿，蓝值
Dim Pjr As Long, Pjg As Long, Pjb As Long        '在对图像锐化的时候用到
Dim Delr As Long, Delg As Long, Delb As Long     '在对图像锐化的时候用到
Dim Delr1 As Long, Delg1 As Long, Delb1 As Long  '在对图像锐化的时候用到
Dim Alpha As Single                              '图像的锐化度
Const Pi = 3.14                                  '将角度变成弧度
Dim xnow As Single, ynow As Single               '用于完成直线,铅笔等的坐标,并不断的改变
Dim x0 As Single, y0 As Single                   '用于完成直线,铅笔等的坐标
Dim radius As Single, radius0 As Single          '圆的半径
Dim x11 As Single, y11 As Single                 '选定区域用到，记录选定区域的最左上角坐标
Dim xnow11 As Single, ynow11 As Single           '选定的功能，记录选定区域的最右下角坐标
Dim ccx As Single, ccy As Single                 '用ccx,ccy保存原图像的大小，在图像改变大小时用到
Dim xx11 As Single, yy11 As Single
Dim xxnow11 As Single, yynow11 As Single
Dim name1 As String, Time1 As Integer            '文件操作
'***************************************************************************
'PicBackUp   在每次对图像进行变换,PicBackUp保存PicMain的图像，以便后来的撤销用
'PicFlip     专门用于图像的大小变换，保存变大，变小的图像
'PicBaocun   专门用于保存剪切的图像，然后把图像放在剪切板上
'PicNew      用于创建一个新的PictureBox
'PicCHULI    专门用于对图像的模糊,锐化,雕刻,扩散
'***************************************************************************

Private Sub Abo_Click()
Dim value As Integer
value = MsgBox("这是我的毕业设计，有不少缺点，请各位老师指教!", 0, "图形编辑小程序V1.0")
End Sub

Private Sub B_Click()
Dim DWidth1 As Single
Dim DHeight1 As Single
PicZoom.Cls
PicBackup.Picture = PicMain.Image
DWidth1 = ccx
DHeight1 = ccy
PicZoom.Width = DWidth1
PicZoom.Height = DHeight1
PicZoom.PaintPicture PicBackup.Picture, 0, 0, DWidth1, DHeight1
'Zoom2 (2)
PicMain.Picture = PicZoom.Image
End Sub

Private Sub BC_Click()
  DrawWide = 3
End Sub

Private Sub brush_Click()
drawact = 9
End Sub

Private Sub BX_Click()
  DrawWide = 1
End Sub
Private Sub Circle_Click()
 drawact = 4
End Sub
Private Sub Col_Click()
   ComDiag.CancelError = False
   ComDiag.ShowColor
   PicFCol.BackColor = ComDiag.Color
   
   PicMain.ForeColor = ComDiag.Color
End Sub

Private Sub Command1_Click()
 Command1.Width = 35
End Sub

Private Sub Copy_Click(Index As Integer)
  Dim width1 As Single, height1 As Single
  width1 = xnow11 - x11: height1 = ynow11 - y11
  PicBackup.Picture = PicMain.Image
  PicBaocun.PaintPicture PicMain.Picture, 0, 0, width1, height1, x11, y11, width1, height1, vbSrcCopy
  PicBaocun.Width = width1: PicBaocun.Height = height1
  PicBaocun.Picture = PicMain.Image
  Clipboard.Clear
  Clipboard.SetData PicBaocun.Picture
End Sub

Private Sub CUOQIE_Click() '********************************功能没有完成
Dim cx2, cy2 As Single
PicCHULI.Picture = LoadPicture("")
cx2 = PicMain.ScaleWidth
cy2 = PicMain.ScaleHeight
PicCHULI.Width = Sqr(cx2 ^ 2 + cy ^ 2) * 2
PicCHULI.Height = Sqr(cx2 ^ 2 + cy ^ 2) * 2
ReDim Arrycol(2, cx2, cy2)
 For i = 0 To cx2 - 1
   For j = 0 To cy2 - 1
    tmlcolor = PicMain.Point(i, j)
    r2 = tmlcolor Mod 256
    g2 = ((tmlcolor And &HFF00) / 256) Mod 256
    b2 = (tmlcolor And &HFF0000) / 65536
    Arrycol(0, i, j) = r2
    Arrycol(1, i, j) = g2
    Arrycol(2, i, j) = b2
  Next j
 Next i
 For i = 0 To cx2 - 1
   For j = 0 To cy2 - 1
    r1 = Arrycol(0, i, j)
    g1 = Arrycol(1, i, j)
    b1 = Arrycol(2, i, j)
   PicCHULI.PSet (i + j, j), RGB(r1, g1, b1)
  Next j
 Next i
 PicMain.Picture = PicCHULI.Image
End Sub

Private Sub D1_Click()
  PicBackup.Picture = PicMain.Image
  cx = PicMain.ScaleWidth
  cy = PicMain.ScaleHeight
  ReDim Arrycol(2, cx, cy)
  For i = 1 To cx
    For j = 1 To cy
      tmlcolor = GetPixel(FormMain.PicMain.hdc, i, j)
      r2 = tmlcolor Mod 256
      g2 = ((tmlcolor And &HFF00) / 256) Mod 256
      b2 = (tmlcolor And &HFF0000) / 65536
      Arrycol(0, i, j) = r2
      Arrycol(1, i, j) = g2
      Arrycol(2, i, j) = b2
    Next j
  Next i
  For i1 = 1 To cx
    For j1 = 1 To cy - 1
      r1 = Arrycol(0, i1, j1 + 1) - Arrycol(0, i1, j1) + 127
      g1 = Arrycol(1, i1, j1 + 1) - Arrycol(1, i1, j1) + 127
      b1 = Arrycol(2, i1, j1 + 1) - Arrycol(2, i1, j1) + 127
      If r1 > 255 Then r1 = 255
      If r1 < 0 Then r1 = 0
      If g1 > 255 Then g1 = 255
      If g1 < 0 Then g1 = 0
      If b1 > 255 Then b1 = 255
      If b1 < 0 Then b1 = 0
      PicMain.PSet (i1, j1), RGB(r1, g1, b1)
    Next j1
    Pg.value = i1 * 100 \ (cx - 1)
  Next i1
    Pg.value = 0
 End Sub

Private Sub D2_Click()
 PicBackup.Picture = PicMain.Image
  cx = PicMain.ScaleWidth
  cy = PicMain.ScaleHeight
  ReDim Arrycol(2, cx, cy)
  For i = 1 To cx
   For j = 1 To cy
     tmlcolor = GetPixel(FormMain.PicMain.hdc, i, j)           'Pixel& = frmFilters.Picture1.Point(j, i)
                                                               ' Red = Pixel& Mod 256
                                                               ' Green = ((Pixel& And &HFF00) / 256&) Mod 256&
                                                               ' Blue = (Pixel& And &HFF0000) / 65536
                                                               ' ImageArray(0, i, j) = Red
                                                               ' ImageArray(1, i, j) = Green
                                                               ' ImageArray(2, i, j) = Blue
     r2 = tmlcolor Mod 256
     g2 = ((tmlcolor And &HFF00) / 256) Mod 256
     b2 = (tmlcolor And &HFF0000) / 65536
     Arrycol(0, i, j) = r2
     Arrycol(1, i, j) = g2
     Arrycol(2, i, j) = b2
     Next j
  Next i
  For i1 = 2 To cx - 2
   For j1 = 2 To cy - 2
    r1 = (Arrycol(0, i1 - 1, j1 - 1) + Arrycol(0, i1 - 1, j1) + Arrycol(0, i1 - 1, j1 + 1) + Arrycol(0, i1, j1 - 1) + Arrycol(0, i1, j1) + Arrycol(0, i1, j1 + 1) + Arrycol(0, i1 + 1, j1 - 1) + Arrycol(0, i1 + 1, j1) + Arrycol(0, i1 + 1, j1 + 1)) / 9
    g1 = (Arrycol(1, i1 - 1, j1 - 1) + Arrycol(1, i1 - 1, j1) + Arrycol(1, i1 - 1, j1 + 1) + Arrycol(1, i1, j1 - 1) + Arrycol(1, i1, j1) + Arrycol(1, i1, j1 + 1) + Arrycol(1, i1 + 1, j1 - 1) + Arrycol(1, i1 + 1, j1) + Arrycol(1, i1 + 1, j1 + 1)) / 9
    b1 = (Arrycol(2, i1 - 1, j1 - 1) + Arrycol(2, i1 - 1, j1) + Arrycol(2, i1 - 1, j1 + 1) + Arrycol(2, i1, j1 - 1) + Arrycol(2, i1, j1) + Arrycol(2, i1, j1 + 1) + Arrycol(2, i1 + 1, j1 - 1) + Arrycol(2, i1 + 1, j1) + Arrycol(2, i1 + 1, j1 + 1)) / 9
    PicMain.PSet (i1, j1), RGB(r1, g1, b1)
                                                               'SetPixel FormMain.PicMain.hdc, i1, j1, RGB(r1, g1, b1)  '这个方法用不成,成功过一次，又忘记怎么做得了
   Next j1
   Pg.value = i1 * 100 \ (cx - 1)                              '改进
 Next i1
   Pg.value = 0
End Sub

Private Sub D3_Click()
 Alpha = 0.3
 cx = PicMain.ScaleWidth
 cy = PicMain.ScaleHeight
 ReDim Arrycol(2, cx, cy)
 For i = 1 To cx
   For j = 1 To cy
     tmlcolor = GetPixel(FormMain.PicMain.hdc, i, j)
     r2 = tmlcolor Mod 256
     g2 = ((tmlcolor And &HFF00) / 256) Mod 256
     b2 = (tmlcolor And &HFF0000) / 65536
     Arrycol(0, i, j) = r2
     Arrycol(1, i, j) = g2
     Arrycol(2, i, j) = b2
     Next j
  Next i
   For i1 = 2 To cx - 2
    For j1 = 2 To cy - 2
      Pjr = (Arrycol(0, i1 - 1, j1 - 1) + Arrycol(0, i1 - 1, j1) + Arrycol(0, i1 - 1, j1 + 1) + Arrycol(0, i1, j1 - 1) + Arrycol(0, i1, j1 + 1) + Arrycol(0, i1 + 1, j1 - 1) + Arrycol(0, i1 + 1, j1) + Arrycol(0, i1 + 1, j1 + 1)) / 8
      Delr1 = Arrycol(0, i1, j1) - Pjr
      Pjg = (Arrycol(1, i1 - 1, j1 - 1) + Arrycol(1, i1 - 1, j1) + Arrycol(1, i1 - 1, j1 + 1) + Arrycol(1, i1, j1 - 1) + Arrycol(1, i1, j1 + 1) + Arrycol(1, i1 + 1, j1 - 1) + Arrycol(1, i1 + 1, j1) + Arrycol(1, i1 + 1, j1 + 1)) / 8
      Delg1 = Arrycol(1, i1, j1) - Pjg
      Pjb = (Arrycol(2, i1 - 1, j1 - 1) + Arrycol(2, i1 - 1, j1) + Arrycol(2, i1 - 1, j1 + 1) + Arrycol(2, i1, j1 - 1) + Arrycol(2, i1, j1 + 1) + Arrycol(2, i1 + 1, j1 - 1) + Arrycol(2, i1 + 1, j1) + Arrycol(2, i1 + 1, j1 + 1)) / 8
      Delb1 = Arrycol(2, i1, j1) - Pjb
      Delr = Arrycol(0, i1, j1) + Delr1 * Alpha
      Delg = Arrycol(1, i1, j1) + Delg1 * Alpha
      Delb = Arrycol(2, i1, j1) + Delb1 * Alpha
      If Delr > 255 Then Delr = 255
      If Delr < 0 Then Delr = 0
      If Delg > 255 Then Delg = 255
      If Delg < 0 Then Delg = 0
      If Delb > 255 Then Delb = 255
      If Delb < 0 Then Delb = 0
       PicMain.PSet (i1, j1), RGB(Delr, Delg, Delb)
    Next j1
    Pg.value = i1 * 100 \ (cx - 1)
 Next i1
    Pg.value = 0
End Sub

Private Sub duibidu_Click()
Dim duibidu As Single
duibidu = InputBox("请输入一个恰当的数值", , -1, 0)
Dim tmlcolor As Long
Dim r As Long, g As Long, b As Long
Dim r1 As Long, g1 As Long, b1 As Long
Dim ArryColor() As Long
PicBackup.Picture = PicMain.Image
cx = PicMain.ScaleWidth
cy = PicMain.ScaleHeight
PicCHULI.Width = cx: PicCHULI.Height = cy
ReDim ArryColor(2, cx, cy)
For i = 0 To cx
   For j = 0 To cy
   tmlcolor = PicMain.Point(i, j)
    r = tmlcolor Mod 256
    g = ((tmlcolor And &HFF00) / 256) Mod 256
    b = (tmlcolor And &HFF0000) / 65536
   ArryColor(0, i, j) = r
   ArryColor(1, i, j) = g
   ArryColor(2, i, j) = b
   Next j
 Next i
 For i = 0 To cx
   For j = 0 To cy
   r1 = (ArryColor(0, i, j) - 127) * duibidu + 127
   g1 = (ArryColor(1, i, j) - 127) * duibidu + 127
   b1 = (ArryColor(2, i, j) - 127) * duibidu + 127
   If r1 > 255 Then r1 = 255
      If r1 < 0 Then r1 = 0
      If g1 > 255 Then g1 = 255
      If g1 < 0 Then g1 = 0
      If b1 > 255 Then b1 = 255
      If b1 < 0 Then b1 = 0
   PicCHULI.PSet (i, j), RGB(r1, g1, b1)
   Next j
 Next i
 PicMain.Picture = PicCHULI.Image
End Sub

Private Sub Exit_Click()
Dim value As Integer
value = MsgBox("真的要退出吗？", 36, "图形编辑小程序")
If value = 6 Then End
End Sub

Private Sub F_Click() '*****************************************这个功能没有成功
  Dim r, g, b As Single
  Dim r1, g1, b1 As Single
  Dim tmlcolor As Long
  cx = PicMain.ScaleWidth
  cy = PicMain.ScaleHeight
  ReDim Arrycol(2, cx, cy)
  For i = 1 To cx
   For j = 1 To cy
     tmlcolor = GetPixel(FormMain.PicMain.hdc, i, j)
     r = tmlcolor Mod 256
     g = ((tmlcolor And &HFF00) / 256) Mod 256
     b = (tmlcolor And &HFF0000) / 65536
     Arrycol(0, i, j) = r
     Arrycol(1, i, j) = g
     Arrycol(2, i, j) = b
     Next j
  Next i
  PicCHULI.Picture = LoadPicture("")
   For i1 = 2 To cx - 2
     For j1 = 2 To cy - 2
      r1 = Arrycol(0, i1, j2)
      g1 = Arrycol(1, i1, j2)
      b1 = Arrycol(2, i1, j2)
      PicCHULI.PSet (i1, j1), RGB(r1, g1, b1)
     Next j1
   Next i1
   PicMain.Picture = PicCHULI.Image
End Sub

Private Sub FCircle_Click()
 drawact = 3
End Sub

Private Sub Form_Load()
  DrawWide = 2
  Load FormToolsBox
  FormToolsBox.Show
  Me.Show
  name1 = "未命名"
  Me.Caption = "未命名"
  FormToolsBox.Top = Me.Top + 50 * 15
  FormToolsBox.Left = Me.Left + 500 * 15
  End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim tixing As VbMsgBoxResult
    tixing = MsgBox("是否保存当前正在编辑的文件", vbYesNoCancel, "是否保存")
If tixing = vbCancel Then
   End
   ElseIf tixing = vbYes Then
        Save1_Click
End If
End Sub

Private Sub FRect_Click()
  drawact = 5
End Sub

Private Sub g_Click()
FormHelp.Show
FormMain.Hide
FormHelp.RichTextBox1.LoadFile "e:\Help.txt"
End Sub

Private Sub h_Click()
Dim t As Integer, h As Integer
PicMain.Picture = LoadPicture("")
h = 0
t = 1
Do While Int(PicBackup.ScaleHeight) - 2 < h <= Int(PicBackup.ScaleHeight) + 2
  PicMain.PaintPicture PicBackup.Picture, 0, h, PicMain.ScaleWidth, t, 0, h, PicMain.ScaleWidth, t, vbSrcCopy
  h = h + 1
 For i = 0 To 100