1
« en: Jueves 9 de Mayo de 2013, 16:55 »
Si prueban el siguiente código, al hacer clic sobre una parte del Picture, indicará las coordenadas. Luego las guarda en txt.
Ahora...en vez de realizar la operación antes explicada, sobre el picture quiero arrastrar y soltar una imagen PNG. Esta acción puedo hacerlo alrededor del picture, pero no soltarla dentro. ¿Existe alguna solución para esto?
NOTA: EL módulo para leer las imágenes PNG no lo adjunté...si lo necesitan, pídanmelo.
Muchas gracias.
Option Explicit
DefLng A-Z
Dim Boton As Integer
Dim Coordy As Integer
Private Sub Form_Load()
'Permitimos al control image una operacion de arrastre
Image1.OLEDragMode = 1
Image3.OLEDragMode = 1
Me.OLEDropMode = 1
Call PngImageLoad("C:\r.png", Image1) 'para cargarlo en el image1
Call PngImageLoad("C:\am.png", Image3) 'para cargarlo en el image1
End Sub
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
With Image1
.Drag vbEndDrag
.Move X - mx, Y - my
End With
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Drag vbBeginDrag
mx = X: my = Y
End Sub
Private Sub Form_OLEDragOver(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, _
X As Single, Y As Single, State As Integer)
Boton = Button
End Sub
'Evento que se ejecuta al soltar la imagen en el formulario
Private Sub Form_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
'Le decimos que sea una copia de lo que vamos a arrastrar
Effect = vbDropEffectCopy
If Boton = vbLeftButton Then
Me.PaintPicture data.GetData(2), X, Y
End If
End Sub
Private Sub Image2_Click()
On Error GoTo cancelar 'en caso de que halla un error ir a cancelar
Dim archivo As String
archivo = "x:\ubicacion del archivo.txt"
Open archivo For Append As #1 'sintaxis para guardar una archivo
Print #1, Text1.Text & " " & Text2.Text
Text3.Text = Text3.Text & IIf(Text3.Text <> "", vbCrLf, "") & Text1.Text & " " & Text2.Text
Close 'cerramos el archivo
cancelar: 'accion que va a tomar si hay algun error.
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const Ancho = 0.3
Const Alto = 0.3
Dim CoordX As Single, CoorY As Single
Dim X1 As Single, Y1 As Single, W1 As Single, H1 As Single
Dim file As Integer, col As Integer
If Button = vbLeftButton Then
CoordX = X - ((Picture1.ScaleWidth * Ancho) / 2)
If CoordX < 0 Then CoordX = 0
If (CoordX + (Ancho * Picture1.ScaleWidth)) > Picture1.ScaleWidth Then
CoordX = Picture1.ScaleWidth * (1 - Ancho)
End If
Coordy = Y - ((Picture1.ScaleHeight * Alto) / 2)
If Coordy < 0 Then Coordy = 0
If (Coordy + (Alto * Picture1.ScaleHeight) > Picture1.ScaleHeight) Then
Coordy = Picture1.ScaleHeight * (1 - Alto)
End If
Text1.Text = CoordX
Text2.Text = Coordy
End If
End Sub