Form1.frm
上传用户:xinwangfa
上传日期:2022-07-09
资源大小:38k
文件大小:5k
源码类别:

图形图像处理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "picclp32.ocx"
  3. Begin VB.Form Form1 
  4.    Caption         =   "复制剪切和粘贴"
  5.    ClientHeight    =   6060
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   7575
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   6060
  11.    ScaleWidth      =   7575
  12.    StartUpPosition =   3  '窗口缺省
  13.    Begin VB.PictureBox Picture2 
  14.       Height          =   3975
  15.       Left            =   4200
  16.       ScaleHeight     =   261
  17.       ScaleMode       =   3  'Pixel
  18.       ScaleWidth      =   197
  19.       TabIndex        =   4
  20.       Top             =   240
  21.       Width           =   3015
  22.    End
  23.    Begin VB.CommandButton CmdPaste 
  24.       Caption         =   "粘贴"
  25.       Height          =   495
  26.       Left            =   3600
  27.       TabIndex        =   3
  28.       Top             =   5040
  29.       Width           =   1215
  30.    End
  31.    Begin VB.CommandButton CmdCut 
  32.       Caption         =   "剪切"
  33.       Height          =   495
  34.       Left            =   2040
  35.       TabIndex        =   2
  36.       Top             =   5040
  37.       Width           =   1095
  38.    End
  39.    Begin VB.CommandButton CmdCopy 
  40.       Caption         =   "复制"
  41.       Height          =   495
  42.       Left            =   480
  43.       TabIndex        =   1
  44.       Top             =   5040
  45.       Width           =   1095
  46.    End
  47.    Begin VB.PictureBox Picture1 
  48.       Height          =   3855
  49.       Left            =   240
  50.       Picture         =   "Form1.frx":0000
  51.       ScaleHeight     =   253
  52.       ScaleMode       =   3  'Pixel
  53.       ScaleWidth      =   205
  54.       TabIndex        =   0
  55.       Top             =   240
  56.       Width           =   3135
  57.       Begin VB.Shape Shape1 
  58.          BorderStyle     =   3  'Dot
  59.          Height          =   1455
  60.          Left            =   960
  61.          Top             =   1080
  62.          Width           =   1575
  63.       End
  64.    End
  65.    Begin PicClip.PictureClip PictureClip1 
  66.       Left            =   0
  67.       Top             =   120
  68.       _ExtentX        =   7011
  69.       _ExtentY        =   7646
  70.       _Version        =   393216
  71.    End
  72. End
  73. Attribute VB_Name = "Form1"
  74. Attribute VB_GlobalNameSpace = False
  75. Attribute VB_Creatable = False
  76. Attribute VB_PredeclaredId = True
  77. 'Download by http://www.codefans.net
  78. Attribute VB_Exposed = False
  79. Dim flag1 As Boolean
  80. Private Sub Form_Load()
  81.     Shape1.Visible = False
  82.     Shape1.BorderStyle = 3
  83.     flag1 = False
  84. End Sub
  85. Private Sub Picture1_MouseDown(Button As Integer, _
  86.                                Shift As Integer, _
  87.                                X As Single, Y As Single)
  88. '开始选择区域
  89.     Shape1.Left = X
  90.     Shape1.Top = Y
  91.     flag1 = True
  92.     '设置标志变量并将Shape1的左上角移动到鼠标所在点
  93. End Sub
  94. Private Sub Picture1_MouseMove(Button As Integer, _
  95.                                Shift As Integer, _
  96.                                X As Single, Y As Single)
  97. '在选定区域过程中随着鼠标移动产生虚线框
  98.    If Button = 1 Then
  99.        If flag1 = True Then
  100.        '如果是处在正在选择区域状态
  101.             Shape1.Width = Abs(X - Shape1.Left)
  102.             Shape1.Height = Abs(Y - Shape1.Top)
  103.             Shape1.Visible = True
  104.             Picture1.Refresh
  105.         Else
  106.             Shape1.Visible = False
  107.         End If
  108.     End If
  109. End Sub
  110. Private Sub Picture1_MouseUp(Button As Integer, _
  111.                              Shift As Integer, _
  112.                              X As Single, Y As Single)
  113.     flag1 = False
  114.     '结束选择区域状态
  115. End Sub
  116. Private Sub CmdCopy_Click()
  117. '通过PictureClip控件作为中间对象将Picture1中由Shape1表明的图像块
  118. '复制到剪贴板上
  119.     If Shape1.Visible = True Then
  120.     '如果有选定的图像块
  121.         Clipboard.Clear    '清空剪贴扳
  122.         On Error Resume Next
  123.         PictureClip1.Picture = Picture1.Picture
  124.         PictureClip1.ClipX = Shape1.Left
  125.         PictureClip1.ClipY = Shape1.Top
  126.         PictureClip1.ClipWidth = Shape1.Width
  127.         PictureClip1.ClipHeight = Shape1.Height
  128.         Clipboard.SetData PictureClip1.Clip
  129.     End If
  130. End Sub
  131. Private Sub CmdCut_Click()
  132. Const vbMergePaint = &HBB0226
  133.     If Shape1.Visible = True Then
  134.         Clipboard.Clear    '清空剪贴扳
  135.         On Error Resume Next
  136.         PictureClip1.Picture = Picture1.Picture
  137.         PictureClip1.ClipX = Shape1.Left
  138.         PictureClip1.ClipY = Shape1.Top
  139.         PictureClip1.ClipWidth = Shape1.Width
  140.         PictureClip1.ClipHeight = Shape1.Height
  141.         Clipboard.SetData PictureClip1.Clip
  142.         '如果有选定的图像块则复制到剪贴板
  143.     
  144.         Picture1.PaintPicture Picture1.Picture, _
  145.              Shape1.Left, Shape1.Top, Shape1.Width, Shape1.Height, _
  146.              Shape1.Left, Shape1.Top, Shape1.Width, Shape1.Height, _
  147.              vbMergePait
  148.         '使用OR运算使Picture1中Shape1所标识的部分清空
  149.         
  150.     End If
  151. End Sub
  152. Private Sub CmdPaste_Click()
  153. '粘贴
  154.     Picture2.Picture = Clipboard.GetData
  155. End Sub