鼠标绘图.frm

一个图象处理的小软件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmdraw 
   Caption         =   "Form2"
   ClientHeight    =   4935
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6915
   LinkTopic       =   "Form2"
   ScaleHeight     =   4935
   ScaleWidth      =   6915
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Pic1 
      Height          =   3615
      Left            =   2520
      ScaleHeight     =   3555
      ScaleWidth      =   4155
      TabIndex        =   17
      Top             =   360
      Width           =   4215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "结束画图"
      Height          =   375
      Index           =   2
      Left            =   5520
      TabIndex        =   16
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "保存画图"
      Height          =   375
      Index           =   1
      Left            =   4080
      TabIndex        =   15
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "清除画图"
      Height          =   375
      Index           =   0
      Left            =   2640
      TabIndex        =   14
      Top             =   4200
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog Cmdlg2 
      Left            =   2640
      Top             =   4560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame2 
      Caption         =   "画线颜色"
      Height          =   2175
      Left            =   120
      TabIndex        =   5
      Top             =   2640
      Width           =   2295
      Begin VB.OptionButton Option1 
         Caption         =   "白"
         Height          =   255
         Index           =   11
         Left            =   1440
         TabIndex        =   13
         Top             =   1680
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "蓝"
         Height          =   255
         Index           =   10
         Left            =   1440
         TabIndex        =   12
         Top             =   1320
         Width           =   615
      End
      Begin VB.OptionButton Option1 
         Caption         =   "黄"
         Height          =   255
         Index           =   9
         Left            =   240
         TabIndex        =   11
         Top             =   1680
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "绿"
         Height          =   255
         Index           =   8
         Left            =   240
         TabIndex        =   10
         Top             =   1320
         Width           =   615
      End
      Begin VB.OptionButton Option1 
         Caption         =   "紫"
         Height          =   255
         Index           =   7
         Left            =   1440
         TabIndex        =   9
         Top             =   840
         Width           =   855
      End
      Begin VB.OptionButton Option1 
         Caption         =   "红"
         Height          =   255
         Index           =   6
         Left            =   240
         TabIndex        =   8
         Top             =   840
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "青"
         Height          =   255
         Index           =   5
         Left            =   1440
         TabIndex        =   7
         Top             =   360
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "黑"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   6
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.OptionButton Option1 
      Caption         =   "自由曲线"
      Height          =   255
      Index           =   3
      Left            =   360
      TabIndex        =   4
      Top             =   1800
      Width           =   1215
   End
   Begin VB.OptionButton Option1 
      Caption         =   "圆　"
      Height          =   255
      Index           =   2
      Left            =   360
      TabIndex        =   3
      Top             =   1320
      Width           =   975
   End
   Begin VB.OptionButton Option1 
      Caption         =   "长方形"
      Height          =   255
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   960
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Caption         =   "画线方式"
      Height          =   2175
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   2295
      Begin VB.OptionButton Option1 
         Caption         =   "直线"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   735
      End
   End
End
Attribute VB_Name = "frmdraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click(index As Integer)
Select Case index
Case 0
'清除画图
Pic1.Cls
Case 1
'以bmp格式保存画图
On Error Resume Next
Cmdlg2.DialogTitle = "保存位图"
Cmdlg2.Filter = "picture(*.bmp)|*.bmp"
Cmdlg2.FileName = "untitled1"
Cmdlg2.ShowSave
If Cmdlg2.FileName <> "" Then
If Err <> 32755 Then
Dim savepicname As String
savepicname = Cmdlg1.FileName
SavePicture Pic1.Image, savepicname
End If
End If
Case 2
Unload Me
End Select
End Sub

Private Sub Form_Load()
Dim cx As Integer, cy As Integer
Dim cx0 As Integer, cy0 As Integer
Dim hxfs As Integer '画线方式
Dim flag1 As Integer
Dim flag2 As Integer
Pic1.BackColor = QBColor(15)
End Sub
'鼠标事件
Private Sub pic1_mousedown(button As Integer, shift As Integer, x As Single, y As Single)
Dim r As Integer
If button = vbRightButton Then
If flag1 = 0 Then
flag1 = 0
cx = 0
cy = 0
Exit Sub
End If
Else
If flag1 = 0 Then
flag1 = 1
If tool = 4 Then
flag2 = 1
End If
cx0 = x
cy0 = y
Else
Select Case tool
Case 1
cx = x
cy = y
Pic1.Line (cx0, cy0)-(cx, cy)
cx0 = cx
cy0 = cy
Case 2
cx = x
cy = y
Pic1.Line (cx0, cy0)-(cx, cy), , B
flag1 = 0
Case 3
cx = x
cy = y
r = Sqr(Abs(cx - cx0) ^ 2 + Abs(cy - cy0) ^ 2)
Pic1.Circle (cx0, cy0), r
flag1 = 0
Case 4
flag2 = 1
End Select
End If
End If
End Sub
Private Sub pic1_mousemove(botton As Integer, shift As Integer, x As Single, y As Single)
If flag2 = 0 Then
Exit Sub
Else
cx = x
cy = y
Pic1.Line (cx0, cy0)-(cx, cy)
cx0 = cx
cy0 = cy
End If
End Sub
Private Sub pic1_mouseup(button As Integer, shift As Integer, x As Single, y As Single)
flag2 = 0
If tool = 4 Then
flag1 = 0
cx = 0
cy = 0
End If
End Sub



Private Sub Option1_Click(index As Integer)
Select Case index
Case 0
hxfx = 1
flag1 = 0
flag = 0
Case 1
hxfx = 2
flag1 = 0
flag2 = 0
Case 2
hxfx = 3
flag1 = 0
flag2 = 0
Case 3
hxfx = 4
flag1 = 0
flag2 = 0
Case 4
Pic1.ForeColor = QBColor(0)
Case 5
Pic1.ForeColor = QBColor(12)
Case 6
Pic1.ForeColor = QBColor(10)
Case 7
Pic1.ForeColor = QBColor(14)
Case 8
Pic1.ForeColor = QBColor(9)
Case 9
Pic1.ForeColor = QBColor(13)
Case 10
Pic1.ForeColor = QBColor(11)
Case 11
Pic1.ForeColor = QBColor(15)
End Select
End Sub