怎样在picturebox上画圆和矩形，然后还能选中拖动和放大缩小？

在picturebox上画圆和矩形，这很简单，困难的是选中拖动和放大缩小，帮你试试先。

在picturebox在添加一个image
托动、放大、缩小对image操作
根据image的变化在对picturebox的用api函数（具体那个我不记得了）进行图像的缩放就可以了。

关于矩形和圆形都要调用API函数，其实不太难的
下面是矩形的代码，不过是画在窗体中的，你自己加一个picture控件，把画在窗体中的代码改在picture控件中就行了：
Option Explicit
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Dim flag As Boolean
Dim hdc1 As Long
Dim pos As RECT
Dim handle As Long
Dim X1 As Long
Dim x2 As Long
Dim y2 As Long
Dim Y1 As Long
Public Function small(ByVal a, ByVal b)
small = a
If a < b Then small = a
If b < a Then small = bEnd FunctionPrivate Sub Form_Load()
flag = False
    Me.ScaleMode = 3
Me.AutoRedraw = True
Form1.Shape1.Visible = False
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
flag = True
pos.Left = X
pos.Top = Y
X1 = X
    Y1 = Y
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (flag) Then
pos.Right = X
pos.Bottom = Y
Shape1.Visible = True
    Shape1.Top = small(Y1, Y)
    Shape1.Left = small(X1, X)
    Shape1.Width = Abs(X - X1)
    Shape1.Height = Abs(Y - Y1)
End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (flag) Then
pos.Right = X
pos.Bottom = Y
Rectangle Me.hdc, pos.Left, pos.Bottom, pos.Right, pos.Top
flag = False
End If
End Sub
下面是圆形的代码，不过是画在窗体中的，你自己加一个picture控件，把画在窗体中的代码改在picture控件中就行了：
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Dim flag As Boolean
Dim hdc1 As Long
Dim X1 As Long
Dim x2 As Long
Dim y2 As Long
Dim Y1 As LongPrivate Sub Form_Load()
flag = True
Me.AutoRedraw = False
Me.ScaleMode = 3
    Me.DrawWidth = 1
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
X1 = X
Y1 = Y
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
x2 = X
y2 = Y
Me.ForeColor = vbRed
Ellipse Me.hdc, X1, Y1, x2, y2
End Sub

'form
'按鼠标左键可以绘图，在指定图形上按左键可移动，在边界区按左键可放缩大小
'图形可以保存下来'在移动的时候Option Explicit
Dim pmDatas As PicMessage
Dim ptDatas As POINT
Dim ptMove As POINT
Dim ptEnd As POINT
Dim intFlags As Integer
Dim intMouses As IntegerPrivate Sub picBack_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim pmpic As PicMessage
  Dim mt As Integer
  Dim iflag As Integer

  pmpic = GetItem(X, Y, mt, iflag)

  intEditFlag = 0

  '画图
  If pmpic.ID = 0 And Button = 1 Then
    pmDatas.ID = GetNewID()
    pmDatas.intX = X
    pmDatas.intY = Y
    pmDatas.intW = 0
    pmDatas.intH = 0
    intEditFlag = 3
    picBack.MousePointer = 2
  End If

   '移动
  If pmpic.ID <> 0 And mt = 5 And Button = 1 Then
     intEditFlag = 1
     pmDatas = pmpic
     ptMove.X = pmpic.intX
     ptMove.Y = pmpic.intY
     picBack.MousePointer = 5
  End If

   '拖拉
  If pmpic.ID <> 0 And mt <> 5 And Button = 1 Then

     pmDatas = pmpic
     ptMove.X = pmpic.intX
     ptMove.Y = pmpic.intY

     ptEnd.X = pmpic.intX + pmpic.intW
     ptEnd.Y = pmpic.intY + pmpic.intH
     intMouses = mt
     intFlags = iflag

     intEditFlag = 2

  End If

  ptDatas.X = X
  ptDatas.Y = Y
