Cargar BMP en un formulario

Aplicaciones de código fuente abierto para descargar

Cargar BMP en un formulario

Notapor ErikH » Mar Dic 04, 2007 11:15 pm

Este programa dibuja un BMP directamente en una ventana
y puede volver a guardar lo que este dibujado en la ventana
Lo malo es que las imagenes se borran al mover la ventana fuera de
los limites del escritorio o si quedan detras de otra ventana,
Como la de Guardar :P


Código: Seleccionar todo
$ADV-
Importar "PauscalW.prp"
Clase c_Frm_MuestraBMP(pscForm)
Público:

  ClaseVar _
    m_OpcArchivo:pscMenu
  ClaseVar _
    Abrirya:pscMenuItem, _
    Guardar:pscMenuItem, _
    OutofForm:pscMenuItem

Privado:
  Proc Init
    X=0
    Y=0
    Ancho=500
    Alto=500
    Texto="Cargar Imagen..."
    Visible=Verd
    Habilitado=Verd
    PuedeCambiarDeTamaño=Verd
    BotonMaximizar=Verd
    BotonMinimizar=Verd
    MenuSistema=Verd
    Centrar=Falso
    Borde=Verd
    Eval Eventos
    FinEval
    CrearForm
    Crear m_OpcArchivo
    Eval m_OpcArchivo
      .NuevoItem
      Abrirya=.Items[0]
      .Items[0].Texto="&Cargar Imagen"
      .Items[0].Eventos.AlSeleccionar@=f0_Abrirya_AlSeleccionar@
      .NuevoItem
      Guardar=.Items[1]
      .Items[1].Texto="&Guardar como..."
      .Items[1].Eventos.AlSeleccionar@=f0_Guardar_AlSeleccionar@
      .NuevoItem
      OutofForm=.Items[2]
      .Items[2].Texto="&Salir"
      .Items[2].Eventos.AlSeleccionar@=f0_OutofForm_AlSeleccionar@
    FinEval
  FinProc
Público:
  Proc CargarForm
    Si (hWnd=0)
      Init
      m_OpcArchivo.CargarMenu(hWnd)
      FormCargado
    FinSi
  FinProc
  Proc Mostrar(Opcional EsModal:Booleano)
    CargarForm
    Si (EsModal) MostrarModalInt; SiNo; MostrarInt
  FinProc

'Eventos

  Proc Abrirya_AlSeleccionar() Adelantado
  Proc Guardar_AlSeleccionar() Adelantado
  Proc OutofForm_AlSeleccionar() Adelantado
  Proc DevolverbyteEntero(EnteroEntrada,IndiceByte:Entero):Byte Adelantado


FinClase

'Alias

Proc f0_Abrirya_AlSeleccionar()
  Frm_MuestraBMP.Abrirya_AlSeleccionar
FinProc
Proc f0_Guardar_AlSeleccionar()
  Frm_MuestraBMP.Guardar_AlSeleccionar
FinProc
Proc f0_OutofForm_AlSeleccionar()
  Frm_MuestraBMP.OutofForm_AlSeleccionar
FinProc


Var Frm_MuestraBMP:c_Frm_MuestraBMP

Proc CicloPrincipal
  Crear Frm_MuestraBMP
  Frm_MuestraBMP.CargarForm
  Frm_MuestraBMP.Mostrar
  Programa.Ejecutar
FinProc


'**************************************************

'Código de eventos y procedimientos
'definidos por el usuario

Proc c_Frm_MuestraBMP.Abrirya_AlSeleccionar()
'------Codigo para abrir imagen------------
Var Imagen[],ImagenCargar[]:Byte
Var pixAlto,pixAncho,offset,puntoy,puntox,p1,p2,p3,ExcesoBytes,controla:Entero
Var Archivo:pscArchivo
Var Dialogo:pscDialogo
Crear Dialogo
Dialogo.Filtro  = "Mapa de bits (*.bmp)|*.bmp"
Dialogo.Título  = "Abrir..."
Si(Dialogo.MostrarAbrir()=Falso)Salir

