【VB开源代码栏目提醒】：网学会员为需要VB开源代码的朋友们搜集整理了窗体1.frm相关资料，希望对各位网友有所帮助!

    VERSION 5.00
    Begin VB.Form Form1 
       Caption         =   "Form1"
       ClientHeight    =   3855
       ClientLeft      =   465
       ClientTop       =   1545
       ClientWidth     =   3135
       LinkTopic       =   "Form1"
       ScaleHeight     =   3855
       ScaleWidth      =   3135
       Begin VB.PictureBox Picture1 
          AutoSize        =   -1  'True
          ForeColor       =   &H00FFFFFF&
          Height          =   3660
          Left            =   120
          Picture         =   "窗体1.frx":0000
          ScaleHeight     =   3600
          ScaleWidth      =   2865
          TabIndex        =   0
          Top             =   60
          Width           =   2925
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
    
    Private Sub Form_Load()
        Picture1.Top = 0
        Picture1.Left = 0
        Form1.Width = Picture1.Width + 100
        Form1.Height = Picture1.Height + 400
        Form2.Show
    End Sub
    
    Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        x1 = X: y1 = Y: x2 = X: y2 = Y
        Picture1.DrawMode = 7
        Picture1.DrawStyle = 4                  '线型号为点划线
    End Sub
    Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = 1 Then                              ' 如果按下鼠标左键
            Picture1.Line (x1, y1)-(x2, y2), , B        ' 擦除原有线框
            x2 = X: y2 = Y                              ' 保存本次新线框右下角坐标
            Picture1.Line (x1, y1)-(x2, y2), , B        ' 画新线框
        End If
    End Sub
    
    Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        On Error Resume Next
        Picture1.Line (x1, y1)-(x2, y2), , B          ' 擦除原有线框
        Form2.Picture1.Cls
        Form2.Picture1.Width = x2 - x1
        Form2.Picture1.Height = y2 - y1
        Form2.Picture1.Top = 0
        Form2.Picture1.Left = 0
        Form2.Width = Form2.Picture1.Width + 100
        Form2.Height = Form2.Picture1.Height + 400
        Form2.Picture1.PaintPicture Picture1, 0, 0, x2 - x1, y2 - y1, x1, y1, x2 - x1, y2 - y1, vbSrcCopy
    End Sub