tyomitch писал(а):Руками, через FillRect и PtInRect
KDima писал(а):Фигуры и Линии в VB не имеют ивентов, особенно нарисованные на форме
A.A.Z. писал(а):А ты прямоугольник рисуешь через "Line(,)-(,), B", или это Shape? Или через API?
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Dim Rects(1 To 2) As RECT
Private Sub Form_Load()
SetRect Rects(1), 0, 0, 100, 100
SetRect Rects(2), 50, 50, 150, 150
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Long, hbr As Long
X = ScaleX(X, ScaleMode, vbPixels)
Y = ScaleY(Y, ScaleMode, vbPixels)
For i = LBound(Rects) To UBound(Rects)
If PtInRect(Rects(i), X, Y) Then
hbr = CreateSolidBrush(QBColor(i))
FillRect hdc, Rects(i), hbr
DeleteObject hbr
Caption = i
End If
Next
End Sub
Private Sub Form_Paint()
Dim i As Long, hbr As Long
For i = LBound(Rects) To UBound(Rects)
hbr = CreateSolidBrush(QBColor(i))
FillRect hdc, Rects(i), hbr
DeleteObject hbr
Next
End Sub
XairOn писал(а):KDima писал(а):Фигуры и Линии в VB не имеют ивентов, особенно нарисованные на форме
Вот "особенно" мне больше всего понравилось - а что остальные имеют???
Спасибо тебе за "экземпл проджект",
ты видать не так понял
(ты там кстати, что-то перемудрил малость)
Сейчас этот форум просматривают: SemrushBot, Yandex-бот и гости: 1