Borrar ImagenCargar
Borrar Imagen
Archivo = Nuevo pscArchivo
Archivo.Nombre = dialogo.archivo
Archivo.Abrir(0)
Redim Preservar Imagen, Archivo.Tamaño
Archivo.Leer(Imagen[0]@, Archivo.Tamaño)
Archivo.Cerrar

Si(Imagen[28]=24)
'Este codigo se ejecuta si la profundidad de color de
'La imagen es de 24 bits
pixAncho=(Imagen[18])+(Imagen[19]*(2^8))+(Imagen[20]*((2^8)^2))+(Imagen[21]*((2^8)^3))
pixAlto=(Imagen[22])+(Imagen[23]*(2^8))+(Imagen[24]*((2^8)^2))+(Imagen[25]*((2^8)^3))
offset=(Imagen[10])+(Imagen[11]*(2^8))+(Imagen[12]*((2^8)^2))+(Imagen[13]*((2^8)^3))

ExcesoBytes = pixAncho Mod 4
'si el ancho no es divisible exactamente
'entre 4 se le agregan bytes al final
'de cada linea iguales al residuo
'Estos Bytes extra valen 0 y no
'forman parte de la imagen

Contar puntoy = pixAlto a 1 Dec
 Contar puntox = 1 a pixAncho
 Si(offset+2<=LongMat(Imagen)-1)
  p1 = Imagen[offset]   'Byte Azul
  p2 = Imagen[offset+1] 'Byte Verde
  p3 = Imagen[offset+2] 'Byte Rojo
  ZonaDibujo.PonerPixel(puntox, puntoy, RGB(p3,p2,p1))
  Si(puntox=pixAncho)
    offset = offset + 3 + ExcesoBytes
  SiNo
    offset = offset + 3
  FinSi
 FinSi
 Seguir
Seguir
SiNo
Mensaje("Solo Imagenes de 24 bits")
FinSi
FinProc

Proc c_Frm_MuestraBMP.Guardar_AlSeleccionar()
'-----Codigo para guardar BMP de 24 Bits-------------
Var R,G,B, Data[]:Byte
Var px,py,s, IWidth,IHeight:EnteroSig, Archivo:PscArchivo
Var ExcesoBytes,tamaño_en_Bytes_de_imagen,tamaño_en_Bytes_de_encabezado,Longitud_Data:Entero
Var a:Entero, Dialogo:pscDialogo

'------------------------------------------------
IWidth  = 400  'Ancho de la imagen a guardar
IHeight = 400  'Alto de la imagen a guardar
'------------------------------------------------
Crear Dialogo
Dialogo.Filtro  = "Mapa de bits (*.bmp)|*.bmp|Todos los archivos (*.*)|*.*"
Dialogo.Título  = "Guardar"
Si(Dialogo.MostrarGuardar()=Falso)Salir
ExcesoBytes = IWidth Mod 4
tamaño_en_Bytes_de_imagen = (IWidth*IHeight*3)+ (ExcesoBytes*IHeight)
tamaño_en_Bytes_de_encabezado = 54
Longitud_Data=tamaño_en_Bytes_de_imagen + tamaño_en_Bytes_de_encabezado

Borrar data
s=0
Redim data,Longitud_Data

