Mastering Visual Basic 5/MasteringVisualBasic5.iso/ch_code/ch15/qdraw/qdraw.frm

Visual Basic Form | 1997-02-20 | 12.8 KB | 422 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form Form1
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   Caption         =   "Draw"
   ClientHeight    =   4200
   ClientLeft      =   1740
   ClientTop       =   2595
   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"
   PaletteMode     =   2  'Custom
   ScaleHeight     =   4200
   ScaleWidth      =   6705
   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
      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"
      NegotiatePosition=   3  'Right
      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"
      NegotiatePosition=   3  'Right
      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"
      NegotiatePosition=   3  'Right
      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"
      NegotiatePosition=   3  'Right
      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"
      NegotiatePosition=   3  'Right
      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"
      NegotiatePosition=   3  'Right
      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 = "Form1"
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, 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 = Form1.FillColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    Form1.FillColor = CommonDialog1.Color
End Sub
Private Sub ColorPage_Click()
    CommonDialog1.Color = Form1.BackColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    Form1.BackColor = CommonDialog1.Color
End Sub
Private Sub ColorPen_Click()
    CommonDialog1.Color = Form1.ForeColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    Form1.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
    Label1.ForeColor = Form1.ForeColor
    PrintText = True
End Sub
Private Sub EditClear_Click()
    Form1.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()
    Form1.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
    Form1.Picture = LoadPicture(CommonDialog1.filename)
    OpenFile = CommonDialog1.filename
    Picture1.Picture = Form1.Picture
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 Form1.Image, CommonDialog1.filename
    OpenFile = CommonDialog1.filename
End Sub
Private Sub Form_Load()
    CopyBMP = False
    PasteBMP = False
    PrintText = False
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
        Form1.AutoRedraw = False
    End If
    If CopyBMP Or CutBMP Then
        PDrawWidth = Form1.DrawWidth
        PDrawStyle = Form1.DrawStyle
        PFillStyle = Form1.FillStyle
        Form1.DrawWidth = 1
        Form1.DrawStyle = 0
        Form1.FillStyle = 1
    End If
    If PasteBMP Then
        Form1.PaintPicture Picture1.Image, X, Y, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &HCC0020
        XPrevious = X
        YPrevious = Y
        Exit Sub
    End If
If PrintText Then
    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
        Form1.Line (XStart, YStart)-(XPrevious, YPrevious), , B
        Form1.Refresh
        Form1.Line (XStart, YStart)-(X, Y), , B
        XPrevious = X
        YPrevious = Y
        Exit Sub
    End If
    If PasteBMP Then
        Form1.PaintPicture Picture1.Image, XPrevious, YPrevious, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &H660046
        Form1.Refresh
        Form1.PaintPicture Picture1.Image, X, Y, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &HCC0020
        Exit Sub
    End If
If PrintText Then
    Label1.Left = X
    Label1.Top = Y
    Exit Sub
End If
    Select Case Shape
        Case "LINE":
            'Form1.Line (XStart, YStart)-(XPrevious, YPrevious)
            Form1.Refresh
            Form1.Line (XStart, YStart)-(X, Y)
        Case "CIRCLE":
            'Form1.Circle (XStart, YStart), Sqr((XPrevious - XStart) ^ 2 + (YPrevious - YStart) ^ 2)
            Form1.Refresh
            Form1.Circle (XStart, YStart), Sqr((X - XStart) ^ 2 + (Y - YStart) ^ 2)
        Case "BOX":
            'Form1.Line (XStart, YStart)-(XPrevious, YPrevious), , B
            Form1.Refresh
            Form1.Line (XStart, YStart)-(X, Y), , B
    End Select

End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim X1, Y1
    If CopyBMP Then
        Form1.Line (XStart, YStart)-(XPrevious, YPrevious), , B
        Form1.Refresh
        If X > XStart Then X1 = XStart Else X1 = X
        If Y > YStart Then Y1 = YStart Else Y1 = Y
        Picture1.PaintPicture Form1.Image, 0, 0, Abs(X - XStart), Abs(Y - YStart), X1, Y1, Abs(X - XStart), Abs(Y - YStart), &HCC0020
        CopyBMP = False
        Form1.DrawWidth = PDrawWidth
        Form1.DrawStyle = PDrawStyle
        Form1.FillStyle = PFillStyle
        CopyWidth = Abs(X - XStart)
        CopyHeight = Abs(Y - YStart)
        Exit Sub
    End If
    If CutBMP Then
        Form1.AutoRedraw = True
        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 Form1.Image, 0, 0, Abs(X - XStart), Abs(Y - YStart), X1, Y1, Abs(X - XStart), Abs(Y - YStart), &HCC0020
        Form1.Line (X, Y)-Step(CopyWidth, CopyHeight), Form1.BackColor, BF
        CutBMP = False
        Form1.DrawWidth = PDrawWidth
        Form1.DrawStyle = PDrawStyle
        Form1.FillStyle = PFillStyle
        CopyWidth = Abs(X - XStart)
        CopyHeight = Abs(Y - YStart)

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