Crear un Objeto

Crear un Objeto

Postby colthop » Tue Sep 17, 2013 12:00 pm

Hola a todos:

Voy a ver si me explico, con el siguiente código lo que hago es poner un código de barras en una ventana, lo capturo y luego creo un JPG. Pero la calidad de la imagen no es la correcta para imprimirla y que los lectores de códigos la identifiquen correctamente.

Code: Select all  Expand view  RUN
function CodigoBarras (zCodFin,zCodCon)
va150 = "{" + zCodFin  + zCodCon + chr(126)
// Creo la ventana oDlgwBro
CreaBrow( 72,600)
DEFINE FONT oFona NAME "Code 128AB" SIZE  15, 72
@ 2,20 SAY va150 OF oDlgwBro PIXEL COLOR RGB(  0,  0,  0), RGB (255,255,255) FONT oFona SIZE 600,72
SysRefresh()

#define SRCCOPY 13369376
hDC := oDlgwBro:GetDC()
hDCMem  = CreateCompatibleDC( hDC )
hBmpMem := CreateCompatibleBitmap( hDC, 600,  72 )
hOldBmp := SelectObject( hDCMem, hBmpMem )
BitBlt( hDCMem, 0, 0, 600,  72, hDC, 0, 0, SRCCOPY )

hDib := DibFromBitmap( hBmpMem )
cTempFile := cTempFile()
DibWrite( cTempFile, hDib )
GloBalFree( hDib )
lSaved = FISaveImg( cTempFile, "Text.jpg", 2, 25 )
FErase( cTempFile )

SelectObject( hDCMem, hOldBmp )
DeleteDC( hDCMem )
oDlgwBro:ReleaseDC()
DeleteObject( hBmpMem)
oDlgwBro:Hide()
oDlgwBro:Destroy()
RETURN (zCodfin)

static function FISAVEIMG( cSrcFile, cDstFile, nDstFormat, nQuality )
local nSrcFormat, hDib, hDib2, lOk := .f.
DEFAULT nQuality := 0
if LoadFreeImage() > 32
   nSrcFormat = FIGETFILETYPE( cSrcFile, 0 )
   hDib = FILOAD( nSrcFormat, cSrcFile, 0 )
   hDib2 = FICNV24( hDib )
   lOk = FISAVE( nDstFormat, hDib2, cDstFile, nQuality )
   FIUNLOAD( hDib )
   FIUNLOAD( hDib2 )
endif
return lOk


Mi pregunta es la siguiente:

Lo primero que hago es crear una ventana y en ella escribir con un SAY en ella el código de barras, después lo capturo y lo pongo en un objeto para crear un archivo JPG y cerrar todo. Yo podría escribir directamente el código de barras en un objeto, para no tener que capturarlo de pantalla, y después con ese objeto crear el JPG.

Por favor ayuda, gracias

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
 
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: Crear un Objeto

Postby Antonio Linares » Tue Sep 17, 2013 1:27 pm

Carlos,

El bitmap lo puedes crear en memoria, y dibujar en él lo que desees, asi:

Code: Select all  Expand view  RUN
function BuildBitmap( nWidth, nHeight )

   local hDC   := GetDC( 0 )
   local hDC2 := CreateCompatibleDC( hDC )
   local hBmp := CreateCompatibleBitMap( hDC, nWidth, nHeight )
   local hBmpOld := SelectObject( hDC2, hBmp )
   
   // Paint using hDC2

   SelectObject( hDC2, hBmpOld )
   DeleteDC( hDC2 )
   ReleaseDC( 0, hDC )

return hBmp
 


Para guardarlo en un fichero, primero tenemos que pasarlo a DIB de esta forma:

hDib = DibFromBitmap( hBmp )

lo escribimos en un fichero:
DibWrite( cNombreFichero, hDib )

Liberamos la memoria del DIB:
GlobalFree( hDib )

y liberamos la memoria del bitmap:
DeleteObject( hBmp )
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42203
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: Crear un Objeto