Data[0] = 66 'B
Data[1] = 77 'M
Data[2] = DevolverbyteEntero(Longitud_Data,0) 'Tamano del archivo
Data[3] = DevolverbyteEntero(Longitud_Data,1) '
Data[4] = DevolverbyteEntero(Longitud_Data,2) '
Data[5] = DevolverbyteEntero(Longitud_Data,3) '
Data[6] = 0 ' Reservado 1
Data[7] = 0 '
Data[8] = 0 ' Reservado 2
Data[9] = 0 '
Data[10] = 54 ' Numero de bytes para el comienzo de los datos de imagen(Offset)
Data[11] = 0 '
Data[12] = 0 '
Data[13] = 0 '
Data[14] = 40 ' Tamano del encabezado (40 para Win 3.1 o 12 para OS/2)
Data[15] = 0 '
Data[16] = 0 '
Data[17] = 0 '
Data[18] = DevolverbyteEntero(IWidth,0) 'Ancho en pixeles
Data[19] = DevolverbyteEntero(IWidth,1) '
Data[20] = DevolverbyteEntero(IWidth,2) '
Data[21] = DevolverbyteEntero(IWidth,3) '
Data[22] = DevolverbyteEntero(IHeight,0) 'Alto en pixeles
Data[23] = DevolverbyteEntero(IHeight,1) '
Data[24] = DevolverbyteEntero(IHeight,2) '
Data[25] = DevolverbyteEntero(IHeight,3) '
Data[26] = 1 ' Numero de Planos (debe ser 1)
Data[27] = 0 '
Data[28] = 24 ' Numero de bits por pixel (24 para 24 bits)
Data[29] = 0 '
Data[30] = 0 'Compresion - 0 significa sin Compresion, 1,2 son RLES
Data[31] = 0 '
Data[32] = 0 '
Data[33] = 0 '
Data[34] = DevolverbyteEntero(tamaño_en_Bytes_de_imagen,0) ' Tamano de la imagen en bytes(sin encabezado)
Data[35] = DevolverbyteEntero(tamaño_en_Bytes_de_imagen,1) '
Data[36] = DevolverbyteEntero(tamaño_en_Bytes_de_imagen,2) '
Data[37] = DevolverbyteEntero(tamaño_en_Bytes_de_imagen,3) '
Data[38] = 0 'Ancho en Pels Per Metre
Data[39] = 0 '
Data[40] = 0 '
Data[41] = 0 '
Data[42] = 0 'Alto en Pels Per Metre
Data[43] = 0 '
Data[44] = 0 '
Data[45] = 0 '
Data[46] = 0 '(0) Numero de colores usados, 0 es todos
Data[47] = 0 '
Data[48] = 0 '
Data[49] = 0 '
Data[50] = 0 '(0) Numero de colores importantes, 0 es todos
Data[51] = 0 '
Data[52] = 0 '
Data[53] = 0 '

Archivo = Nuevo PscArchivo
Archivo.Nombre = quitarextensión(dialogo.archivo)+".bmp"
Archivo.CrearNuevo(Verd)

s = tamaño_en_Bytes_de_encabezado

Contar py = IHeight a 1 Dec
  Contar px = 1 a IWidth
   ObtenerRGB(ZonaDibujo.DevolverPixel(px,py), R, G, B)

   Data[s]   = B 'Byte Azul
   Data[s+1] = G 'Byte Verde
   Data[s+2] = R 'Byte Rojo

  Si(px=IWidth)
       s = s + 3 + ExcesoBytes
  SiNo
     s = s + 3
  FinSi
  Seguir
Seguir

Archivo.Escribir(Data[0]@,LongMat(data))
Archivo.Cerrar
FinProc

Proc c_Frm_MuestraBMP.DevolverbyteEntero(EnteroEntrada,IndiceByte:Entero):Byte
'En Pauscal existe una funcion llamada EntHex
'Que convierte un numero entero a Hexadecimal
'Pero el valor devuelto es de tipo cadena
'y se requiere un valor entero para guardarlo
'como byte.
' Ejemplo: Si convertimos 3569 a hexadecimal
' obtendremos 00000DF1. Para verlo mejor
' dividamoslo en pares, en donde cada pareja
' corresponderia a un byte
' 00-00-0D-F1
' Si observamos de derecha a izquierda
' El Byte menos significativo es F1 el que le sigue
' es 0D y los ultimos dos que son los mas significativos
' tienen como valor 0
' Ahora procederemos a obtener el valor para cada
' Byte usando IndiceByte como indice
' para indicar que par de numeros
' Hexadecimal queremos, comenzando por el cero.
'         -------------------
'         Indice 3  2  1  0
'         Numero 00-00-0D-F1
'         -------------------
' Y posteriormente lo convertimos a decimal
'----------------------------------------------------------
'Creamos una matriz con los valores correspondientes
'del 0-9-A-F para compararlos con los caracteres
'que obtendremos mediante la funcion EntHex
Var ValorHex:Cadena 'Variable para guardar el Par Hexadecimal-Byte
Var MatrizCar[],retornar,ciclos:Entero
Redim MatrizCar,16
'Usando la funcion Carac() con
'los siguentes valores
'obtendremos los caracteres
'necesarios para comparar
MatrizCar[0]=48 '0
MatrizCar[1]=49 '1
MatrizCar[2]=50 '2
MatrizCar[3]=51 '3
MatrizCar[4]=52 '4
MatrizCar[5]=53 '5
MatrizCar[6]=54 '6
MatrizCar[7]=55 '7
MatrizCar[8]=56 '8
MatrizCar[9]=57 '9
MatrizCar[10]=65 'A
MatrizCar[11]=66 'B
MatrizCar[12]=67 'C
MatrizCar[13]=68 'D
MatrizCar[14]=69 'E
MatrizCar[15]=70 'F

