画图板.frm

基于Visual Basic 6.0的画图板设计

         Index           =   3
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   23
         Top             =   1800
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "画矩形"
         Height          =   375
         Index           =   2
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   22
         Top             =   1320
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "画圆"
         Height          =   375
         Index           =   1
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   21
         Top             =   840
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         Caption         =   "画直线"
         Height          =   375
         Index           =   0
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   20
         Top             =   360
         Width           =   735
      End
   End
   Begin VB.Image Image2 
      Height          =   480
      Left            =   7920
      Picture         =   "画图板.frx":0000
      Top             =   5880
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   0
      Picture         =   "画图板.frx":0442
      Top             =   0
      Width           =   480
   End
   Begin VB.Menu MENUFILE 
      Caption         =   "文件"
      Begin VB.Menu NEW 
         Caption         =   "新建"
      End
      Begin VB.Menu BAR1 
         Caption         =   "-"
      End
      Begin VB.Menu OPEN 
         Caption         =   "打开"
      End
   End
   Begin VB.Menu MENUSAVE 
      Caption         =   "保存"
      Begin VB.Menu SAVE 
         Caption         =   "保存"
      End
      Begin VB.Menu BAR2 
         Caption         =   "-"
      End
      Begin VB.Menu ASSAVE 
         Caption         =   "另存为"
      End
   End
   Begin VB.Menu MENUPRINT 
      Caption         =   "打印"
      Begin VB.Menu PRINT 
         Caption         =   "打印图形"
      End
   End
   Begin VB.Menu MENUHELP 
      Caption         =   "帮助"
      Begin VB.Menu ABOUT 
         Caption         =   "关于“画图板”"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
Dim DrawState As Boolean '定义逻辑型变量作为画图状态标志
Dim PreX As Single '画线起点坐标
Dim PreY As Single
Dim x1 As Single, x2 As Single, y1 As Single, y2 As Single '存画图坐标
Dim DrawLineWidth%




Private Sub Form_Load()
For i = 0 To 15
Label1(i).BackColor = QBColor(i)
Next i
Label2.BackColor = QBColor(0)
DrawState = False '画图状态标志初始化为False
Image1.Visible = False '隐藏带有图标的图像框
Option1(0).Value = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture2.Line (0, 300)-(900, 300)
Option2(0).Value = True
End Sub

Private Sub Label1_Click(Index As Integer)
Label2.BackColor = QBColor(Index)
End Sub



Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0
 Picture2.Cls
 Picture2.Line (0, 300)-(900, 300)
 Case 1
 Picture2.Cls
 Picture2.Circle (400, 300), 300
Case 2
 Picture2.Cls
 Picture2.Line (100, 100)-(700, 550), , B
Case 3
 Picture2.Cls
 Picture2.Circle (400, 300), 300, , , , 0.5
Case 4
 Picture2.Cls
 Picture2.Line (0, 300)-(150, 100)
 Picture2.Line -(300, 500)
 Picture2.Line -(450, 100)
 Picture2.Line -(600, 300)
End Select
End Sub