End SubPrivate Sub picBack_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim pmpic As PicMessage
  Dim mt As Integer

  picBack.MousePointer = 0

  Select Case intEditFlag
    Case 0:
        pmpic = GetItem(X, Y, mt)
        If mt <> 2 And pmpic.ID > 0 Then
           picBack.MousePointer = mt
        Else
           picBack.MousePointer = 0
        End If

    Case 1: '移动

        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(255, 255, 255), BF

        pmDatas.intX = ptMove.X + X - ptDatas.X
        pmDatas.intY = ptMove.Y + Y - ptDatas.Y

        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(0, 0, 255), BF
        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(255, 0, 0), B

        picBack.MousePointer = 5
    Case 2: '拖拉
        picBack.MousePointer = intMouses

        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(255, 255, 255), BF

        Select Case intFlags
           Case 0:
             pmDatas.intX = ptMove.X + X - ptDatas.X
             pmDatas.intW = ptEnd.X - pmDatas.intX
           Case 1:
             pmDatas.intW = X - ptMove.X
           Case 2:
             pmDatas.intY = ptMove.Y + Y - ptDatas.Y
             pmDatas.intH = ptEnd.Y - pmDatas.intY
           Case 3:
             pmDatas.intH = Y - ptMove.Y

           Case 4:
             pmDatas.intX = ptMove.X + X - ptDatas.X
             pmDatas.intY = ptMove.Y + Y - ptDatas.Y
             pmDatas.intW = ptEnd.X - pmDatas.intX
             pmDatas.intH = ptEnd.Y - pmDatas.intY
           Case 5:
             pmDatas.intW = X - ptMove.X
             pmDatas.intH = Y - ptMove.Y
           Case 6:
             pmDatas.intY = ptMove.Y + Y - ptDatas.Y
             pmDatas.intW = X - pmDatas.intX
             pmDatas.intH = ptEnd.Y - pmDatas.intY

           Case 7:
             pmDatas.intX = ptMove.X + X - ptDatas.X
             pmDatas.intH = Y - pmDatas.intY
             pmDatas.intW = ptEnd.X - pmDatas.intX


        End Select

        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(0, 0, 255), BF
        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(255, 0, 0), B
    Case 3: '画图

        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(255, 255, 255), BF

        pmDatas.intW = X - pmDatas.intX
        pmDatas.intH = Y - pmDatas.intY

        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(0, 0, 255), BF
        picBack.Line (pmDatas.intX, pmDatas.intY)-(pmDatas.intX + pmDatas.intW, pmDatas.intY + pmDatas.intH), RGB(255, 0, 0), B

        picBack.MousePointer = 2


  End Select



End SubPrivate Sub picBack_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

   picBack.MousePointer = 0
  Select Case intEditFlag
    Case 0:

    Case 1: '移动
         Del 0, pmDatas.ID
         Add pmDatas

    Case 2: '拖拉
         Del 0, pmDatas.ID
         Add pmDatas

    Case 3: '画图
        pmDatas.intType = 0
        Add pmDatas
  End Select

  intEditFlag = 0
End Sub

'模块
Option Explicit
Private m_pmOBJ() As PicMessage
Private m_Num As IntegerPublic Type PicMessage                   '形状信息结构体
   ID As Long                            '形状ID号
   intX As Single
   intY As Single
   intW As Single
   intH As Single
   intType As Integer                    ' 图形类型 0 －矩形 1－椭圆
   intZ   As Integer                      'Z序中的层次
End TypePublic Type POINT
        X As Single
        Y As Single
End Type
Public intEditFlag As Integer             '处理标志  0-什么也不处理 1－拖动（分几种） 2－移动 3－绘图   '详细的有你定义
Public Function Count() As Integer
  Count = m_Num
End Function'增加数据
Public Sub Add(pmData As PicMessage)
  ReDim Preserve m_pmOBJ(m_Num) As PicMessage

  m_pmOBJ(m_Num) = pmData
   m_Num = m_Num + 1
End Sub
'删除指定ID的数据
Public Sub Del(Index As Integer, Optional ID As Long = 0)
    Dim i As Integer
    Dim j As Integer

    If ID <> 0 Then
       For i = 0 To m_Num - 1
         If m_pmOBJ(i).ID = ID Then
           Exit For
         End If
       Next i
    Else
      i = Index
    End If

    If i < m_Num Then
        For j = i To m_Num - 2
         m_pmOBJ(j) = m_pmOBJ(j + 1)
        Next j

        m_Num = m_Num - 1
        If m_Num > 0 Then ReDim Preserve m_pmOBJ(m_Num - 1) As PicMessage
    End If

End Sub'获得对象
Public Function Item(Index As Integer) As PicMessage
   Dim pmData As PicMessage
   pmData.ID = 0
   If Index < m_Num Then
     Item = m_pmOBJ(Index)
   Else
     Item = pmData
   End If
