formmain.txt

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

           PicMain.Line (x0, y0)-(xnow, ynow), Not (PicMain.ForeColor), BF
           PicMain.Line (x0, y0)-(X, Y), Not (PicMain.ForeColor), BF
           xnow = X: ynow = Y
        End If
        '空心矩形
        Case 6
        If canrect And Button = 1 Then
            PicMain.Line (x0, y0)-(xnow, ynow), Not (PicMain.ForeColor), B
            PicMain.Line (x0, y0)-(X, Y), Not (PicMain.ForeColor), B
            xnow = X: ynow = Y
        End If
        '多边形
        Case 7
        If canpolo And Button = 1 Then
        End If
        '橡皮
        Case 8
        If canrubber And Button = 1 Then
           PicMain.Line -(X, Y), vbWhite
        End If
       '刷子
       Case 9
       If canbrush And Button = 1 Then
           PicMain.Line -(X, Y), PicMain.ForeColor
       End If
       '油漆桶
        Case 10
         'do  nothing
       Case 12    '因为选定和别的不同，所以应该Button=1
         PicMain.DrawStyle = 2
         If Xuanding = True And Button = 1 Then
         PicMain.Line (x11, y11)-(xnow11, ynow11), Not (PicMain.ForeColor), B
         PicMain.Line (x11, y11)-(X, Y), Not (PicMain.ForeColor), B
         xnow11 = X: ynow11 = Y
        End If
    End Select
End Sub


Private Sub PicMain_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Select Case drawact
         '铅笔
         Case 1
         canpen = False
         '直线
         Case 2
         canline = False
         PicMain.Line (x0, y0)-(xnow, ynow)
         PicMain.DrawMode = 13
         PicMain.Line (x0, y0)-(xnow, ynow), PicMain.ForeColor
         '实心圆
         Case 3
         canfcircle = False
         PicMain.Circle (x0, y0), radius, Not (PicMain.ForeColor)
         PicMain.DrawMode = 13
         PicMain.Circle (x0, y0), radius, PicMain.ForeColor
        '空心圆
         Case 4
         cancircle = False
         PicMain.Circle (x0, y0), radius, Not (PicMain.ForeColor)
         PicMain.DrawMode = 13
         PicMain.Circle (x0, y0), radius, PicMain.ForeColor
         '实心矩形
         Case 5
         canfrect = False
         PicMain.Line (x0, y0)-(xnow, ynow), Not (PicMain.ForeColor), BF
         PicMain.DrawMode = 13
         PicMain.Line (x0, y0)-(xnow, ynow), PicMain.ForeColor, BF
         '空心矩形
         Case 6
         canrect = False
         PicMain.Line (x0, y0)-(xnow, ynow), PicMain.ForeColor, B
         PicMain.DrawMode = 13
         PicMain.Line (x0, y0)-(xnow, ynow), PicMain.ForeColor, B
         '多边形
         Case 7
          Times = Times + 1
          If Times = 2 Then
           PicMain.Line (X, Y)-(px, py), PicMain.ForeColor
          End If
          px1 = X: py1 = Y
         '橡皮
         Case 8
         canrubber = False
         '刷子
         Case 9
         canbrush = False
         '油漆桶
         Case 10
         canyouqi = False
         Case 11
         '选定
         Case 12
         Xuanding = False
         PicMain.DrawStyle = 2
         PicMain.Line (x11, y11)-(xnow11, ynow11), Not (PicMain.ForeColor), B
         PicMain.DrawMode = 13
         PicMain.Line (x11, y11)-(xnow11, ynow11), PicMain.ForeColor, B
         xxnow11 = X: yynow11 = Y
  End Select
  If move1 = True Then
    PicBackup.Picture = PicMain.Image
    x22 = X: y22 = Y
    PicMain.PaintPicture PicMain.Picture, x22, y22, Abs(xnow11 - x11), Abs(ynow11 - y11), x11, y11, Abs(xnow11 - x11), Abs(ynow11 - y11), vbSrcCopy
    move1 = False
 End If
End Sub