'Ahora Obtendremos el par de letras en hexadecimal
'que corresponden a un Byte

ValorHex = ParteCad(EntHex(EnteroEntrada,Verd),7-(IndiceByte*2),2)
Contar ciclos=0 a 15
' Comparando letra por letra del 0-9 y A-F
' obtendremos el valor en decimal del numero menos significativo
' de nuestra pareja en hexadecimal
  Si(DerechaCad(ValorHex,1)=Carac(MatrizCar[ciclos]))
   retornar=ciclos
  FinSi
Seguir
Contar ciclos=0 a 15
 Si(IzquierdaCad(ValorHex,1)=Carac(MatrizCar[ciclos]))
' Ahora del mas significativo y los sumamos para finalmente
' Obtener el valor del Byte segun el indice
   retornar=retornar+(ciclos*16)
 FinSi
Seguir
Devolver retornar
FinProc

Proc c_Frm_MuestraBMP.OutofForm_AlSeleccionar()
Programa.Terminar
FinProc

CicloPrincipal
Fin


En GitHub
Código: Seleccionar todo
wget --no-check-certificate https://github.com/Erikhht/pauscal-codigo/raw/master/ErikH/Cargar-BMP-en-un-formulario.pdp
Última edición por ErikH el Sab Abr 04, 2015 7:17 pm, editado 1 vez en total
ImagenEntrá a la wiki en OpenShift
Colofox!!!!
ErikH
 
Mensajes: 151
Registrado: Jue Nov 29, 2007 11:24 pm
Ubicación: Algún lugar de México

Sponsor


Re: Cargar BMP en un formulario

Notapor Pauscal » Mar Dic 04, 2007 11:40 pm

Muy bueno!!
¿Y qué me decís de cargar JPGs? (no vale usar DLLs de terceros :lol: )
Si este proyecto te parece útil, aceptamos donaciones en Bitcoins: 1FdnaaQyVDqmhsJZw9gk41M3zUsJrDY7Hj
Pauscal
Jefe
 
Mensajes: 439
Registrado: Mar Nov 20, 2007 9:41 pm
Ubicación: Paraná, Entre Ríos, Argentina

Re: Cargar BMP en un formulario

Notapor Joe » Mié Dic 05, 2007 1:35 am

Muy bueno!
Deberiamos modificar las bibliotecas y agregar procedimiento "AlPintar" (WM_PAINT) para que redibuje la pantalla cada vez que esta sufre un cambio, porque por ejemplo al pasar otro formulario por encima se borra la imagen.

Yo ya lo realice como una prueba, y funciono a la prefeccion, no recuerdo bien como lo realice y ya no poseo los codigos, habia creado un prototipo para ese tipo de evento o algo asi, y lo habia agregado a la estructura de los eventos, y luego habia agregado este codigo (o mas o menos):
Código: Seleccionar todo
      Caso WM_PAINT
        Si (Eventos.AlPintar@) Eventos.AlPintar(wParam)

a los mensajes pasados por la aplicacion.

Tambien ahi tiene que entrar el boss para modificar el VP (el mio todavia esta muy embrion) para poder agregar este metodo ( AlPintar() ) al formulario. :roll:
La Hora 10 esta cerca. Haz el bien, haz lo que mas te gusta, por que a partir de alli todo cambiará
Joe
 
Mensajes: 130
Registrado: Mar Nov 20, 2007 11:55 pm

Re: Cargar BMP en un formulario

Notapor Pauscal » Mié Dic 05, 2007 8:27 am

