Много рисунков

[Chuvack]

Как сделать, чтобы при клики мыши на форме появился рисунок и остался там, где курсор мыши, еще раз кликнешь опять рисунок и так чтобы N количество раз.
Делал так:
Private Sub Form_DblClick()
Image.Picture = LoadPicture("путь к рисунку")
end sub
но всегда один рисунок.

[A.A.Z.]

Надеюсь, я правильно понял:

Код: Выделить всё

Option Explicit

Dim I() As Image, cX&, cY&

Private Sub Form_DblClick()
ReDim Preserve I(UBound(I) + 1)
Set I(UBound(I)) = Me.Controls.Add("VB.Image", "Image" & UBound(I))
I(UBound(I)).Left = cX
I(UBound(I)).Top = cY
I(UBound(I)).Picture = LoadPicture("C:\1.bmp")
I(UBound(I)).Visible = True
End Sub

Private Sub Form_Load()
ReDim I(0) As Image
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cX = X
cY = Y
End Sub

[Chuvack]

Большое спасибо, все работает, но у меня возник ещё вопрос, как сделать, чтобы при клике на рисунок, он удалялся. И еще, почему рисунок появляется не поверх всех объектов на форме, а под ними.

[Konst_One]

Код: Выделить всё

...
I(UBound(I)).ZOrder 0
I(UBound(I)).Visible = True
...


[OMEGUS]

Классно! И просто! Тоже так сделаю!

[Chuvack]

Всё гениальное - просто
И всё-таки как удалить рисунок?

[Inferno]

Image.Picture = LoadPicture()

[Chuvack]

И что ты написал?????Перепутал что-то

[alibek]

Set Image.Picture = [LoadPicture() | Nothing]

[Chuvack]

Что-то я не понял, как это работает ,не могу въехать.

[A.A.Z.]

Надо было сразу сказать про удаление
Тогда можно так (для удаления наведи мышкой на картинку и нажми Del):

Код: Выделить всё

Option Explicit

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Dim I() As PictureBox, cX&, cY&, CurPB As Long, WithEvents Timer1 As Timer

Private Sub Form_DblClick()
ReDim Preserve I(UBound(I) + 1)
Set I(UBound(I)) = Me.Controls.Add("VB.PictureBox", "Picture" & UBound(I))
I(UBound(I)).Left = cX
I(UBound(I)).Top = cY
I(UBound(I)).Picture = LoadPicture("C:\1.bmp")
I(UBound(I)).AutoSize = True
I(UBound(I)).BorderStyle = 0
I(UBound(I)).Visible = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
If MsgBox("Удалить?", vbQuestion Or vbYesNo) = vbYes Then
Set I(CurPB) = Nothing
Me.Controls.Remove "Picture" & CurPB
End If
End If
End Sub

Private Sub Form_Load()
ReDim I(0) As PictureBox
Me.KeyPreview = True
Set Timer1 = Me.Controls.Add("VB.Timer", "Timer1")
Timer1.Interval = 1
Timer1.Enabled = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
cX = x
cY = y
End Sub

Private Sub Timer1_Timer()
Dim J&, R As RECT, P As POINTAPI
GetCursorPos P
For J = 1 To UBound(I)
If Not I(J) Is Nothing Then
GetWindowRect I(J).hwnd, R
If PtInRect(R, P.x, P.y) Then I(J).BorderStyle = 1: CurPB = J: Exit Sub Else I(J).BorderStyle = 0
End If
Next
CurPB = 0
End Sub

[Chuvack]

Всё работает,но ты cделал PictureBox, а в том примере было Image и теперь при появление рисунка, он все закрывает и получается некрасиво, с Image было как-то лучше.

[A.A.Z.]

Тогда так:

Код: Выделить всё

Option Explicit

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CYCAPTION As Long = &H4&, SM_CXBORDER As Long = &H5&, SM_CYBORDER As Long = &H6&, SM_CXDLGFRAME As Long = &H7&, SM_CYDLGFRAME As Long = &H8&

Dim I() As Image, S As Shape, cX&, cY&, CurImg&, FormLeft&, FormTop&, WithEvents Timer1 As Timer

Private Sub Form_Activate()
Dim Flag As Boolean
If Not Flag Then
FormLeft = Me.Left / Screen.TwipsPerPixelX + GetSystemMetrics(SM_CXDLGFRAME) + GetSystemMetrics(SM_CXBORDER)
FormTop = Me.Top / Screen.TwipsPerPixelY + GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYBORDER)
End If
Flag = True
End Sub

Private Sub Form_DblClick()
ReDim Preserve I(UBound(I) + 1)
Set I(UBound(I)) = Me.Controls.Add("VB.Image", "Image" & UBound(I))
I(UBound(I)).Left = cX
I(UBound(I)).Top = cY
I(UBound(I)).Picture = LoadPicture("C:\1.bmp")
I(UBound(I)).ZOrder 0
I(UBound(I)).Visible = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete And CurImg <> 0 Then
If MsgBox("Удалить?", vbQuestion Or vbYesNo) = vbYes Then
Set I(CurImg) = Nothing
Me.Controls.Remove "Image" & CurImg
End If
End If
End Sub

Private Sub Form_Load()
ReDim I(0) As Image
Me.KeyPreview = True
Me.ScaleMode = 3
Set Timer1 = Me.Controls.Add("VB.Timer", "Timer1")
Timer1.Interval = 1
Timer1.Enabled = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
cX = x
cY = y
End Sub

Private Sub Timer1_Timer()
Dim J&, R As RECT, P As POINTAPI
GetCursorPos P
For J = 1 To UBound(I)
If Not I(J) Is Nothing Then
GetImageRect I(J), R
If PtInRect(R, P.x, P.y) Then CurImg = J: Exit Sub
End If
Next
CurImg = 0
End Sub

Private Sub GetImageRect(oImage As Image, lpRect As RECT)
lpRect.Left = oImage.Left + FormLeft
lpRect.Top = oImage.Top + FormTop
lpRect.Right = lpRect.Left + oImage.Width
lpRect.Bottom = lpRect.Top + oImage.Height
End Sub

[Chuvack]

Огромное спасибо!!!!!Теперь всё как надо

[|kerish|]

Для ускорения предлагаю использовать Pset.
И рисовать рисунок по точкам.

[Chuvack]

И намного быстрее работает????

[Chuvack]

Появился снова вопрос.А можно вставлять не рисунок, а Label, TextBox, Frame. Такой же принцип или нет?
A.A.Z. если можешь помоги.

[A.A.Z.]

Да, такой же.
Например:

Код: Выделить всё

Dim L As Label
Set L = Me.Controls.Add("VB.Label", "Label1")
With L
.Caption = "Привет!!!"
.Visible = True
End With

Подробнее читай в статье gaidar'а.

[Chuvack]

Спасибо за статью, теперь я разобрался