Mastering Visual Basic 6/mastvb6.iso/ch_code/ch06/draw/draw.frm

Visual Basic Form | 1998-02-20 | 12.9 KB | 420 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form DrawForm
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   Caption         =   "Draw"
   ClientHeight    =   4200
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6705
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H000000FF&
   LinkTopic       =   "Form1"
   ScaleHeight     =   4200
   ScaleWidth      =   6705
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture1
      AutoRedraw      =   -1  'True
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2535
      Left            =   4320
      ScaleHeight     =   2475
      ScaleWidth      =   1515
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   1575
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   315
      Top             =   165
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FontSize        =   2.54052e-29
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   3600
      TabIndex        =   1
      Top             =   240
      Visible         =   0   'False
      Width           =   60
   End
   Begin VB.Menu FileMenu
      Caption         =   "File"
      Begin VB.Menu FileNew
         Caption         =   "New"
      End
      Begin VB.Menu FileOpen
         Caption         =   "Open"
      End
      Begin VB.Menu FileSave
         Caption         =   "Save"
      End
      Begin VB.Menu FileSaveAs
         Caption         =   "Save As"
      End
      Begin VB.Menu FileExit
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu EditMenu
      Caption         =   "Edit"
      Begin VB.Menu EditCopy
         Caption         =   "Copy"
      End
      Begin VB.Menu EditCut
         Caption         =   "Cut"
      End
      Begin VB.Menu EditPaste
         Caption         =   "Paste"
      End
      Begin VB.Menu EditClear
         Caption         =   "Clear"
      End
   End
   Begin VB.Menu ShapeMenu
      Caption         =   "Shape"
      Begin VB.Menu DrawLine
         Caption         =   "Line"
      End
      Begin VB.Menu DrawCircle
         Caption         =   "Circle"
      End
      Begin VB.Menu DrawBox
         Caption         =   "Box"
      End
      Begin VB.Menu DrawText
         Caption         =   "Text"
      End
   End
   Begin VB.Menu WidthMenu
      Caption         =   "Width"
      Begin VB.Menu width1
         Caption         =   "1 pixel"
      End
      Begin VB.Menu Width2
         Caption         =   "2 pixels"
      End
      Begin VB.Menu Width3
         Caption         =   "3 pixels"
      End
   End
   Begin VB.Menu StyleMenu
      Caption         =   "DrawStyle"
      Begin VB.Menu StyleSolid
         Caption         =   "Solid"
      End
      Begin VB.Menu StyleDash
         Caption         =   "Dash"
      End
      Begin VB.Menu StyleDot
         Caption         =   "Dot"
      End
      Begin VB.Menu menuSeparator
         Caption         =   "-"
      End
      Begin VB.Menu StyleFilled
         Caption         =   "Solid Shape"
      End
   End
   Begin VB.Menu ColorMenu
      Caption         =   "Colors"
      Begin VB.Menu ColorPage
         Caption         =   "Page Color"
      End
      Begin VB.Menu ColorPen
         Caption         =   "Pen Color"
      End
      Begin VB.Menu ColorFill
         Caption         =   "Fill Color"
      End
   End
Attribute VB_Name = "DrawForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Shape As String
Dim XStart, YStart As Single
Dim XPrevious, YPrevious As Single
Dim CopyBMP, PasteBMP, CutBMP, PrintText As Integer
Dim PDrawWidth, PDrawStyle, PFillStyle As Integer
Dim CopyWidth, CopyHeight As Integer
Dim XLabel, YLabel As Integer
Dim OpenFile As String
Private Sub UnCheckStyles()
    StyleSolid.Checked = False
    StyleDash.Checked = False
    StyleDot.Checked = False
End Sub
Private Sub ColorFill_Click()
    CommonDialog1.Color = DrawForm.FillColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    DrawForm.FillColor = CommonDialog1.Color
End Sub
Private Sub ColorPage_Click()
    CommonDialog1.Color = DrawForm.BackColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    DrawForm.BackColor = CommonDialog1.Color
End Sub
Private Sub ColorPen_Click()
    CommonDialog1.Color = DrawForm.ForeColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    DrawForm.ForeColor = CommonDialog1.Color