Joe escribiste:el mio todavia esta muy embrion

Vos también como zafás, eh?? :lol:
Si este proyecto te parece útil, aceptamos donaciones en Bitcoins: 1FdnaaQyVDqmhsJZw9gk41M3zUsJrDY7Hj
Pauscal
Jefe
 
Mensajes: 439
Registrado: Mar Nov 20, 2007 9:41 pm
Ubicación: Paraná, Entre Ríos, Argentina

Re: Cargar BMP en un formulario

Notapor lukasg » Mié Dic 05, 2007 9:07 am

Modificaste alguna biblioteca para realizar ese código?, porque me dice que en mi biblioteca no existe PonerPixel.
lukasg
 
Mensajes: 129
Registrado: Mié Nov 21, 2007 9:41 am
Ubicación: Santa Fe, Argentina

Re: Cargar BMP en un formulario

Notapor Joe » Mié Dic 05, 2007 7:34 pm

pguerra escribiste:
Joe escribiste:el mio todavia esta muy embrion

Vos también como zafás, eh?? :lol:

:roll:
La Hora 10 esta cerca. Haz el bien, haz lo que mas te gusta, por que a partir de alli todo cambiará
Joe
 
Mensajes: 130
Registrado: Mar Nov 20, 2007 11:55 pm

Re: Cargar BMP en un formulario

Notapor ErikH » Jue Dic 06, 2007 11:29 pm

:shock: JPG' S sin DLL . Ni idea de donde empezar

Las bibliotecas que uso estaban en el otro foro, no me acuerdo quien las posteo, De quien eran? :roll: , pero aqui estan de todas maneras
Adjuntos
Biblioteca Pauscal (Mod).zip
Bibliotecas Con ObtenerPixel Y PonerPixel
(54.05 KiB) 335 veces
ImagenEntrá a la wiki en OpenShift
Colofox!!!!
ErikH
 
Mensajes: 151
Registrado: Jue Nov 29, 2007 11:24 pm
Ubicación: Algún lugar de México

Re: Cargar BMP en un formulario

Notapor Joe » Vie Dic 07, 2007 12:22 am

jajajaja las subi yo, en el foro anterior, la verdad no tenia idea que alguien las usaba :D jajajaja
La Hora 10 esta cerca. Haz el bien, haz lo que mas te gusta, por que a partir de alli todo cambiará
Joe
 
Mensajes: 130
Registrado: Mar Nov 20, 2007 11:55 pm

Re: Cargar BMP en un formulario

Notapor lukasg » Vie Dic 07, 2007 9:19 am

ErikH escribiste::shock: JPG' S sin DLL . Ni idea de donde empezar

Las bibliotecas que uso estaban en el otro foro, no me acuerdo quien las posteo, De quien eran? :roll: , pero aqui estan de todas maneras


Me baje las bibliotecas, pero al intentar precompilarlas en muchas me saltaron errores :?: :!:
Intenta revisarlas, o estaría bueno que subas los archivos precompilados.
lukasg
 
Mensajes: 129
Registrado: Mié Nov 21, 2007 9:41 am
Ubicación: Santa Fe, Argentina

Re: Cargar BMP en un formulario

Notapor Pauscal » Vie Dic 07, 2007 12:19 pm

Probablemente te hayas equivocado en el orden de compilación. Esas bibliotecas están altamente relacionadas, y muchas son dependientes de otras, por lo que el orden es muy importante.
En estos casos conviene distribuir (además del código fuente de las bibliotecas) un archivo .lst para realizar una compilación por lotes. Estos archivos se administran desde el menú Herramientas/Compilación por lotes.. desde el editor de Pauscal (por ahora esta opción no se encuentra en el editor beta; sólo en el original).
Si este proyecto te parece útil, aceptamos donaciones en Bitcoins: 1FdnaaQyVDqmhsJZw9gk41M3zUsJrDY7Hj
Pauscal
Jefe
 
Mensajes: 439
Registrado: Mar Nov 20, 2007 9:41 pm
Ubicación: Paraná, Entre Ríos, Argentina

Siguiente

Volver a Código Abierto

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 2 invitados

cron