Postby colthop » Tue Sep 17, 2013 1:48 pm

Hola Antonio:

Entiendo lo que me dices y es lo que hago pero crear el Bitmap en memoria de una captura de parte de una ventana de pantalla la calidad de la salida no es muy buena o por lo menos yo no se hacerlo para que lo sea, Yo pregunto que si se puede crear directamente el Bitmap en memoria del objeto que se pinta en pantalla sin escribirlo o sin capturarlo de lo escrito, vamos cuando hacemos una ventana y pintamos un SAY creamos un objeto con la información, esa información valdría para hacer el Bipmap en memoria y sería igual a lo que pinta en la ventana.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
 
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: Crear un Objeto

Postby cnavarro » Tue Sep 17, 2013 2:26 pm

Carlos, por si te puede servir
Yo lo que hago es imprimirlos directamente a pantalla, utilizando el preview, y siempre me han salido perfectas, incluso puedo grabar el emf, como bien sabes.
Un ejemplo:
Image
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6552
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Crear un Objeto

Postby colthop » Tue Sep 17, 2013 3:48 pm

Hola cnavarro:

Como puedo saber como se llama el archivo EMF que crea la preview.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
 
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: Crear un Objeto

Postby AngelSalom » Tue Sep 17, 2013 3:59 pm

Teniendo oPreview como objeto de previsualización :

Code: Select all  Expand view  RUN
Eval( oPreview:oDevice:aMeta, { |cMeta| Msginfo( cMeta ) } )
Angel Salom
Visionwin Software - https://www.visionwin.com
------------------------------------------------------------
fwh 19.05 - harbour 3.2 - bcc 7.4
User avatar
AngelSalom
 
Posts: 727
Joined: Fri Oct 07, 2005 7:38 am
Location: Benicarló (Castellón ) - España

Re: Crear un Objeto

Postby cnavarro » Tue Sep 17, 2013 4:08 pm

colthop wrote:Hola cnavarro:

Como puedo saber como se llama el archivo EMF que crea la preview.

Un saludo

Carlos


O bien, puedes añadir a tu rpreview un campo para grabarlo con el nombre que consideres, o cargar uno que tengas grabado

Code: Select all  Expand view  RUN

METHOD BuildWindow() CLASS TPreview
.../...
     cFichEmf := Space(20)
     @ 7, 760+60 SAY "Fichero.: " PIXEL OF ::oBar FONT ::oFont
     @ 4, 810+60 GET oGetFich VAR cFichEmf PICTURE "@X" ;
          SIZE 140, 20 PIXEL OF ::oBar FONT ::oFont ;
          ACTION MsgInfo(" Cargar Fichero ? ") ;
          VALID ( ::GrabaTmp( oGetFich , ::nPage , ::oDevice:aMeta ) )
.../...

// Esta es una posibilidad
METHOD GrabaTmp( oGet , nPage , aFichs ) CLASS TPreview
Local lSw := .t.
Local cFich  := ""
Local cFich1 := ""
if !empty( oGet ) .and. Valtype( oGet ) = "O"
  //if Len( aFichs ) = 1
   cFich := oGet:VarGet()
   if cFich <> MiFileName(aFichs[ nPage ])   // Se ha modificado el nombre
      cFich1 := Alltrim(cFich)+StrZero( nPage, 4)+".bmp"
      cFich  := Alltrim(cFich)+StrZero( nPage, 4)+".emf" //".wmf"
      if MsgYesNo("Desea Grabar la Página Actual?","Grabar en Fichero")
         if !File( cFich )
            __CopyFile( aFichs[ nPage ] , cFich )
            DibWrite( cFich1, DibFromBitmap( WndBitmap( ::oMeta1:hWnd ) ) )
         else
            if MsgYesNo("El fichero destino existe, ¿Susituir?","Atencion")
               __CopyFile( aFichs[ nPage ] , cFich )
               DibWrite( cFich1, DibFromBitmap( WndBitmap( ::oMeta1:hWnd ) ) )
            endif
         endif
      else
        cFich := MiFileName(aFichs[ nPage ])
        oGet:VarPut( cFich )
        oGet:EditUpdate()
        oGet:Refresh()
      endif
   endif
  //else

  //endif