End Sub
Private Sub DrawBox_Click()
    Shape = "BOX"
End Sub
Private Sub DrawCircle_Click()
    Shape = "CIRCLE"
End Sub
Private Sub DrawLine_Click()
    Shape = "LINE"
End Sub
Private Sub DrawText_Click()
Dim DrawString As String
    DrawString = InputBox("Enter string")
    Label1.Caption = DrawString
    PrintText = True
End Sub
Private Sub EditClear_Click()
    DrawForm.Cls
End Sub
Private Sub EditCopy_Click()
    CopyBMP = True
End Sub
Private Sub EditCut_Click()
    CutBMP = True
End Sub
Private Sub EditPaste_Click()
    PasteBMP = True
End Sub
Private Sub FileExit_Click()
    End
End Sub
Private Sub FileNew_Click()
    DrawForm.Picture = LoadPicture()
    OpenFile = ""
End Sub
Private Sub FileOpen_Click()
    CommonDialog1.Filter = "Images|*.bmp;*.gif;*.jpg"
    CommonDialog1.DefaultExt = "BMP"
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName = "" Then Exit Sub
    DrawForm.Picture = LoadPicture(CommonDialog1.FileName)
    OpenFile = CommonDialog1.FileName
    Shape = ""
End Sub
Private Sub FileSave_Click()
    If OpenFile <> "" Then
        SavePicture Image, OpenFile
    End If
End Sub
Private Sub FileSaveAs_Click()
    CommonDialog1.Filter = "Images|*.bmp"
    CommonDialog1.DefaultExt = "BMP"
    CommonDialog1.ShowSave
    If CommonDialog1.FileName = "" Then Exit Sub
    SavePicture DrawForm.Image, CommonDialog1.FileName
    OpenFile = CommonDialog1.FileName
