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

Visual Basic Form | 1997-02-20 | 14.6 KB | 453 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.UserDocument QDrawDoc
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   3630
   ClientLeft      =   1740
   ClientTop       =   2595
   ClientWidth     =   3870
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H000000FF&
   HScrollSmallChange=   15
   PaletteMode     =   2  'Custom
   ScaleHeight     =   3630
   ScaleWidth      =   3870
   VScrollSmallChange=   15
   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            =   225
      ScaleHeight     =   2475
      ScaleWidth      =   1515
      TabIndex        =   0
      Top             =   735
      Visible         =   0   'False
      Width           =   1575
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   315
      Top             =   165
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
      FontSize        =   1.17491e-38
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   930
      TabIndex        =   1
      Top             =   210
      Visible         =   0   'False
      Width           =   60
   End
   Begin VB.Menu FileMenu
      Caption         =   "File"
      NegotiatePosition=   3  'Right
      Begin VB.Menu FileNew
         Caption         =   "New"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu FileOpen
         Caption         =   "Open"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu FileSave
         Caption         =   "Save"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu FileSaveAs
         Caption         =   "Save As"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu FileExit
         Caption         =   "Exit"
         NegotiatePosition=   3  'Right
      End
   End
   Begin VB.Menu EditMenu
      Caption         =   "Edit"
      NegotiatePosition=   3  'Right
      Begin VB.Menu EditCopy
         Caption         =   "Copy"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu EditCut
         Caption         =   "Cut"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu EditPaste
         Caption         =   "Paste"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu EditClear
         Caption         =   "Clear"
         NegotiatePosition=   3  'Right
      End
   End
   Begin VB.Menu ShapeMenu
      Caption         =   "Shape"
      NegotiatePosition=   3  'Right
      Begin VB.Menu DrawLine
         Caption         =   "Line"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu DrawCircle
         Caption         =   "Circle"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu DrawBox
         Caption         =   "Box"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu DrawText
         Caption         =   "Text"
         NegotiatePosition=   3  'Right
      End
   End
   Begin VB.Menu WidthMenu
      Caption         =   "Width"
      NegotiatePosition=   3  'Right
      Begin VB.Menu width1
         Caption         =   "1 pixel"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu Width2
         Caption         =   "2 pixels"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu Width3
         Caption         =   "3 pixels"
         NegotiatePosition=   3  'Right
      End
   End
   Begin VB.Menu StyleMenu
      Caption         =   "DrawStyle"
      NegotiatePosition=   3  'Right
      Begin VB.Menu StyleSolid
         Caption         =   "Solid"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu StyleDash
         Caption         =   "Dash"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu StyleDot
         Caption         =   "Dot"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu menuSeparator
         Caption         =   "-"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu StyleFilled
         Caption         =   "Solid Shape"
         NegotiatePosition=   3  'Right
      End
   End
   Begin VB.Menu ColorMenu
      Caption         =   "Colors"
      NegotiatePosition=   3  'Right
      Begin VB.Menu ColorPage
         Caption         =   "Page Color"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu ColorPen
         Caption         =   "Pen Color"
         NegotiatePosition=   3  'Right
      End
      Begin VB.Menu ColorFill
         Caption         =   "Fill Color"
         NegotiatePosition=   3  'Right
      End
   End
Attribute VB_Name = "QDrawDoc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
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 UserDocument_Initialize()
    Call Form_Load
End Sub
Private Sub UnCheckStyles()
    StyleSolid.Checked = False
    StyleDash.Checked = False
    StyleDot.Checked = False
End Sub
Private Sub ColorFill_Click()
    CommonDialog1.Color = UserDocument.FillColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    UserDocument.FillColor = CommonDialog1.Color
End Sub
Private Sub ColorPage_Click()
    CommonDialog1.Color = UserDocument.BackColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    UserDocument.BackColor = CommonDialog1.Color
End Sub
Private Sub ColorPen_Click()
    CommonDialog1.Color = UserDocument.ForeColor
    CommonDialog1.Flags = cdlCCRGBInit
    CommonDialog1.ShowColor
    UserDocument.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 = UserDocument.ForeColor
    PrintText = True
End Sub
Private Sub EditClear_Click()
    UserDocument.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()
'[AXDW] The following line was commented out by the ActiveX Document Migration Wizard.
'    End
End Sub
Private Sub FileNew_Click()
    UserDocument.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
    UserDocument.Picture = LoadPicture(CommonDialog1.filename)
    OpenFile = CommonDialog1.filename
    Picture1.Picture = UserDocument.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 UserDocument.Image, CommonDialog1.filename
    OpenFile = CommonDialog1.filename
End Sub
Private Sub Form_Load()
    CopyBMP = False
    PasteBMP = False
    PrintText = False
End Sub
Private Sub UserDocument_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
        UserDocument.AutoRedraw = False
    End If
    If CopyBMP Or CutBMP Then
        PDrawWidth = UserDocument.DrawWidth
        PDrawStyle = UserDocument.DrawStyle
        PFillStyle = UserDocument.FillStyle
        UserDocument.DrawWidth = 1
        UserDocument.DrawStyle = 0
        UserDocument.FillStyle = 1
    End If
    If PasteBMP Then
        UserDocument.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 UserDocument_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> 1 Then Exit Sub
    If CopyBMP Or CutBMP Then
        UserDocument.Line (XStart, YStart)-(XPrevious, YPrevious), , B
        UserDocument.Refresh
        UserDocument.Line (XStart, YStart)-(X, Y), , B
        XPrevious = X
        YPrevious = Y
        Exit Sub
    End If
    If PasteBMP Then
        UserDocument.PaintPicture Picture1.Image, XPrevious, YPrevious, CopyWidth, CopyHeight, 0, 0, CopyWidth, CopyHeight, &H660046
        UserDocument.Refresh
        UserDocument.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":
            'userdocument.Line (XStart, YStart)-(XPrevious, YPrevious)
            UserDocument.Refresh
            UserDocument.Line (XStart, YStart)-(X, Y)
        Case "CIRCLE":
            'userdocument.Circle (XStart, YStart), Sqr((XPrevious - XStart) ^ 2 + (YPrevious - YStart) ^ 2)
            UserDocument.Refresh
            UserDocument.Circle (XStart, YStart), Sqr((X - XStart) ^ 2 + (Y - YStart) ^ 2)
        Case "BOX":
            'userdocument.Line (XStart, YStart)-(XPrevious, YPrevious), , B
            UserDocument.Refresh
            UserDocument.Line (XStart, YStart)-(X, Y), , B
    End Select

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

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