哪个高人肯帮我实现这样的功能？

Question

在窗体上放置Picture1、Picture2,Command1和Command2.
Command1为“复制”Command2为“粘贴”
要实现的功能
1、程序运行时Picture2为不可见。
2、在Picture1上导入一张图片后，用鼠标在图片上拖动即出现一个虚线框，按Command1将虚线框内的区域复制到剪贴板，
3、按Command2将剪贴板上的图片粘贴到Picture2上，同时Picture2出现（可见），用鼠标可以拖动Picture2。
最好来段示例，先谢了。

Answer 1

吃过饭用我以前写的代码帮你改一下, 可以完全做到你要的.剪贴板Clipboard就没必要用了,直接用Bitblt将虚线方块Bitblt到Picture2即可.

Answer 2

'添加 Command1   Picture1   Picture2
'Picture1 装载一张图片Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Dim XX1!, YY1!, XX2!, YY2!, Pic2X%, Pic2Y%, StartX&, StartY&
Private Sub Form_Load()
   Me.ScaleMode = 3: Me.DrawMode = 7: Me.DrawStyle = 2: Me.AutoRedraw = False
   Picture1.ScaleMode = 3: Picture1.DrawMode = 7: Picture1.DrawStyle = 2: Picture1.AutoRedraw = False: Picture1.AutoSize = True
   Picture2.ScaleMode = 3: Picture2.AutoRedraw = True: Picture2.AutoSize = False: Picture2.BorderStyle = 0: Picture2.Visible = False
   Command1.Caption = "保 存"
End SubPrivate Sub Command1_Click()
   SavePicture Picture2.Image, "c:\tt.bmp"
   MsgBox "保存完成"
End SubPrivate Sub FORM_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
      Me.Line (XX1, YY1)-(XX2, YY2), QBColor(10), B
      Me.Line (XX1, YY1)-(X, Y), QBColor(10), B
      XX2 = X: YY2 = Y
   End If
End SubPrivate Sub FORM_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then XX1 = X: YY1 = Y: XX2 = X: YY2 = Y
End SubPrivate Sub FORM_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
      Me.Line (XX1, YY1)-(X, Y), QBColor(10), B
      Picture2.Cls
      StartX = IIf(X >= XX1, XX1, X)
      StartY = IIf(Y >= YY1, YY1, Y)
      Picture2.Width = Abs(X - XX1): Picture2.Height = Abs(Y - YY1)
      BitBlt Picture2.hDC, 0, 0, Abs(X - XX1), Abs(Y - YY1), Me.hDC, StartX, StartY, vbSrcCopy
   End If
End SubPrivate Sub picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then XX1 = X: YY1 = Y: XX2 = X: YY2 = Y: Picture2.Visible = False
End SubPrivate Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
      Picture1.Line (XX1, YY1)-(XX2, YY2), QBColor(10), B
      Picture1.Line (XX1, YY1)-(X, Y), QBColor(10), B
      XX2 = X: YY2 = Y
   End If
End SubPrivate Sub picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
      Picture2.Visible = True: Picture2.Cls
      Picture2.Width = Abs(X - XX1): Picture2.Height = Abs(Y - YY1)
      Picture1.Line (XX1, YY1)-(X, Y), QBColor(10), B
      StartX = IIf(X >= XX1, XX1, X)
      StartY = IIf(Y >= YY1, YY1, Y)
      BitBlt Picture2.hDC, 0, 0, Abs(X - XX1), Abs(Y - YY1), Picture1.hDC, StartX, StartY, vbSrcCopy
   End If
End SubPrivate Sub picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Pic2X = X: Pic2Y = Y
   Picture2.MousePointer = 7
End SubPrivate Sub picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Pic2X <> 0 And Pic2Y <> 0 Then
      Picture2.Left = Picture2.Left + (X - Pic2X)
      Picture2.Top = Picture2.Top + (Y - Pic2Y)
   End If
End SubPrivate Sub picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Pic2X = Pic2Y = 0
   Picture2.MousePointer = 0
End Sub

Answer 3

哪有那么复杂吧，利用OLE拖放技术直接将Picture1拖放到Picture2搞定。就几行代码！！
Option ExplicitPrivate Sub Form_Load()
        Picture1.OLEDragMode = 1 '使picture1自动成为拖放源
        Picture2.OLEDropMode = 1 '使picture2成为放入目标
End SubPrivate Sub picture2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
         
        '从Picture2拖出来的照片放到Picture1中
        Picture2.Picture = Picture1.Picture
        
End SubPrivate Sub picture2_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
        '凡是移到图片框List2上方的东西都允许放下,
        '显示放得下的图标，带小加号的
         Effect = vbDropEffectCopy And Effect
End Sub

Answer 4

上面代码事先在Form_Load()中写入一行：
Picture1.Picture = LoadPicture("d:\漂亮小妹.jpg")

Answer 5

Option ExplicitPrivate Sub Form_Load()
        Picture1.Picture = LoadPicture("d:\漂亮小妹.jpg")
        Picture1.OLEDragMode = 1 '使picture1自动成为拖放源
        Picture2.OLEDropMode = 1 '使picture2成为放入目标
End SubPrivate Sub picture2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
         
        '从Picture1拖出来的照片放到Picture2中
        Picture2.Picture = Picture1.Picture
        
End SubPrivate Sub picture2_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
        '凡是移到图片框picture2上方的东西都允许放下,
        '显示放得下的图标，带小加号的
         Effect = vbDropEffectCopy And Effect
End Sub

Answer 6

哈哈....OLEDragDrop 我当然知道如何用,代码肯定少.楼主的 "虚线框内的区域" 意思即表明是要截取部份区块, 还要拖动所截取的Picture2,  不然那有那么麻烦的代码, 呵呵.................

Answer 7

楼主请注意一下, 上面代码不是只有截取Picture1的图片, 窗体内的图片也可以截取的.如果不要截取窗体内的图片,则将下面三个事件的代码全部拿掉Private Sub FORM_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Private Sub FORM_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Private Sub FORM_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)如果要截取窗体内的图片则将下面改一下,多个 Picture2.visible=truePrivate Sub FORM_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 Then
      Picture2.Visible = True
      Me.Line (XX1, YY1)-(X, Y), QBColor(10), B
      Picture2.Cls
      StartX = IIf(X >= XX1, XX1, X)
      StartY = IIf(Y >= YY1, YY1, Y)
      Picture2.Width = Abs(X - XX1): Picture2.Height = Abs(Y - YY1)
      BitBlt Picture2.hDC, 0, 0, Abs(X - XX1), Abs(Y - YY1), Me.hDC, StartX, StartY, vbSrcCopy
   End If
End Sub

Answer 8

http://www.j2soft.cn/static_html/200511161710417375admin.html源码

Answer 9

再加一行代码：
Picture1.Picture = LoadPicture("d:\一百美圆.jpg")