Al otro lado de la pantalla
Esto es un ejemplo de soltar un archivo de texto en un TextArea.
Se que la función que decodifica la URI la vi en alguna parte, la he dejado tal cual.
No parece completa, por eso cree otra función para saber la extensión. Tal como está ahora
mostraría hasta un archivo de imagen en texto..
Public Sub TextArea1_Drag()
If Drag.Type <> Drag.Text Then Stop Event
End
Public Sub TextArea1_Drop()
Dim ruta As String
Dim anombre As String[]
Dim palabra As String
ruta = Drag.Data
anombre = Split(ruta, "/", "\r\n", True)
ruta = Null
'Eliminar la plabra file: del array anombre
If anombre[0] = "file:" Then anombre.Remove(0)
For Each palabra In anombre
ruta &= "/" & URLDecode(palabra)
Next
' Mostrarlo en TextArea
TextArea1.Text = File.Load(qextension(ruta))
End
Private Function URLDecode(txt As String) As String
''' Descodifica los caracteres hexadecimales en las URI's recorriendo la cadena dada
''' Params: txt la URI a descodificar
''' Return: la URI descodificada
Dim txt_len As Integer
Dim i As Integer
Dim ch As String
Dim digits As String
Dim resultado As String
resultado = ""
txt_len = Len(txt)
i = 1
Do While i <= txt_len
' Examinar el siguiente caracter
ch = Mid$(txt, i, 1)
If ch = "+" Then
' Convertir a espacio
resultado = resultado & " "
Else If ch <> "%" Then
' Normal, no cambiar
resultado = resultado & ch
Else If i > txt_len - 2 Then
resultado = resultado & ch
Else
' Obtener los siguientes caracteres hex.
digits = Mid$(txt, i + 1, 2)
' Debug digits
' aquí convertimos el valor hexadecimal a entero y
' se lo pasamos a Chr que devuelve el carácter correcto.
resultado = resultado & Chr$(CInt(Val("&" & digits)))
i = i + 2
Endif
i = i + 1
Loop
Return resultado
End
Public Function qextension(txt As String) As String
Dim pospunto, i As Integer
Dim ch, extension As String
'Busca lugar del punto
pospunto = InStr(txt, ".")
'Añadimos a i el lugar donde se encuentra el punto + 1
i = pospunto + 1
'No se aceptan caracteres que contengan número y los simbolos ":" y "-"
Do While i < Len(txt)
ch = Mid(txt, i, 1)
If InStr("0123456789:-", ch) = 0 Then
extension &= ch
Else
'Salimos en caso de ser los caracteres prohibidos
Break
Endif
i += 1
Loop
Return (Left(txt, pospunto) & extension)
End
If Drag.Type <> Drag.Text Then Stop Event
End
Public Sub TextArea1_Drop()
Dim ruta As String
Dim anombre As String[]
Dim palabra As String
ruta = Drag.Data
anombre = Split(ruta, "/", "\r\n", True)
ruta = Null
'Eliminar la plabra file: del array anombre
If anombre[0] = "file:" Then anombre.Remove(0)
For Each palabra In anombre
ruta &= "/" & URLDecode(palabra)
Next
' Mostrarlo en TextArea
TextArea1.Text = File.Load(qextension(ruta))
End
Private Function URLDecode(txt As String) As String
''' Descodifica los caracteres hexadecimales en las URI's recorriendo la cadena dada
''' Params: txt la URI a descodificar
''' Return: la URI descodificada
Dim txt_len As Integer
Dim i As Integer
Dim ch As String
Dim digits As String
Dim resultado As String
resultado = ""
txt_len = Len(txt)
i = 1
Do While i <= txt_len
' Examinar el siguiente caracter
ch = Mid$(txt, i, 1)
If ch = "+" Then
' Convertir a espacio
resultado = resultado & " "
Else If ch <> "%" Then
' Normal, no cambiar
resultado = resultado & ch
Else If i > txt_len - 2 Then
resultado = resultado & ch
Else
' Obtener los siguientes caracteres hex.
digits = Mid$(txt, i + 1, 2)
' Debug digits
' aquí convertimos el valor hexadecimal a entero y
' se lo pasamos a Chr que devuelve el carácter correcto.
resultado = resultado & Chr$(CInt(Val("&" & digits)))
i = i + 2
Endif
i = i + 1
Loop
Return resultado
End
Public Function qextension(txt As String) As String
Dim pospunto, i As Integer
Dim ch, extension As String
'Busca lugar del punto
pospunto = InStr(txt, ".")
'Añadimos a i el lugar donde se encuentra el punto + 1
i = pospunto + 1
'No se aceptan caracteres que contengan número y los simbolos ":" y "-"
Do While i < Len(txt)
ch = Mid(txt, i, 1)
If InStr("0123456789:-", ch) = 0 Then
extension &= ch
Else
'Salimos en caso de ser los caracteres prohibidos
Break
Endif
i += 1
Loop
Return (Left(txt, pospunto) & extension)
End
A ver si se puede mejorar un poco más. El código, claro.
Saludos
| SoltarTexto.tar.gz | ||
| Descripción: |  Descargar |
|
| Nombre del archivo: | SoltarTexto.tar.gz | |
| Tamaño: | 6.11 KB | |
| Descargado: | 37 veces | |
| SoltarTexto.tar.gz | ||
| Descripción: | Descargar |
|
| Nombre del archivo: | SoltarTexto.tar.gz | |
| Tamaño: | 6.11 KB | |
| Descargado: | 37 veces | |
| SoltarTexto.tar.gz | ||
| Descripción: | Descargar |
|
| Nombre del archivo: | SoltarTexto.tar.gz | |
| Tamaño: | 6.11 KB | |
| Descargado: | 37 veces | |
