VB中实现图片处理

Question

用两个PICTUREBOX，一个显示大图，一个为小方块，用paintpicture方法把所需要的图形复制到小方块里.

Answer 1

放二个　picturebox ,一个　Label  , copy 下面的代码运行：＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option ExplicitDim Flag As Boolean     '拖动标志
Dim oldx, oldx1, oldy1, oldy As Double      '记录原来的坐标Private Sub Form_Load()
    Picture2.Move 0, 0, Me.Width, Me.Height
    Set Label1.Container = Picture2
    Set Picture2.Picture = LoadPicture("C:\Documents and Settings\wxy\My Documents\My Pictures\样品.jpg")
    
    Label1.Caption = ""
    Label1.Move 0, 0, 1000, 1000
    Label1.BackStyle = 0
    Label1.BorderStyle = 1
    Label1.ToolTipText = "鼠标右击截取图片"
    
    Picture1.Width = Label1.Width
    Picture1.Height = Label1.Height
    Picture1.Visible = False
    Picture1.AutoRedraw = True
End SubPrivate Sub Form_Unload(Cancel As Integer)
    End
End SubPrivate Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        '开始拖动
        Flag = True
        '记录下应该绘图的左上角坐标
        oldx = Label1.Left
        oldy = Label1.Top
        '在控件内部的位置
        oldx1 = x
        oldy1 = y
        Picture2.DrawMode = 6
        Picture2.DrawStyle = 2
        '绘制一个拖动的虚线框
        Picture2.Line (oldx, oldy)-(oldx + Label1.Width, oldy + Label1.Height), , B
    ElseIf Button = 2 Then
        Picture1.Visible = True
        Picture1.ZOrder 0
        Set Picture1.Picture = LoadPicture("")
        
        Picture1.PaintPicture Picture2, 0, 0, Label1.Width, Label1.Height, Label1.Left, Label1.Top, Label1.Width, Label1.Height
        MsgBox "图片被保存在　C:\tmp.bmp"
        SavePicture Picture1.Image, "C:\tmp.bmp"
    End If
End SubPrivate Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Flag = False Then
        Exit Sub
    End If
    '首先消除原先的边框
    Picture2.DrawMode = 6
    Picture2.DrawStyle = 2
    Picture2.Line (oldx, oldy)-(oldx + Label1.Width, oldy + Label1.Height), , B
    '计算新的虚线框位置
    oldx = Label1.Left - oldx1 + x
    oldy = Label1.Top + y - oldy1
    '重新绘制拖动位置
    Picture2.Line (oldx, oldy)-(oldx + Label1.Width, oldy + Label1.Height), , BEnd SubPrivate Sub Label1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Flag = False Then Exit Sub
    '消除最后的边框
    Picture2.Line (oldx, oldy)-(oldx + Label1.Width, oldy + Label1.Height), , B
    Label1.Move oldx, oldy
    '不让控件被别的东西遮住
    Label1.ZOrder 0
    '不能跑出窗体
    If oldx < 0 Then
        Label1.Move 0, oldy
        oldx = 0
    End If
    If oldx > (Picture2.ScaleWidth - Label1.Width) Then
        Label1.Move Me.ScaleWidth - Label1.Width, oldy
        oldx = Me.ScaleWidth - Label1.Width
    End If
    If oldy < 0 Then
        Label1.Move oldx, 0
        oldy = 0
    End If
    If oldy > (Picture2.ScaleHeight - Label1.Height) Then
        Label1.Move oldx, Me.ScaleHeight - Label1.Height
        oldy = Me.ScaleHeight - Label1.Height
    End If
    
    '结束拖动
    Flag = FalseEnd Sub