End Function'*************************************************************************
'**函数名：GetItem
'**输    入：sngX(Single) - 鼠标座标
'**        ：sngY(Single) - 鼠标座标
'**        ：intMouseType(Integer) -  鼠标形状
'**输    出：( PicMessage) - 返回指定点对象
'**功能描述：返回鼠标指定点的对象
'**全局变量：
'**调用模块：
'**作    者：
'**日    期：2003年04月03日
'**修改人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************Public Function GetItem(sngX As Single, sngY As Single, intMouseType As Integer, Optional intFlag As Integer = 0) As PicMessage
   Dim i As Integer
   Dim pmData As PicMessage
   pmData.ID = 0

   For i = 0 To m_Num - 1
      If m_pmOBJ(i).intType = 0 Then
        '矩形
        If sngX >= m_pmOBJ(i).intX And sngY >= m_pmOBJ(i).intY And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intH Then
           '在矩形内

           If sngX >= m_pmOBJ(i).intX + 3 And sngY >= m_pmOBJ(i).intY + 3 And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW - 3 And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intH - 3 Then
             '移动+
             intMouseType = 5
             intFlag = -1
           End If


           If sngX >= m_pmOBJ(i).intX And sngY >= m_pmOBJ(i).intY + 3 And sngX <= m_pmOBJ(i).intX + 3 And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intH - 3 Then
             '-－
             intMouseType = 9
             intFlag = 0
           End If

           If sngX >= m_pmOBJ(i).intX + m_pmOBJ(i).intW - 3 And sngY >= m_pmOBJ(i).intY + 3 And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intH - 3 Then
             '-－
             intMouseType = 9
             intFlag = 1
           End If

           If sngX >= m_pmOBJ(i).intX + 3 And sngY >= m_pmOBJ(i).intY And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW - 3 And sngY <= m_pmOBJ(i).intY + 3 Then
             '|
             intMouseType = 7
             intFlag = 2
           End If

           If sngX >= m_pmOBJ(i).intX + 3 And sngY >= m_pmOBJ(i).intY + m_pmOBJ(i).intH - 3 And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW - 3 And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intW Then
             '|
             intMouseType = 7
             intFlag = 3
           End If


           If sngX >= m_pmOBJ(i).intX And sngY >= m_pmOBJ(i).intY And sngX <= m_pmOBJ(i).intX + 3 And sngY <= m_pmOBJ(i).intY + 3 Then
             '\
             intMouseType = 8
             intFlag = 4
           End If

           If sngX >= m_pmOBJ(i).intX + m_pmOBJ(i).intW - 3 And sngY >= m_pmOBJ(i).intY + m_pmOBJ(i).intH - 3 And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intH Then
             '\
             intMouseType = 8
             intFlag = 5
           End If


           If sngX >= m_pmOBJ(i).intX + m_pmOBJ(i).intW - 3 And sngY >= m_pmOBJ(i).intY And sngX <= m_pmOBJ(i).intX + m_pmOBJ(i).intW And sngY <= m_pmOBJ(i).intY + 3 Then
             '/
             intMouseType = 6
             intFlag = 6
           End If

           If sngX >= m_pmOBJ(i).intX And sngY >= m_pmOBJ(i).intY + m_pmOBJ(i).intH - 3 And sngX <= m_pmOBJ(i).intX + 3 And sngY <= m_pmOBJ(i).intY + m_pmOBJ(i).intH Then
             '/
             intMouseType = 6
             intFlag = 7
           End If

          GetItem = m_pmOBJ(i)
          Exit Function
        End If



      Else
        '椭圆
        '你自己处理吧

      End If

   Next i

  intMouseType = 2
  GetItem = pmData
End Function'获得新ID
Public Function GetNewID() As Long
  Dim lngID As Long
  Dim bFlag As Boolean
  Dim i As Integer
  Do While True
    lngID = Rnd * 30000
    bFlag = False
    For i = 0 To Count() - 1
      If lngID = Item(i).ID Then
        bFlag = True
      End If
    Next i

    If bFlag = False Then
      GetNewID = lngID
      Exit Do
    End If
  LoopEnd Function

调试易

怎样在picturebox上画圆和矩形，然后还能选中拖动和放大缩小？

解决方案 »