Crear un Objeto

[colthop]

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

[Antonio Linares]

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 )

[colthop]

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

[cnavarro]

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:

[colthop]

Hola cnavarro:

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

Un saludo

Carlos

[AngelSalom]

Teniendo oPreview como objeto de previsualización :

Code: Select all  Expand view  RUN

Eval( oPreview:oDevice:aMeta, { |cMeta| Msginfo( cMeta ) } )

[cnavarro]

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

[colthop]

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

[cnavarro]

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
 

[cnavarro]

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

[Antonio Linares]

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.

[colthop]

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

[colthop]

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

[Antonio Linares]

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.

[cnavarro]

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 )