• Domingo 6 de Octubre de 2024, 15:19

Autor Tema:  Imagen PNG sobre Picture  (Leído 2227 veces)

Mombasa

  • Nuevo Miembro
  • *
  • Mensajes: 6
    • Ver Perfil
Imagen PNG sobre Picture
« en: Jueves 9 de Mayo de 2013, 16:55 »
0
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.

Código: [Seleccionar]
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