Private Sub Option2_Click(Index As Integer)
Select Case Index
Case 0
DrawLineWidth = 1
Case 1
DrawLineWidth = 3
Case 2
DrawLineWidth = 6
Case 3
DrawLineWidth = 10
End Select
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Radius
    DrawState = True '设置画图状态，设DrawState为True，
    If Button = 1 And Option1(4).Value = True Then
        '按下鼠标左键时，表示开始画线
        Picture1.MousePointer = vbCustom '将鼠标指针类型设为用户指定样式
        Picture1.MouseIcon = Image1.Picture '将图像框中的图案作为鼠标指针图标
        'PreX和PreY保存线条起点。
        '修改X、Y的值是为了保证画线恰好在笔尖下,
        '修正值根据图标大小作调整。
        PreX = x - 200
        PreY = y + 180
    End If
        '保存开始画图时的坐标
        x1 = x: y1 = y: x2 = x: y2 = y
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Radius
    x2 = x: y2 = y
    Picture1.DrawWidth = DrawLineWidth
    If DrawState = True And Option1(0).Value = True And Button = 1 Then
            Picture1.AutoRedraw = False '为清除做准备
            Picture1.Cls
            Picture1.Line (x1, y1)-(x2, y2), Label2.BackColor
    End If
    If DrawState = True And Option1(1).Value = True And Button = 1 Then
            Picture1.AutoRedraw = False '为清除做准备
            Picture1.Cls
            Picture1.Circle (x1, y1), Abs(x - x1), Label2.BackColor  '画圆
    End If
    If DrawState = True And Option1(2).Value = True And Button = 1 Then
            Picture1.AutoRedraw = False '为清除做准备
            Picture1.Cls
            Picture1.Line (x1, y1)-(x2, y2), Label2.BackColor, B
    End If
    If DrawState = True And Option1(3).Value = True And Button = 1 Then
            Picture1.AutoRedraw = False '为清除做准备
            Picture1.Cls
            'Picture1.Circle (x1, y1), Abs(x - x1), Label2.BackColor, , , 0.5 '画椭圆
            x2 = Abs(x - x1) + 0.0001
            y2 = Abs(y - y1) + 0.0001
            Aspect = y2 / x2            '设置椭圆纵横比
            If x2 > y2 Then             '设置半径
                Radius = x2
            Else
                Radius = y2
            End If
            Picture1.Circle (x1, y1), Radius, , , , Aspect '画椭圆
    End If
    If DrawState = True And Option1(4).Value = True And Button = 1 Then
            Picture1.Line (PreX, PreY)-(x - 200, y + 180), Label2.BackColor
            PreX = x - 200
            PreY = y + 180
    End If
    If DrawState = True And Option1(5).Value = True And Button = 1 Then
            Picture1.MousePointer = vbCustom '将鼠标指针类型设为用户指定样式
            Picture1.MouseIcon = Image2.Picture
            Picture1.DrawWidth = 8
            Picture1.Line (x1, y1)-(x, y), vbWhite
            x1 = x
            y1 = y
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Picture1.AutoRedraw = True
    Picture1.DrawWidth = DrawLineWidth
    If DrawState = True And Option1(0).Value = True And Button = 1 Then
             Picture1.Line (x1, y1)-(x2, y2), Label2.BackColor
    End If
    If DrawState = True And Option1(1).Value = True And Button = 1 Then
            Picture1.Circle (x1, y1), Abs(x - x1), Label2.BackColor   '画圆
    End If
    If DrawState = True And Option1(2).Value = True And Button = 1 Then
            Picture1.Line (x1, y1)-(x2, y2), Label2.BackColor, B
    End If
    If DrawState = True And Option1(3).Value = True And Button = 1 Then
            'Picture1.Circle (x1, y1), Abs(x - x1), Label2.BackColor, , , 0.5 '画椭圆
            x2 = Abs(x - x1) + 0.0001
            y2 = Abs(y - y1) + 0.0001
            Aspect = y2 / x2            '设置椭圆纵横比
            If x2 > y2 Then             '设置半径
                Radius = x2
            Else
                Radius = y2
            End If
            Picture1.Circle (x1, y1), Radius, Label2.BackColor, , , Aspect '画椭圆
    End If
    Picture1.MousePointer = vbDefault '释放鼠标键，指针恢复原样
    DrawState = False '解除画图状态
End Sub

Private Sub New_Click()
    Picture1.Cls
End Sub

Private Sub Open_Click()
            Picture1.Cls
            Picture1.MousePointer = 0
            CommonDialog1.InitDir = App.Path '设置初始路径
            CommonDialog1.FileName = "" '清除文件名
            CommonDialog1.ShowOpen '显示“打开”对话框
            FileName = CommonDialog1.FileName '保存文件名
            If Len(CommonDialog1.FileName) > 0 Then
            Picture1.Picture = LoadPicture(CommonDialog1.FileName)
            End If
End Sub
Private Sub Print_Click()
    Printer.PaintPicture Picture1.Picture, 0, 4000
End Sub

Private Sub Save_Click()
        CommonDialog1.InitDir = App.Path '设置初始路径
        CommonDialog1.FileName = "" '初始化文件名
        CommonDialog1.Filter = "位图文件(*.bmp)|*.bmp|图标文件(*.ico)|*.ico|所有文件(*.*)|*.*"
        CommonDialog1.ShowSave
    If Len(CommonDialog1.FileName) > 0 Then
        SavePicture Picture1.Image, CommonDialog1.FileName
    End If
End Sub

Private Sub AsSave_Click()
    Dim File As Integer
    CommonDialog1.InitDir = App.Path '设置初始路径
    CommonDialog1.FileName = "" '初始化文件名
    CommonDialog1.Filter = "位图文件(*.bmp)|*.bmp|图标文件(*.ico)|*.ico|所有文件(*.*)|*.*"
    CommonDialog1.ShowSave
    If Len(CommonDialog1.FileName) > 0 Then
    SavePicture Picture1.Image, CommonDialog1.FileName
    End If
End Sub
Private Sub About_Click()
'点击About键发生
    MsgBox "VB课程设计实例" + Chr$(13) + Chr$(10) + "——画图程序" + Chr$(13) + Chr$(10) + "     2007.7.", 0
End Sub