else
   MsgInfo("No hay Fichero Definido")
   lSw := .f.
endif
Return lSw

 


Cristobal
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6552
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Crear un Objeto

Postby colthop » Tue Sep 17, 2013 5:48 pm

Disculpar mi torpeza pero no me entra:

Vamos a ver. Yo hago esta impresión:

Code: Select all  Expand view  RUN

va150 = "HOLA"
PRINT oPrn PREVIEW
DEFINE FONT oFont1 NAME "Code 128AB" SIZE 0, 15 BOLD OF oPrn
PAGE
oPrn:Say( 1,  2,va150 ,ofont1)
ENDPAGE
ENDPRINT


Como se en este ejemplo el nombre del archivo EMF que crea el PREVIEW.

Gracias

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
 
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: Crear un Objeto

Postby cnavarro » Tue Sep 17, 2013 6:18 pm

colthop wrote:Disculpar mi torpeza pero no me entra:

Vamos a ver. Yo hago esta impresión:

Code: Select all  Expand view  RUN

va150 = "HOLA"
PRINT oPrn PREVIEW
DEFINE FONT oFont1 NAME "Code 128AB" SIZE 0, 15 BOLD OF oPrn
PAGE
oPrn:Say( 1,  2,va150 ,ofont1)
ENDPAGE
ENDPRINT


Como se en este ejemplo el nombre del archivo EMF que crea el PREVIEW.

Gracias

Carlos


Estara en oPrn:aMeta[1], si no me equivoco

Prueba esto directamente:

Code: Select all  Expand view  RUN

#include "fivewin.ch"
#include "print.ch"


Function Main()
Local oFont1
Local oPrn
Local va150 := "HOLA"
PRINT oPrn PREVIEW
DEFINE FONT oFont1 NAME "Code 128AB" SIZE 0, 15 BOLD OF oPrn
PAGE
oPrn:Say( 1,  2,va150 + "  "+ oPrn:aMeta[1] ,ofont1)
ENDPAGE
ENDPRINT
oFont1:End()

Return nil
 
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6552
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Crear un Objeto

Postby cnavarro » Tue Sep 17, 2013 6:53 pm

Incluso, se me ocurre que, con un poco de trabajo, se podria diseñar un buildwindow de la clase TPreview para adaptarlo a un espacio de pantalla definido por ti (por ejemplo un TPanel), pero hay que probarlo.
Claro, modificando la clase
Es una idea.
Saludos
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6552
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Re: Crear un Objeto

Postby Antonio Linares » Tue Sep 17, 2013 7:17 pm

Carlos,

La función que te he mostrado crea un bitmap en memoria, sin que tengas que capturar nada de la pantalla.

Al crear el bitmap, dibujas, escribes, etc en él y luego lo salvas a disco, etc.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42203
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: Crear un Objeto

Postby colthop » Tue Sep 17, 2013 8:47 pm

Hola y gracias a todos.

Voy a probar lo del EMF.

Antonio como he dicho antes soy un poco torpe tu me has dicho que para hacerlo tengo que crear este código:

Code: Select all  Expand view  RUN

   local hDC   := GetDC( 0 )
   local hDC2 := CreateCompatibleDC( hDC )
   local hBmp := CreateCompatibleBitMap( hDC, nWidth, nHeight )
   local hBmpOld := SelectObject( hDC2, hBmp )
   
   // Paint using hDC2

   SelectObject( hDC2, hBmpOld )
   DeleteDC( hDC2 )
   ReleaseDC( 0, hDC )

 


Entonces supongo que donde pones "// Paint using hDC2" es que tengo que poner lo que quiero escribir en este caso
podría poner :