Private Sub ping_Click()
  Dim ping1 As Long
  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)
     r = tmlcolor Mod 256
     g = ((tmlcolor And &HFF00) / 256) Mod 256
     b = (tmlcolor And &HFF0000) / 65536
     ping1 = (r + g + b) / 3
     Arrycol(0, i, j) = ping1
     Arrycol(1, i, j) = ping1
     Arrycol(2, i, j) = ping1
     Next j
  Next i
  For i1 = 0 To cx - 1
     For j1 = 0 To cy - 1
    r1 = Arrycol(0, i1, j1)
    g1 = Arrycol(1, i1, j1)
    b1 = Arrycol(2, i1, j1)
     PicMain.PSet (i1, j1), RGB(r1, g1, b1)
    Next j1
  Next i1
End Sub

Private Sub Polo_Click()
drawact = 7
End Sub

Private Sub Print_Click()
  FormPrint.Show
End Sub

Private Sub S1_Click()

End Sub



Private Sub Property_Click()
FormProperty.Show
FormProperty.Text1.Text = FormMain.PicMain.ScaleWidth
FormProperty.Text2.Text = FormMain.PicMain.ScaleHeight
FormProperty.Option3 = True
End Sub

Private Sub Q_Click()
PicMain.Cls
End Sub

Private Sub Rect_Click()
drawact = 6
End Sub

Private Sub Red_Click()

End Sub

Private Sub Rubber_Click()
drawact = 8
End Sub

Private Sub S_Click(Index As Integer)                                '说明为一个按控件数组
  Dim bhor As Boolean                                                '在原程序中一定要定义成全局变量，要不然，每当推出菜单这个之就要发生变化。
                                                                     '经过该改正的程序必须定义成局部变量
  Dim bVert As Boolean
  Call PreFlip                                                       'PreFlip保存了现在PicMain的图像，和PicTemp没有关系
  Select Case Index
        Case 0
            bhor = Not bhor                                          'horizon,我们可以设bhor,bVert初值为０
        Case 1
            bVert = Not bVert
    End Select
 
  Dim Picture As StdPicture
  Set Picture = FormMain.PicFlip.Picture
    If bhor And bVert Then
        PicBackup.Picture = PicMain.Image
        PicMain.PaintPicture Picture, PicMain.Width, PicMain.Height, _
        PicFlip.Width * (-1), PicFlip.Height * (-1)                   '图像及垂直翻转又水平翻转
    ElseIf bhor And Not bVert Then
        PicBackup.Picture = PicMain.Image
        PicMain.PaintPicture Picture, PicMain.Width, 0, _
        PicFlip.Width * (-1), PicFlip.Height                           '图像水平翻转
    ElseIf Not bhor And bVert Then
        PicBackup.Picture = PicMain.Image
        PicMain.PaintPicture Picture, 0, PicMain.Height, _
            PicFlip.Width, PicFlip.Height * (-1)                       '图像垂直翻转
    Else
        PicBackup.Picture = PicMain.Image
        PicMain.PaintPicture Picture, 0, 0                             '图像按原来的图形载入
    End If
End Sub


Private Sub Save_Click()
If name1 = "未命名" Then
    Me.ComDiag.ShowSave
    ComDiag.Filter = "IMAGE|*.gif;*.jpg;*.bmp;*.ico"
   If Me.ComDiag.FileName <> "" And Me.ComDiag.FileName <> name1 Then
       name1 = Me.ComDiag.FileName
       SavePicture Me.PicMain.Image, name1
   End If
Else
   SavePicture Me.PicMain.Image, name1
End If
End Sub

Private Sub Save1_Click()
    Dim SFName As String
    Dim value As Integer
    ComDiag.Filter = "IMAGE|*.gif;*.jpg;*.bmp;*.ico"
    Me.ComDiag.ShowSave
    SFName = ComDiag.FileName
   If FileExist(SFName) Then
       value = MsgBox("这个文件名已经存在,你想替换吗？", 36, "提醒")
     If value = vbYes Then
        Save_Click
     End If
  End If
End Sub

Private Sub Timer1_Timer()

End Sub

Private Sub Undo_Click()
PicMain.Picture = PicBackup.Picture
End Sub

Private Sub V_Click()
  PicBackup.Picture = PicMain.Image
  PicMain.Picture = PicBaocun.Image
End Sub

