Advertisement
jsbsan

SoltarArchivo

Aug 31st, 2014
1,731
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' Gambas class file
  2.  
  3. Public Sub _new()
  4.  
  5. End
  6.  
  7. Public Sub Form_Open()
  8.  
  9.   ButtonTexto.Drop = True
  10.   PictureBox1.Drop = True
  11.  
  12.   TextArea1.Wrap = True 'para que el texto mas ancho que el control se escriba completo
  13.   PictureBox1.border = Border.Plain
  14.   PictureBox1.Stretch = True 'la imagen se adapta al picturebox
  15.  
  16. End
  17.  
  18. Public Sub PictureBox1_Drop()
  19.  
  20.   arrastreImagen(PictureBox1)
  21.  
  22. End
  23.  
  24. Public Sub ButtonTexto_Drop()
  25.  
  26.   Dim ruta As String
  27.  
  28.   ruta = TomaArchivosSoltados((Drag.Paste("text/uri-list")))
  29.   Try TextArea1.text = File.Load(ruta)
  30.   If Error Then
  31.     Message.Info("Se ha producido un error al leer el archivo")
  32.   Endif
  33.  
  34. End
  35.  
  36. '-------------------------------------------------------------
  37. 'subrutinas necesarias para extraer la ruta del fichero
  38. '-------------------------------------------------------------
  39. Private Sub arrastreImagen(pic As PictureBox)
  40.  
  41.   Dim ruta As String
  42.  
  43.   ruta = TomaArchivosSoltados((Drag.Paste("text/uri-list")))
  44.  
  45.   Try Pic.Picture = Picture.Load(ruta)
  46.   If Error Then
  47.     Message.Info("Se ha producido un error al leer el archivo")
  48.   Endif
  49.  
  50. End
  51.  
  52. Public Sub TomaArchivosSoltados(ruta As String) As String
  53.  
  54.   ruta = Replace(ruta, "\n", "")
  55.   ruta = Replace(ruta, "\r", "")
  56.   ruta = Right$(ruta, -7)  'Quitamos el file://
  57.   ruta = ConvierteRuta(ruta) 'Decodificamos de html a ruta entendible
  58.   ruta = Replace(ruta, "\x00", "") 'ese caracter me da problemas
  59.   Return ruta
  60.  
  61. End
  62.  
  63. Private Function ConvierteRuta(txt As String) As String
  64.   ''' Función de jguardon en gambas-es
  65.   ''' Descodifica los caracteres hexadecimales en las URI's recorriendo la cadena dada
  66.   ''' Params: txt la URI a descodificar
  67.   ''' Return: la URI descodificada
  68.  
  69.   Dim txt_len As Integer
  70.   Dim i As Integer
  71.   Dim ch As String
  72.   Dim digits As String
  73.   Dim resultado As String
  74.  
  75.   resultado = ""
  76.   txt_len = Len(txt)
  77.   i = 1
  78.   Do While i <= txt_len
  79.     ' Examinar el siguiente caracter
  80.     ch = Mid$(txt, i, 1)
  81.     If ch = "+" Then
  82.       ' Convertir a espacio
  83.       resultado = resultado & " "
  84.     Else If ch <> "%" Then
  85.       ' Normal, no cambiar
  86.       resultado = resultado & ch
  87.     Else If i > txt_len - 2 Then
  88.       resultado = resultado & ch
  89.     Else
  90.       ' Obtener los siguientes caracteres hex.
  91.       digits = Mid$(txt, i + 1, 2)
  92.       ' Debug digits
  93.       ' aquí convertimos el valor hexadecimal a entero y
  94.       ' se lo pasamos a Chr que devuelve el carácter correcto.
  95.       resultado = resultado & Chr$(CInt(Val("&" & digits)))
  96.       i = i + 2
  97.     Endif
  98.     i = i + 1
  99.   Loop
  100.  
  101.   Return resultado
  102.  
  103. End
Advertisement
RAW Paste Data Copied
Advertisement