@ 70, 10 SAY "Hola" OF hCD2 FONT oFont SIZE 150,20

para escribir lo que desee.

Un saludo

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
 
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: Crear un Objeto

Postby colthop » Wed Sep 18, 2013 7:53 am

Hola y gracias a todos:

Sigo con el proceso lo tengo en dos partes:

La primera es al del EMF y aquí tengo el problema de cerrar la PREVIEW después de capturar el EMF que aunque cierro el oPrn esta no se cierra.

La segunda es la de Antonio he creado el archivo y le he dado el tamaño que quiero pero lo que no he conseguido es imprimir el SAY por mas que pruebo siempre me da un error NUMERIC.

He puesto

Code: Select all  Expand view  RUN

   hDC     := GetDC( 0 )
   hDC2    := CreateCompatibleDC( hDC )
   hBmp    := CreateCompatibleBitMap( hDC, 600, 80 )
   hBmpOld := SelectObject( hDC2, hBmp )

   // Paint using hDC2
   DEFINE FONT oFona NAME "Code 128AB" SIZE  12, 72
   @ 2,20 SAY va150 OF hDC2 PIXEL COLOR RGB(  0,  0,  0), RGB (255,255,255) FONT oFona SIZE 600,72

   hDib      := DibFromBitmap( hBmp )
   cTempFile := cTempFile()
   DibWrite( cTempFile, hDib )
   GloBalFree( hDib )
   lSaved = FISaveImg( cTempFile, "Text.jpg", 2, 25 )
   FErase( cTempFile )

   SelectObject( hDC2, hBmpOld )
   DeleteDC( hDC2 )
   ReleaseDC( 0, hDC )


Si quito la línea de @ SAY me crea el archivo y todo perfecto pero si la pongo me da el error NUMERIC. Supongo es que no se cual es el OF o si se pone así. Ayuda por favor.

Carlos
Colt Hop ED, S.L.
Carlos Blas Fernández Domínguez
Tlfo: 645847093
E-Mail: carlos@colthop.es

Nunca se termina de aprender, por eso necesito siempre ayuda.
colthop
 
Posts: 505
Joined: Sat Apr 22, 2006 9:09 am
Location: Madrid - España

Re: Crear un Objeto

Postby Antonio Linares » Wed Sep 18, 2013 10:07 am

Carlos,

Un hDC es un handle de "device context" y no es un control del que puedas crear un objeto SAY.

Puedes usarlo asi, por ejemplo:

TextOut( hDC2, 10, 10, "Hola" )

Es decir, solo puedes usar las funciones de pintado que admiten hDC como parámetro.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42203
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: Crear un Objeto

Postby cnavarro » Wed Sep 18, 2013 10:53 am

Carlos

La primera es al del EMF y aquí tengo el problema de cerrar la PREVIEW después de capturar el EMF que aunque cierro el oPrn esta no se cierra.

No entiendo lo que quieres hacer: presentar el preview, que grabe la imagen y que se cierre automaticamente?
Puedes explicar un poco?

La segunda es la de Antonio he creado el archivo y le he dado el tamaño que quiero pero lo que no he conseguido es imprimir el SAY por mas que pruebo siempre me da un error NUMERIC

Tal y como te comenta Antonio, algunas de las funciones que puedes usar son (estas son las que yo he utilizado alguna vez):
Code: Select all  Expand view  RUN

 SetTextColor( hDC, nCSel )
 
 SetBkColor( hDC, nColor  )

 hOldFont = SelectObject( hDC, oFont1:hFont )

 TextOut( hDC, 10, 10, "Hola" )

// o
 
 DrawText( hDC, cText, aCoors )

// o

 DrawTextEx( hDC, cText, aCoors, DT_LEFT + DT_VCENTER )

 SelectObject( hDC, hOldFont )

 
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
User avatar
cnavarro
 
Posts: 6552
Joined: Wed Feb 15, 2012 8:25 pm
Location: España

Next

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 22 guests

cron