End Sub
Private Sub Form_Load()
    CopyBMP = False
    PasteBMP = False
    PrintText = False
    XPrevious = -9999
    YPrevious = -9999
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then Shape = ""
    If Button = 1 Then
        XStart = X
        YStart = Y
        XPrevious = XStart
        YPrevious = YStart
        DrawForm.DrawMode = 7
    End If
    If CopyBMP Or CutBMP Then
        PDrawWidth = DrawForm.DrawWidth
        PDrawStyle = DrawForm.DrawStyle
        PFillStyle = DrawForm.FillStyle
        DrawForm.DrawWidth = 1
        DrawForm.DrawStyle = 0
        DrawForm.FillStyle = 1
    End If
    If PasteBMP Then
        DrawForm.PaintPicture Picture1.Image, X, Y, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &H660046
        XPrevious = X
        YPrevious = Y
        Exit Sub
    End If
    If PrintText Then
        Label1.ForeColor = DrawForm.ForeColor
        Label1.Visible = True
        Label1.Left = X
        Label1.Top = Y
        Exit Sub
    End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> 1 Then Exit Sub
    If CopyBMP Or CutBMP Then
        DrawForm.Line (XStart, YStart)-(XPrevious, YPrevious), , B
        DrawForm.Line (XStart, YStart)-(X, Y), , B
        XPrevious = X
        YPrevious = Y
        Exit Sub
    End If
    If PasteBMP Then
        DrawForm.PaintPicture Picture1.Image, XPrevious, YPrevious, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &H660046
        DrawForm.PaintPicture Picture1.Image, X, Y, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &H660046
        XPrevious = X
        YPrevious = Y
        Exit Sub
    End If
    If PrintText Then
        Label1.Left = X
        Label1.Top = Y
        Exit Sub
    End If
    Select Case Shape
        Case "LINE":
            DrawForm.Line (XStart, YStart)-(XPrevious, YPrevious)
            DrawForm.Line (XStart, YStart)-(X, Y)
        Case "CIRCLE":
            DrawForm.Circle (XStart, YStart), Sqr((XPrevious - XStart) ^ 2 + (YPrevious - YStart) ^ 2)
            DrawForm.Circle (XStart, YStart), Sqr((X - XStart) ^ 2 + (Y - YStart) ^ 2)
        Case "BOX":
            DrawForm.Line (XStart, YStart)-(XPrevious, YPrevious), , B
            DrawForm.Line (XStart, YStart)-(X, Y), , B
    End Select
    XPrevious = X
    YPrevious = Y

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim X1, Y1
Dim oldDrawMode
    If CopyBMP Then
        DrawForm.Line (XStart, YStart)-(XPrevious, YPrevious), , B
        If X > XStart Then X1 = XStart Else X1 = X
        If Y > YStart Then Y1 = YStart Else Y1 = Y
        Picture1.PaintPicture DrawForm.Image, 0, 0, Abs(X - XStart), Abs(Y - YStart), X1, Y1, Abs(X - XStart), Abs(Y - YStart), &HCC0020
        CopyBMP = False
        DrawForm.DrawWidth = PDrawWidth
        DrawForm.DrawStyle = PDrawStyle
        DrawForm.FillStyle = PFillStyle
        CopyWidth = Abs(X - XStart)
        CopyHeight = Abs(Y - YStart)
        Exit Sub
    End If
    If CutBMP Then
        oldDrawMode = DrawForm.DrawMode
        DrawForm.DrawMode = 13
        CopyWidth = XStart - X
        CopyHeight = YStart - Y
        If X > XStart Then X1 = XStart Else X1 = X
        If Y > YStart Then Y1 = YStart Else Y1 = Y
        Picture1.PaintPicture DrawForm.Image, 0, 0, Abs(X - XStart), Abs(Y - YStart), X1, Y1, Abs(X - XStart), Abs(Y - YStart), &HCC0020
        DrawForm.Line (X, Y)-Step(CopyWidth, CopyHeight), DrawForm.BackColor, BF
        CutBMP = False
        DrawForm.DrawWidth = PDrawWidth
        DrawForm.DrawStyle = PDrawStyle
        DrawForm.FillStyle = PFillStyle
        DrawForm.DrawMode = oldDrawMode
        CopyWidth = Abs(X - XStart)
        CopyHeight = Abs(Y - YStart)

        Exit Sub
    End If
    If PasteBMP Then
        DrawForm.PaintPicture Picture1.Image, X, Y, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &HCC0020
        PasteBMP = False
        Exit Sub
    End If
    If PrintText Then
        DrawForm.AutoRedraw = True
        DrawForm.CurrentX = X
        DrawForm.CurrentY = Y
        DrawForm.Print Label1.Caption
        Label1.Visible = False
        PrintText = False
        Exit Sub
    End If
    DrawForm.DrawMode = 13
     Select Case Shape
        Case "LINE":
            DrawForm.Line (XStart, YStart)-(X, Y)
        Case "CIRCLE":
            DrawForm.Circle (XStart, YStart), Sqr((X - XStart) ^ 2 + (Y - YStart) ^ 2)
            ' the following statement erases the dot at the circle's center
            DrawForm.Circle (XStart, YStart), DrawForm.DrawWidth, DrawForm.BackColor
        Case "BOX":
            DrawForm.Line (XStart, YStart)-(X, Y), , B
    End Select
End Sub
Private Sub Form_Resize()
    Picture1.Width = DrawForm.Width
    Picture1.Height = DrawForm.Height
End Sub
Private Sub StyleDash_Click()
    UnCheckStyles
    StyleDash.Checked = True
    DrawForm.DrawStyle = 1
End Sub
Private Sub StyleDot_Click()
    UnCheckStyles
    StyleDot.Checked = True
    DrawForm.DrawStyle = 2
End Sub
Private Sub StyleFilled_Click()
    StyleFilled.Checked = Not StyleFilled.Checked
    If StyleFilled.Checked Then
        DrawForm.FillStyle = 0
    Else
        DrawForm.FillStyle = 1
    End If
End Sub
Private Sub StyleSolid_Click()
    UnCheckStyles
    StyleSolid.Checked = True
    DrawForm.DrawStyle = 0
End Sub
Private Sub width1_Click()
    DrawForm.DrawWidth = 1
End Sub
Private Sub Width2_Click()
    DrawForm.DrawWidth = 2
End Sub
Private Sub Width3_Click()
    DrawForm.DrawWidth = 3
End Sub