如何选定picture中的一片内容！

Question

Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Answer 1

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPublic grect As RECT
i_hwnd = GetDC(Picture1.hWnd)
DrawFocusRect i_hwnd, grect

Answer 2

然后分别在MouseDown、MouseMove里确定矩形的四个点

Answer 3

只是一部分，剩下的自己写吧，没时间了Option ExplicitPrivate Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDc Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private grect As RECTPrivate Sub Form_Load()
    With grect
        .Bottom = 0
        .Left = 0
        .Top = 0
        .Right = 0
    End With
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i_hwnd As Long
    Dim i_rec As Long
    
    If Button = 1 Then
        i_hwnd = GetDC(Picture1.hwnd)
        DrawFocusRect i_hwnd, grect
        grect.Left = X
        grect.Top = Y
        i_rec = ReleaseDc(Picture1.hwnd, i_hwnd)
    End IfEnd Sub

Answer 4

先在PictureBox内放一矩形Shape,使其不可见，然后。
Private originPosX As Integer
Private originPosY As Integer
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
originPosX = X
originPosY = Y
With Me.Shape1
.Left = X
.Top = Y
.Visible = True
End With
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button <> 1 Then
    Exit Sub
End IfWith Me.Shape1
If X > originPosX Then
.Width = X - originPosX
Else
.Width = originPosX - X
.Left = X
End If
If Y > originPosY Then
.Height = Y - originPosY
Else
.Height = originPosY - Y
.Top = Y
End If
DoEvents
End With
End Sub

Answer 5

是在 picturebox中选定一个任意的区域！就象在ide中选择控件一样有虚线框出现

Answer 6

Dim BegX As Integer, BegY, EndX, EndY
Dim LDown As Boolean
Private Sub Form_Load()
    LDown = False
    Picture1.DrawStyle = 2End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        LDown = True
        BegX = X
        BegY = Y
    End IfEnd SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If LDown = True Then
                
                Picture1.Cls
                Picture1.Line (BegX, BegY)-(BegX, Y), , B
                Picture1.Line (BegX, BegY)-(X, BegY), , B
                Picture1.Line (X, Y)-(X, BegY), , B
                Picture1.Line (X, Y)-(BegX, Y), , B
                
                EndX = X
                EndY = Y
    End If
    
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    LDown = False
End Sub

Answer 7

这是刚写的，你试试吧，放一个　PICTUREBOX ，然后ｃｏｐｙ　过去就行

Answer 8

那样不就占用了picturebox的绘图的空间了吗？

Answer 9

应该是占用了picturebox的绘图进程

Answer 10

然也，小弟很想认识你！
我现在也正在学VB，希望能跟向你请教！！
你的QQ能告诉我吗！？
我的是9172547，请加我吧！！！

Answer 11

to qimini(帆) :"我在动态的绘一个图形。用户希望选定一个区域并放大"想不通什么地方需要把你“动态绘图”的东西放大，一般自己“画”出来的效果太差，根本没有必要放大！如果是ｌｏａｄ的图片，我的方法不会影响什么；如果真的是“动态绘图”，那还是用shape控件！改变以下它的外观为虚线就行ｔｏ　 chinadjzh(段誉) ：　有事在论坛发帖子，这里高手太多！