Private Sub X_Click()
Dim DWidth As Single
Dim DHeight As Single
PicZoom.Cls
PicBackup.Picture = PicMain.Image
DWidth = PicBackup.Width * 0.5
DHeight = PicBackup.Height * 0.5
PicZoom.Width = DWidth
PicZoom.Height = DHeight
PicZoom.PaintPicture PicBackup.Picture, 0, 0, DWidth, DHeight
PicMain.Picture = PicZoom.Image                                    'PicZoom中保存了改变大小后的图像
End Sub

Private Sub XZ_Click()
Dim Angle As Integer
Dim x3 As Integer, y3 As Integer
Dim X1 As Double, y1 As Double
Dim xx As Double, yy As Double
Dim Radian As Double
Dim ccx1 As Single, ccy1 As Single                                  '记录现在的PicMain中的图像的宽度，高度
Angle = InputBox("请输入一个0-359的整数", , 90, 0)
Radian = Angle * Pi / 180                                            '把输入的值转化为另外一种表示方法
PicMain.ScaleMode = vbPixels
ccx1 = PicMain.ScaleWidth: ccy1 = PicMain.ScaleHeight
PicFlip.ScaleMode = vbPixels
PicFlip.Picture = LoadPicture("")
PicFlip.Width = Sqr(ccx1 ^ 2 + ccy1 ^ 2)
PicFlip.Height = Sqr(ccx1 ^ 2 + ccy1 ^ 2)
 For x3 = 0 To PicFlip.ScaleWidth
     X1 = x3 - PicFlip.ScaleWidth \ 2
     For y3 = 0 To PicFlip.ScaleHeight
        y1 = y3 - PicFlip.ScaleHeight \ 2
        xx = X1 * Cos(-Radian) - y1 * Sin(-Radian)
        yy = y1 * Cos(-Radian) + X1 * Sin(-Radian)
        PicFlip.PSet (x3, y3), PicMain.Point(CInt(xx) + PicMain.ScaleWidth \ 2, CInt(yy) + PicMain.ScaleHeight \ 2)
     Next y3
     DoEvents
 Next x3
 PicMain.Picture = PicFlip.Image
End Sub
'For x3 = 0 To PicMain.ScaleWidth                                   ***********************************这种算法有一定的缺陷
'   x1 = x3 - PicMain.ScaleWidth \ 2                                图像以图像的中心逆时针旋转(PicMain.ScaleWidth \ 2,PicMain.ScaleHeight \ 2)中心的坐标
'   For y3 = 0 To PicMain.ScaleHeight
'     y1 = y3 - PicMain.ScaleHeight \ 2                             图像以图像的中心逆时针旋转
'     xx = X1 * Cos(Radian) - y1 * Sin(Radian)                      旋转矩阵
'     yy = y1 * Cos(Radian) + X1 * Sin(Radian)                      旋转矩阵
'     PicUndo.PSet (xx + PicUndo.ScaleWidth \ 2, yy + PicUndo.ScaleHeight \ 2), PicMain.Point(x3, y3)
'     Next y3
'   DoEvents
'   Next x3
' PicMain.Picture = PicUndo.Image
'End Sub
Private Sub Youqi_Click()
drawact = 10
End Sub

Private Sub zuida_Click()
  Dim Max As Long
  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
     Max = r2
     If g > Max Then
      Max = g2
     End If
     If b2 > Max Then
     End If
     Arrycol(0, i, j) = Max
     Arrycol(1, i, j) = Max
     Arrycol(2, i, j) = Max
     Next j
  Next i
  For i1 = 0 To cx - 1
     For j1 = 0 To cy - 1
    r1 = Arrycol(0, i1, j1)
    g1 = Arrycol(1, i1, j1)
    b1 = Arrycol(2, i1, j1)
     PicMain.PSet (i1, j1), RGB(r1, g1, b1)
    Next j1
  Next i1
End Sub
Private Sub NewFile()
 name1 = "未命名"
 Me.ComDiag.FileName = name1
 FormMain.Cls
 Label1.Visible = True
 Pg.Visible = True
 PicFCol.Visible = True
 PicMain.Picture = PicNew.Picture
 Me.Caption = "未命名"
 PicMain.Width = 321
 PicMain.Height = 257
End Sub