VB中画出圆后怎么选中它呢？
本帖最后由 thesky102 于 2013-11-08 08:51:10 编辑 就是VB程序运行时画圆，可以在picturebox里画吧？（或者其他控件？）然后程序运行时可能需要鼠标选中这个画的圆。
要这么弄呢？ vb 画圆 选中
[解决办法]
一个利用 Shape 控件做的例子。点击圆内选中，可用方向键控制移动，双击 PictureBox 放弃选中。
Option Explicit
Private Sub Form_Load()
Shape1.Shape = 3 'Circle
Shape1.BorderColor = vbBlack
Shape1.Top = 200
Shape1.Left = 200
Shape1.Height = 2000
End Sub
Private Sub Picture1_DblClick()
Shape1.BorderWidth = 1
Shape1.BorderColor = vbBlack
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shape1.BorderColor = vbBlack Then Exit Sub
If KeyCode = vbKeyLeft And Shape1.Left > 50 Then Shape1.Left = Shape1.Left - 50
If KeyCode = vbKeyUp And Shape1.Top > 50 Then Shape1.Top = Shape1.Top - 50
If KeyCode = vbKeyRight And Shape1.Left + Shape1.Width < Picture1.Width - 50 Then Shape1.Left = Shape1.Left + 50
If KeyCode = vbKeyDown And Shape1.Top + Shape1.Height < Picture1.Height - 50 Then Shape1.Top = Shape1.Top + 50
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim circle_center_x As Long, circle_center_y As Long, circle_radius As Long
With Shape1
circle_radius = .Height \ 2
circle_center_x = .Left + circle_radius
circle_center_y = .Top + circle_radius
If (X - circle_center_x) ^ 2 + (Y - circle_center_y) ^ 2 < circle_radius ^ 2 Then
.BorderWidth = 5
.BorderColor = vbRed
End If
End With
End Sub
Private Type Pointer
X As Long
Y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal HDC As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal HDC As Long, ByVal hRgn As Long, ByVal HBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const ALTERNATE = 1
Const WINDING = 2
Const BLACKBRUSH = 4
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Dim Poly(3) As Pointer
Dim NumCoords As Long
Dim HBrush As Long
Dim hRgn As Long
Private Sub Form_Load()
NumCoords = UBound(Poly) + 1
HBrush = GetStockObject(1)
Picture1.ScaleMode = 3
Poly(0).X = 10
Poly(0).Y = 10
Poly(1).X = 100
Poly(1).Y = 70
Poly(2).X = 100
Poly(2).Y = 10
Poly(3).X = 10
Poly(3).Y = 70
Draw
SetWindowRgn Picture1.hwnd, hRgn, True
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject hRgn
End Sub
Private Sub Draw()
With Picture1
.Cls
.AutoRedraw = True
Polygon .HDC, Poly(0), NumCoords
hRgn = CreatePolygonRgn(Poly(0), NumCoords, ALTERNATE)
If hRgn Then FillRgn .HDC, hRgn, HBrush
.Refresh
End With
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Picture1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Type CirclePos
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long
End Type
Private mudtCircle As CirclePos
Private mlngOffsetX As Long
Private mlngOffsetY As Long
Private mblnDown As Boolean
Private mblnMoved As Boolean
Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
With mudtCircle
.X1 = 50
.Y1 = 50
.X2 = 180
.Y2 = 150
End With
Shape1.BorderStyle = 3
drawCircle
Shape1.Visible = False
End Sub
Private Sub drawCircle()
With Picture1
Ellipse Picture1.hdc, mudtCircle.X1, mudtCircle.Y1, mudtCircle.X2, mudtCircle.Y2
.Refresh
End With
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
mblnDown = True
If PtInCircle(CLng(X), CLng(Y)) Then
Shape1.Left = IIf(mudtCircle.X1 < mudtCircle.X2, mudtCircle.X1, mudtCircle.X2)
Shape1.Top = IIf(mudtCircle.Y1 < mudtCircle.Y2, mudtCircle.Y1, mudtCircle.Y2)
Shape1.Width = Abs(mudtCircle.X1 - mudtCircle.X2)
Shape1.Height = Abs(mudtCircle.Y1 - mudtCircle.Y2)
Shape1.Visible = True
mlngOffsetX = X - Shape1.Left
mlngOffsetY = Y - Shape1.Top
Else
Shape1.Visible = False
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mblnDown = False Or Shape1.Visible = False Then Exit Sub
Shape1.Move (X - mlngOffsetX), (Y - mlngOffsetY)
mblnMoved = True
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mblnMoved = True Then
Picture1.Cls
With mudtCircle
.X1 = Shape1.Left
.Y1 = Shape1.Top
.X2 = .X1 + Shape1.Width
.Y2 = .Y1 + Shape1.Height
End With
drawCircle
mblnMoved = False
End If
mblnDown = False
End Sub
Private Function PtInCircle(ByVal X As Long, ByVal Y As Long) As Boolean
Dim hR As Long
hR = CreateEllipticRgn(mudtCircle.X1, mudtCircle.Y1, mudtCircle.X2, mudtCircle.Y2)
If hR <> 0 Then
If PtInRegion(hR, X, Y) > 0 Then PtInCircle = True
DeleteObject hR
End If
End Function
