哪个高人肯帮我实现这样的功能?
在窗体上放置Picture1、Picture2,Command1和Command2.
Command1为“复制”Command2为“粘贴”
要实现的功能
1、程序运行时Picture2为不可见。
2、在Picture1上导入一张图片后,用鼠标在图片上拖动即出现一个虚线框,按Command1将虚线框内的区域复制到剪贴板,
3、按Command2将剪贴板上的图片粘贴到Picture2上,同时Picture2出现(可见),用鼠标可以拖动Picture2。
最好来段示例,先谢了。
[解决办法]
'添加 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 Sub
Private Sub Command1_Click()
SavePicture Picture2.Image, "c:\tt.bmp"
MsgBox "保存完成"
End Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private Sub picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pic2X = X: Pic2Y = Y
Picture2.MousePointer = 7
End Sub
Private 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 Sub
Private Sub picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Pic2X = Pic2Y = 0
Picture2.MousePointer = 0
End Sub
------解决方案--------------------
上面代码事先在Form_Load()中写入一行:
Picture1.Picture = LoadPicture("d:\漂亮小妹.jpg")
[解决办法]
http://www.j2soft.cn/static_html/200511161710417375admin.html
源码
[解决办法]