Código de Barras por pantalla.

Post Reply
FiveWiDi
Posts: 910
Joined: Mon Oct 10, 2005 2:38 pm

Código de Barras por pantalla.

Post by FiveWiDi »

Hola a todos,

Aquí les dejo unos ficheros para quien quiera ver códigos de barra por pantalla, ya sea bajo WINDOW o en un DIALOG.

Es una adaptación de la librería Barlib de Cayetano, y precisa de ella para el cálculo del código de barras.

Seguro que se pude mejorar mucho, pero ahora ya muestra los códigos de barra por pantalla.

Código de Barras por pantalla.

http://www.mediafire.com/file/yijnmtjnznj/BarCodeW.rar

Saludos
Carlos G.
Un Saludo
Carlos G.

FiveWin 19.06 + Harbour 3.2, BCC 7 Windows 10
Vladimir Zorrilla
Posts: 225
Joined: Tue Feb 28, 2006 4:25 pm
Location: PERU

Re: Código de Barras por pantalla.

Post by Vladimir Zorrilla »

amigo

falta la funcion ncm2pixels y muchas mas

GRACIAS
ME INTERESA FW Y XHB POR SER OPEN SOURCE
FiveWiDi
Posts: 910
Joined: Mon Oct 10, 2005 2:38 pm

Re: Código de Barras por pantalla.

Post by FiveWiDi »

Vladimir Zorrilla wrote:amigo

falta la funcion ncm2pixels y muchas mas

GRACIAS
Aquí van algunas:

Code: Select all

#include "FiveWin.ch"

#define HORZSIZE          4
#define VERTSIZE          6
#define HORZRES           8
#define VERTRES          10
#define LOGPIXELSX       88
#define LOGPIXELSY       90


/* ****************************************************************************
Funciones para convertir PIXEL a Twip/Pulgadas/Centímetros y viceversa.

hDC -> oWnd:hDC or oPrn:hDC

   ************************************************************************* */

/* ******************************************************* */
FUNCTION nPixels2Twips( hDC, nPixels, lVertical )
Return (nPixels / GetDeviceCaps( hDC, If(lVertical, LOGPIXELSY, LOGPIXELSX) ) ) * 1440
/* ******************************************************* */
FUNCTION nTwips2Pixels( hDC, nTwips, lVertical )
Return (nTwips / 1440) * GetDeviceCaps( hDC, If(lVertical, LOGPIXELSY, LOGPIXELSX) )
/* ******************************************************* */
FUNCTION nPixels2Inches( hDC, nPixels, lVertical )
Return (nPixels / GetDeviceCaps( hDC, If(lVertical, LOGPIXELSY, LOGPIXELSX) ) )
/* ******************************************************* */
FUNCTION nInches2Pixels( hDC, nInches, lVertical )
Return (nInches * GetDeviceCaps( hDC, If(lVertical, LOGPIXELSY, LOGPIXELSX) ) )
/* ******************************************************* */
FUNCTION nPixels2Cm( hDC, nPixels, lVertical )
Return nPixels2Inches( hDC, nPixels, lVertical ) * 2.54
/* ******************************************************* */
FUNCTION nCm2Pixels( hDC, nCm, lVertical )
Return nInches2Pixels( hDC, (nCm / 2.54), lVertical )
/* ******************************************************* */
FUNCTION uCm2Pixels( HdC, nCmy, nCmx )
nCmy := nCm2Pixels( hDC, nCmy, .T. )
nCmx := nCm2Pixels( hDC, nCmx, .F. )
Return Nil
 
Recuerda que te hará falta la Barlib de Cayetano.

Que otras funciones faltan?

Saludos
Carlos G.
Un Saludo
Carlos G.

FiveWin 19.06 + Harbour 3.2, BCC 7 Windows 10
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: Código de Barras por pantalla.

Post by Antonio Linares »

Carlos,

Gracias por tu contribución. Copiemos aqui los ficheros pues mediafire se cancela despues de un tiempo,

BARCODEW.CH

Code: Select all


#ifndef _BARCODE_
#define _BARCODE_

#translate @ <nRow>, <nCol> CODE128W  <cCode> ;
                [ MODE <cMode>] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, <cMode>, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "CODE128", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_CODE128W  <cCode> ;
                [ MODE <cMode>] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, <cMode>, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "CODE128", <.design.>, .F. )

#translate @ <nRow>, <nCol> CODE3_9W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "CODE3_9", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_CODE3_9W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "CODE3_9", <.design.>, .F. )

#translate @ <nRow>, <nCol> EAN13W  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "EAN13", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_EAN13W  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "EAN13", <.design.>, .F. )

#translate @ <nRow>, <nCol> UPCAW  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "UPCA", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_UPCAW  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "UPCA", <.design.>, .F. )

#translate @ <nRow>, <nCol> EAN8W  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "EAN8", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_EAN8W  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "EAN8", <.design.>, .F. )

#translate @ <nRow>, <nCol> SUP5W  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "SUP5", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_SUP5W  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                         "SUP5", <.design.>, .F. )

#translate @ <nRow>, <nCol> CODABARW  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "CODABAR", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_CODABARW  <cCode> ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         Nil, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "CODABAR", <.design.>, .F. )

#translate @ <nRow>, <nCol> INT25W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "INT25", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_INT25W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "INT25", <.design.>, .F. )

#translate @ <nRow>, <nCol> IND25W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "IND25", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_IND25W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "IND25", <.design.>, .F. )

#translate @ <nRow>, <nCol> MAT25W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "MAT25", <.design.>, .T. )

#translate @ <nRow>, <nCol> CM_MAT25W  <cCode> ;
                [ <lCheck:CHECK> ] ;
                [ <lVert:VERTICAL> ];
                [ COLOR <nColor> ] ;
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ OF <oWnd>] ;
                [ <design:DESIGN>] ;
                => ;
        TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                         <.lCheck.>, Nil, <nColor>, .not. <.lVert.>, ;
                         <nWidth>, <nSize>, Nil, Nil, ;
                         "MAT25", <.design.>, .F. )

#ENDIF



/* ***************************************************************************************** */


#translate @ <nRow>, <nCol> BARCODEW [ <oBarCodeW> PROMPT ] <cCode> ;
                [ <predef: CODE128, CODE3_9, EAN13, UPCA, EAN8, SUP5, ;
                           CODABAR, INT25, IND25, MAT25> ] ;
                [ OF <oWnd>] ;
                [ <lCheck:CHECK> ] ;
                [ MODE <cMode>] ;
                [ COLOR <nColor> ] ;
                [ <lVert:VERTICAL> ];
                [ WIDTH <nWidth> ] ;
                [ SIZE <nSize> ] ;
                [ <lBanner:BANNER> ] ;
                [ FONT <cFont> ] ;
                [ <design: DESIGN >  ] ;
                [ <lPixel: PIXEL, PIXELS > ] ;
                => ;
        <oBarCodeW> := TBarCodeW():New( <nRow>, <nCol>, <cCode>, <oWnd>, ;
                                        <.lCheck.>, <cMode>,<nColor>, .not. <.lVert.>, ;
                                        <nWidth>, <nSize>, <.lBanner.>, <cFont>, ;
                                        Upper(<(predef)>), <.design.>, <.lPixel.> )
 
BANNERW.PRG

Code: Select all

// labels on barcodes

#include "fivewin.ch"

FUNCTION barlen13W( cCode, oWnd, nRow, nCol, Color, lHorz, nWidth, nLen, cFont)

    Local oFont, nLenChar, l , Control, k, n, nWidthChar
Local WndhDC := 0

    default lHorz := .t.

    default nWidth := 0.025 // 1/3 M/mm

    default nLen := 1.5 // Cmm.

    default cFont := 'arial'

    default Color := CLR_BLACK

WndhDC := oWnd:GetDC()

    k:=left(alltrim(cCode)+'000000000000',12) // padding with '0'

    // calculo del digito de control
     k := k + EAN13_CHECK( k )                           // Chaeck Digit en EAN13

    If !lHorz
        //nWidth := round ( nWidth * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .T. ), 0 )
    else
        //nWidth := round  ( nWidth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .F. ), 0 )
    EndIf

    // Len of bar
    If lHorz
        //nLen := round ( nLen * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .T. ), 0 )
    Else
        //nLen := round  ( nLen * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .F. ), 0 )
    EndIf


/*
        nLenChar := nWidth*10
        nWidthChar:= nLen*0.3
        while .t.
            define font oFont name cFont of oPrInt size nLenChar , nLenChar/2 ;
                nescapement if(lHorz,0,13500)
            if oPrint:GetTextWidth( '888888', oFont )<=42*nWidth
                // alert(if(lHorz,'H:','V:')+str(nWidth*7)+str(nLenChar/(nWidth*7)))
                while .t.
                    define font oFont name cFont of oPrInt size nLenChar , nWidthChar ;
                        nescapement if(lHorz,0,13500)
                    if oPrint:GetTextHeigth( '8', oFont )<=0.2*nLen
                        alert(if(lHorz,'H:','V:')+str(nLen*0.2)+str(nWidthChar/(nLen*0.2)))
                        exit
                    else
                        nWidthChar-=0.2
                    end
                    oFont:end()
                enddo
                exit
            else
                nLenChar-=1
            end
            oFont:end()
        end
 *   nWidt -> 0.8
*/

    //DEFINE FONT oFont NAME cFont OF oPrInt SIZE nWidth * 5.6, nLen * 0.04 ;
    //            NESCAPEMENT If( lHorz, 0, 13500)

    DEFINE FONT oFont NAME cFont SIZE nWidth * 5.6, nLen * 0.24 ;
                NESCAPEMENT If( lHorz, 0, 13500)

    If lHorz
        //oPrint:say( nRow + nLen * 0.9, nCol - nWidth * 8, Left(k, 1), oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol - nWidth * 8, Left(k, 1), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * 3, Substr(k, 2, 6), oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * 3, SubStr(k, 2, 6), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * 50, Substr(k, 8, 6), oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * 50, SubStr(k, 8, 6), Color, Nil, oFont, .T., Nil, Nil )
    Else
        //oPrint:say( nRow - nWidth * 8, nCol + nLen * 0.1, Left(k, 1), oFont, , Color)
            oWnd:Say( nRow - nWidth * 8, nCol + nLen * 0.1, Left(k, 1), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nWidth * 3, nCol + nLen * 0.1, substr(k, 2, 6), oFont, , Color)
            oWnd:Say( nRow + nWidth * 3, nCol + nLen * 0.1, SubStr(k, 2, 6), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nWidth * 50, nCol + nLen * 0.1, Substr(k, 8, 6), oFont, , Color)
            oWnd:Say( nRow + nWidth * 50, nCol + nLen * 0.1, SubStr(k, 8, 6), Color, Nil, oFont, .T., Nil, Nil )
    EndIf

    RELEASE oFont

oWnd:ReleaseDC()

RETURN Nil


FUNCTION barlenW( cCode, nDigs, oWnd, nRow, nCol, Color, lHorz, nWidth, nLen, cFont)

    Local oFont, nLenChar, l ,Control,k,s1,s2,n, Izda, dCha
Local WndhDC := 0

    DEFAULT lHorz := .t.
    DEFAULT nWidth := 0.025 // 1/3 M/mm
    DEFAULT nLen := 1.5 // Cmm.
    DEFAULT cFont := 'arial'
    DEFAULT Color := CLR_BLACK
    DEFAULT nDigs := 11

WndhDC := oWnd:GetDC()

    // calculo del digito de control
    k := Left(Alltrim(cCode) + '000000000000', nDigs) // padding with '0'

    // calculo del digito de control
    k = k + Upc_CHECK(cCode, nDigs)                     // cCode,nLen

    nDigs++
    dcha := Right(K, nDigs / 2)
    izda := Left(k, nDigs / 2)

    If !lHorz
        //nWidth :=round ( nWidth * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .T. ), 0 )
    Else
        //nWidth :=round  ( nWidth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .F. ), 0 )
    EndIf

    // Len of bar
    If lHorz
        //nLen :=round ( nLen * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .T. ), 0 )
    Else
        //nLen :=round  ( nLen * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .F. ), 0 )
    EndIf

    //define font oFont name cFont of oPrInt size nWidth*5.6 , nLen*0.04 ;
    //            nescapement if(lHorz,0,13500)

    DEFINE FONT oFont NAME cFont SIZE nWidth * 5.6 , nLen * 0.24 ;
                NESCAPEMENT If(lHorz, 0, 13500)

    // fisrt letter
    If lHorz
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * 3, Izda, oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * 3, Izda, Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * ( int(nDigs) / 2 * 7 + 8), dcha, oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * ( int(nDigs) / 2 * 7 + 8), dcha, Color, Nil, oFont, .T., Nil, Nil )
    Else
        //oPrint:say( nRow + nWidth * 3, nCol + nLen * 0.1, izda, oFont, , Color)
            oWnd:Say( nRow + nWidth * 3, nCol + nLen * 0.1, izda, Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nWidth * (nDigs / 2 + 8), nCol + nLen * 0.1, dcha, oFont, , Color )
            oWnd:Say( nRow + nWidth * (nDigs / 2 + 8), nCol + nLen * 0.1, dcha, Color, Nil, oFont, .T., Nil, Nil )
    EndIf

    RELEASE oFont

oWnd:ReleaseDC()

return nil


FUNCTION ban5W( cCode, oWnd, nRow, nCol, Color, lHorz, nWidth, nLen, cFont)

    Local oFont, nLenChar, k,n, oPen
Local WndhDC := 0

    DEFAULT lHorz := .t.
    DEFAULT nWidth := 0.025 // 1/3 M/mm
    DEFAULT nLen := 1.5 // Cmm.
    DEFAULT cFont := 'arial'
    DEFAULT Color := CLR_BLACK

WndhDC := oWnd:GetDC()

    ccode := Left(Alltrim(cCode) + '000000000000', 5) // padding with '0'

    If !lHorz
        //nWidth := round ( nWidth * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .T. ), 0 )
    Else
       //nWidth := round  ( nWidth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
       nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .F. ), 0 )
    EndIf

    // Len of bar
    If lHorz
        //nLen :=round ( nLen * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .T. ), 0 )
    Else
        //nLen :=round  ( nLen * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .F. ), 0 )
    EndIf

    //define font oFont name cFont of oPrInt size nWidth*5.6 , nLen*0.04 ;
    //            nescapement if(lHorz,0,13500)
    DEFINE FONT oFont NAME cFont SIZE nWidth * 5.6 , nLen * 0.24 ;
                NESCAPEMENT If( lHorz, 0, 13500)

    //define pen oPen color CLR_WHITE of oPrint
    DEFINE PEN oPen COLOR CLR_WHITE

    k := ''
    FOR n := 1 to 4
        k += substr( cCode, n, 1) + ' '
    ENDFOR
    cCode := k + right( cCOde, 1)

    //Box( nTop, nLeft, nBottom, nRight )

    If lHorz
        //oPrint:box(nrow,ncol,nrow+nLen*.3,nCol+48*nWidth,oPen)
        Rectangle( WndhDC, nrow, ncol, nrow + nLen * .3, nCol + 48 * nWidth, oPen:hPen )
    Else
        //oPrint:box(nrow,ncol,nrow+41*nWidth,nCol+nLen*.3+48*nWidth,oPen)
        Rectangle( WndhDC, nrow, ncol, nrow + 41 * nWidth, nCol + nLen * .3 + 48 * nWidth, oPen:hPen )
    EndIf

    //oPrint:say(nRow,nCol,cCode,oFont,,Color)
    oWnd:Say( nRow, nCol, cCode, Color, Nil, oFont, .T., Nil, Nil )

    RELEASE oFont
    RELEASE oPen

oWnd:ReleaseDC()

RETURN Nil


FUNCTION UPCA_barlenW( cCode, oWnd, nRow, nCol, Color, lHorz, nWidth, nLen, cFont)

    Local oFont, nLenChar, l ,Control,k,n, Izda, dCha, nDigs:=11,oFont2
Local WndhDC := 0

    DEFAULT lHorz := .t.
    DEFAULT nWidth := 0.025 // 1/3 M/mm
    DEFAULT nLen := 1.5 // Cmm.
    DEFAULT cFont := 'arial'
    DEFAULT Color := CLR_BLACK

WndhDC := oWnd:GetDC()

    // calculo del digito de control
    k := Left(Alltrim(cCode) + '000000000000', nDigs) // padding with '0'
    // calculo del digito de control
    k = k + Upc_CHECK( cCode, nDigs)                     // cCode,nLen
    nDigs++
    dcha := Right(K, nDigs / 2)
    izda := Left(k, nDigs / 2)

    If !lHorz
        //nWidth :=round ( nWidth * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .T. ), 0 )
    Else
        //nWidth :=round  ( nWidth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nWidth := ROUND( nCm2Pixels( WndhDC, nWidth, .F. ), 0 )
    EndIf

    // Len of bar
    IF lHorz
        //nLen :=round ( nLen * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .T. ), 0 )
    Else
        //nLen :=round  ( nLen * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
        nLen := ROUND( nCm2Pixels( WndhDC, nLen, .F. ), 0 )
    EndIf

    //define font oFont name cFont of oPrInt size nWidth*5.6 , nLen*0.04 ;
    //            nescapement if(lHorz,0,13500)
    //define font oFont2 name cFont of oPrInt size nWidth*5.6 , nLen*0.025 ;
    //            nescapement if(lHorz,0,13500)

    DEFINE FONT oFont NAME cFont SIZE nWidth * 5.6 , nLen * 0.24 ;
                NESCAPEMENT If(lHorz, 0, 13500)
    DEFINE FONT oFont2 NAME cFont SIZE nWidth * 5.6 , nLen * 0.15 ;
                NESCAPEMENT If(lHorz, 0, 13500)

    // fisrt letter

    If lHorz
        //oPrint:say( nRow + nLen * 0.9, nCol - nWidth * 8, left(k, 1), oFont2, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol - nWidth * 8, Left(k, 1), Color, Nil, oFont2, .T., Nil, Nil )
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * 10, right(Izda, 5), oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * 10, Right(Izda, 5), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * 50, left( dcha, 5), oFont, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * 50, Left( Dcha, 5), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nLen * 0.9, nCol + nWidth * 95, right( k, 1), oFont2, , Color)
            oWnd:Say( nRow + nLen * 0.9, nCol + nWidth * 95, Right( k, 1), Color, Nil, oFont2, .T., Nil, Nil )
    Else
        //oPrint:say( nRow - nWidth * 8, nCol + nLen * 0.1, left(k, 1),oFont2,,Color)
            oWnd:Say( nRow - nWidth * 8, nCol + nLen * 0.1, Left(k, 1), Color, Nil, oFont2, .T., Nil, Nil )
        //oPrint:say( nRow + nWidth * 10, nCol + nLen * 0.1, right( izda, 5), oFont, , Color)
            oWnd:Say( nRow + nWidth * 10, nCol + nLen * 0.1, Right( Izda, 5), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nWidth * 50, nCol + nLen * 0.1, left( dcha, 5), oFont, , Color)
            oWnd:Say( nRow + nWidth * 50, nCol + nLen * 0.1, Left( Dcha, 5), Color, Nil, oFont, .T., Nil, Nil )
        //oPrint:say( nRow + nWidth * 95, nCol + nLen * 0.1, right( k, 1), oFont2, , Color)
            oWnd:Say( nRow + nWidth * 95, nCol + nLen * 0.1, Right( k, 1), Color, Nil, oFont2, .T., Nil, Nil )
    EndIf

    RELEASE oFont
    RELEASE oFont2

oWnd:ReleaseDC()

RETURN Nil
//
 
BARLIBW.PRG

Code: Select all

/*  Para visualizar los códigos de barra por pantalla.
    Basado en el desarrollo de Cayetano (Barlib).
    C.Gelabert 28/4/09
    ============================================== */

// funciones de llamadas de barlib
// chequean las posibles concordancias de datos
// y dan los errores

#include 'fivewin.ch'

// CODE 128

/*

    Code 128:

    Admite los 128 caracteres 0 - 127

    si s¢lo son n£meros se usa un modelo comprimido, llamado
    modo C
    Si hay caracteres < 32 se usa el m¢do A
    Si hay caracteres en minusculas se usa el modo B ( modo por defecto)

    Los modos se mezclan

    Sintaxis :

    code128W(nRow,nCol,cCode,oWnd,[cMode],[Color],
           [lOrientacion],[nAncho],[nAlto])

    nRow, nCol en Pixels
    nAncho,nAlto en Cm
*/

Function Code128W( nRow, nCol, cCode, oWnd, cMode, Color, lHorz, nWidth, nHeigth )
    // test de parametros
    // por implementar
    go_codeW( _code128(cCode,cMode), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
return nil

Function c_Code128W( nRow, nCol, cCode, oWnd, cMode, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return Code128W( nRow, nCol, cCode, oWnd, cMode, Color, lHorz, nWidth, nHeigth )


Function Code3_9W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    // test de parametros
    // por implementar
    go_codeW( _code3_9(cCode,lCheck), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
return nil

Function c_Code3_9W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth)
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return Code3_9W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )

Function ean13W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth, lBanner, cFont )
    local nLen
    // test de parametros
    // por implementar
    default nHeigth := 1.5
    default lBanner:=.f.
    // desplazamiento...
    if lHorz
        go_codeW( _ean13(cCode), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth * 0.90 )
    else
        //nLen :=round  ( nHeigth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 ) * 0.1
        nLen := round  ( nCm2Pixels( oWnd:GetDC(), nLen, .F. ), 0 ) * 0.1
        oWnd:ReleaseDC()
       // 10% espacios
            go_codeW( _ean13(cCode), nRow, nCol + nLen, oWnd, lHorz, Color, nWidth, nHeigth * 0.90 )
    end
    go_codeW( _ean13Bl(), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
    if lBanner
        barlen13W( cCode, oWnd, nRow, nCol, Color, lHorz, nWidth, nHeigth, cFont )
    end
return nil


Function c_ean13W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return ean13W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )

Function UPCAW( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth, lBanner, cFont )
    local nLen
    // test de parametros
    // por implementar
    default nHeigth := 1.5
    default lBanner:=.f.
    if lHorz
        go_codeW( _UPC(cCode), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth * 0.90 )
    else
        //nLen := round  ( nHeigth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 ) * 0.1
        nLen := ROUND( nCm2Pixels( oWnd:GetDC(), nLen, .F. ), 0 ) * 0.1
        oWnd:ReleaseDC()
       // 10% espacios
            go_codeW( _UPC(cCode), nRow, nCol + nLen, oWnd, lHorz, Color, nWidth, nHeigth * 0.90 )
    end
    go_codeW( _UPCABl(cCode), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
    if lBanner
        UPCA_barlenW( cCode, oWnd, nRow, nCol, Color, lHorz, nWidth, nHeigth, cFont )
    end
return nil


Function c_UPCAW( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return UPCAW( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )

Function ean8W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth, lBanner, cFont )
    local nLen
    // test de parametros
    // por implementar
    default nHeigth := 1.5
    default lBanner:=.f.
    if lHorz
        go_codeW( _UPC(cCode,7), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth * 0.90 )
    else
        //nLen :=round  ( nHeigth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 ) * 0.1
        nLen := ROUND( nCm2Pixels( oWnd:GetDC(), nLen, .F. ), 0 ) * 0.1
        oWnd:ReleaseDC()
       // 10% espacios
            go_codeW( _UPC(cCode,7), nRow, nCol + nLen, oWnd, lHorz, Color, nWidth, nHeigth * 0.90 )
    end
    go_codeW( _ean13Bl(8), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
    if lBanner
        barlenW( cCode, 7, oWnd, nRow, nCol, Color, lHorz, nWidth, nHeigth, cFont )
    end
return nil


Function c_ean8W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return ean8W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )


Function sup5W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth, lBanner, cFont )
    // test de parametros
    // por implementar
    go_codeW( _sup5(cCode), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
    if lBANNER
        ban5W( cCode, oWnd, nRow, nCol, Color, lHorz, nWidth, nhEIGTH, cFont )
    end
return nil

Function c_Sup5W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth, lBanner, cFont )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return sup5W( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth, lBanner, cFont )


Function CodabarW( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )
    // test de parametros
    // por implementar
    go_codeW( _Codabar(cCode), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
return nil

Function c_CodabarW( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return CodabarW( nRow, nCol, cCode, oWnd, Color, lHorz, nWidth, nHeigth )

Function int25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    // test de parametros
    // por implementar
    go_codeW( _int25(cCode,lCheck), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
return nil

Function c_int25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return int25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )

Function ind25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    // test de parametros
    // por implementar
    go_codeW( _ind25(cCode,lCheck), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
return nil

Function c_ind25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return ind25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )

Function mat25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    // test de parametros
    // por implementar
    go_codeW( _mat25(cCode,lCheck), nRow, nCol, oWnd, lHorz, Color, nWidth, nHeigth )
return nil

Function c_mat25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
    uCm2Pixels( oWnd:GetDC(), @nRow, @nCol )
    oWnd:ReleaseDC()
return mat25W( nRow, nCol, cCode, oWnd, lCheck, Color, lHorz, nWidth, nHeigth )
 
regards, saludos

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

Re: Código de Barras por pantalla.

Post by Antonio Linares »

GO_CODW.PRG

Code: Select all

// imprime un codigo

#include 'FiveWin.ch'

FUNCTION Go_CodeW( cBarra, nx, ny, oWnd, lHoRz, nColor, nWidth, nLen )

Local n      := 0
Local oBr    := Nil
Local WndhDC := 0

//traza(1, "Inici" )

WndhDc := oWnd:GetDc()

    If Empty( nColor )
        nColor := CLR_BLACK
    EndIf

    DEFAULT lHorz  := .t.
    DEFAULT nWidth := 0.025 // 1/3 M/mm
    DEFAULT nLen   := 1.5 // Cmm.

    DEFINE BRUSH oBr COLOR nColor

    /*
    Traza( 1, "cbarra=", cbarra )
    traza( 1, "nx      =", nx )
    Traza( 1, "ny      =", ny )
    Traza( 1, "lHorz   =", lHoRz )
    Traza( 1, "ncolor  =", ncolor, CLR_BLACK )
    Traza( 1, "a-nWidth=", nWidth )
    Traza( 1, "a-nLen  =", nLen )
    */

    //    Width of Bar
    If !lHorz
        //nWidth :=round ( nWidth * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nWidth := ROUND( nCm2Pixels( WndhDc, nWidth, .T. ), 0 )
    Else
       //nWidth := round  ( nWidth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
       nWidth := ROUND( nCm2Pixels( WndhDc, nWidth, .F. ), 0 )
    EndiF

    // Len of bar
    If lHorz
        //nLen := round ( nLen * 10 * oPrint:nVertRes() / oPrint:nVertSize() ,0 )
        nLen := ROUND( nCm2Pixels( WndhDc, nLen, .T. ), 0 )
    Else
       //nLen := round  ( nLen * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 )
       nLen := ROUND( nCm2Pixels( WndhDc, nLen, .F. ), 0 )
    EndIf

    //Traza( 1, "b-nWidth=", nWidth )
    //Traza( 1, "b-nLen=", nLen )

    FOR n := 1 to Len( cBarra )

        If substr(cBarra,n,1) ='1'
            If lHorz
                //oPrint:fillRect({nx,ny,nx+nLen,(ny+=nWidth)},oBr)
                FillRect( WndhDc, {nx, ny, nx + nLen, (ny += nWidth)}, oBr:hBrush )
            Else
                //oPrint:fillRect({nx,ny,(nx+=nWidth),ny+nLen},oBr)
                FillRect( WndhDc, {nx, ny, (nx += nWidth), ny + nLen}, oBr:hBrush )
            EndIf
        Else
            If lHorz
                ny += nWidth
            Else
                nx += nWidth
            EndIf
        EndIf

    NEXT

    oBr:end()

oWnd:ReleaseDc()

//traza(1, "Fin" )

RETURN Nil
 
Proves.prg

Code: Select all


#include "FiveWin.ch"
#INCLUDE "BARCODEW.CH"

FUNCTION Main( )
WcodebarA( )
WcodebarB( )
Return Nil

FUNCTION WcodebarA( )

Local oWnd, oAceptar

DEFINE WINDOW oWnd FROM 2.19,37.88 TO 35.50,137.00 //FIVEWIDI


@ 432,581 BUTTON oAceptar PROMPT "&OK" SIZE 152,32 ACTION oWnd:End() OF ownd ;
    FONT TFont():New('Arial',0,-11,.F.,.F.,0,0,400,.F.,.F.,.F.,0,3,2,1,nil) PIXEL ;
    MESSAGE "Cerrará venana" UPDATE CANCEL //FIVEWIDI

@ 10,10 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 VERTICAL

@ 10,60 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1

@ 10,210 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 MODE "A"

@ 10,385 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 MODE "B"

@ 10,560 CODE128W "1111167890" ;
       OF oWnd ;
       SIZE 1 MODE "C"

// =====================================
@ 130,10 CODE3_9W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 VERTICAL

@ 50,60 CODE3_9W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 CHECK

@ 50,290 CODE3_9W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 CHECK

// =====================================
@ 330,10 EAN13W "1111167890" ;
       OF oWnd COLOR CLR_GREEN ;
       SIZE 1 VERTICAL

@ 470,10 EAN13W "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL BANNER

@ 90,60 EAN13W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 BANNER FONT "Courier New"

@ 90,270 EAN13W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 BANNER

// =====================================
@ 600,10 UPCAW "1111167890" ;
       OF oWnd COLOR CLR_GREEN ;
       SIZE 1 VERTICAL

@ 600,100 UPCAW "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL BANNER

@ 140,60 UPCAW "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 BANNER FONT "Courier New"

@ 140,270 UPCAW "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 BANNER

// =====================================
@ 450,100 EAN8W "1111167890" ;
       OF oWnd COLOR CLR_GREEN ;
       SIZE 1 VERTICAL

@ 450,200 EAN8W "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL BANNER

@ 190,60 EAN8W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 BANNER FONT "Courier New"

@ 190,270 EAN8W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 BANNER

// =====================================
@ 300,200 CODABARW "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL

@ 240,60 CODABARW "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1.5

@ 240,270 CODABARW "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1.5

ACTIVATE WINDOW oWnd MAXIMIZED

Return Nil


FUNCTION WcodebarB( )
Local oWnd, oAceptar

DEFINE DIALOG oWnd FROM 5,5 TO 50,125 //FIVEWIDI

@ 216,290 BUTTON oAceptar PROMPT "&OK" SIZE 75,16 ACTION oWnd:End() OF ownd ;
    FONT TFont():New('Arial',0,-11,.F.,.F.,0,0,400,.F.,.F.,.F.,0,3,2,1,nil) PIXEL ;
    MESSAGE "Cerrará venana" UPDATE CANCEL //FIVEWIDI

@ 5,5 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 VERTICAL

@ 5,30 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1

@ 5,105 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 MODE "A"

@ 5,192 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 MODE "B"

@ 5,280 CODE128W "1111167890" ;
       OF oWnd ;
       SIZE 1 MODE "C"

// =====================================
@ 65,5 CODE3_9W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 VERTICAL

@ 25,30 CODE3_9W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 CHECK

@ 25,145 CODE3_9W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 CHECK

// =====================================
@ 165,5  EAN13W "1111167890" ;
       OF oWnd COLOR CLR_GREEN ;
       SIZE 1 VERTICAL

@ 235,5  EAN13W "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL BANNER

@ 45,30 EAN13W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 BANNER FONT "Courier New"

@ 45,135 EAN13W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 BANNER

// =====================================
@ 300,5  UPCAW "1111167890" ;
       OF oWnd COLOR CLR_GREEN ;
       SIZE 1 VERTICAL

@ 300,50  UPCAW "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL BANNER

@  70,30 UPCAW "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 BANNER FONT "Courier New"

@  70,135 UPCAW "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 BANNER

// =====================================
@ 225,50  EAN8W "1111167890" ;
       OF oWnd COLOR CLR_GREEN ;
       SIZE 1 VERTICAL

@ 225,100 EAN8W "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL BANNER

@  95,30 EAN8W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1 BANNER FONT "Courier New"

@  95,135 EAN8W "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1 BANNER

// =====================================
@ 150,100 CODABARW "1111167890" ;
       OF oWnd ;
       SIZE 1 VERTICAL

@ 120,30 CODABARW "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       SIZE 1.5

@ 120,135 CODABARW "1111167890" ;
       OF oWnd COLOR CLR_HBLUE ;
       SIZE 1.5

//Code128W( 90, 10, "167891", oWnd, NIL, CLR_HRED, .T., Nil, Nil)

//traza( 1, "code128w=", _code128( "1111167890", Nil ) )

//ACTIVATE WINDOW oWnd MAXIMIZED
ACTIVATE DIALOG oWnd

/*
@ 10,30 CODE128W "1234567890" ;
       OF oWnd COLOR CLR_HRED
       //WIDTH 0.10 ;
       //SIZE 50
       //MODE "A" ;
       //COLOR RED ;
*/

//Code128W( 90, 10, "167891", oWnd, NIL, CLR_HRED, .T., Nil, Nil)
//Code128W(nRow,nCol,cCode,oWnd,cMode,Color,lHorz,nWidth,nHeigth)

/*
@ 10,30 CODE128W "1111167890" ;
       OF oWnd COLOR CLR_HRED ;
       //WIDTH 0.10 ;
       //SIZE 0.80
       //MODE "A"

@ 300,300 CODE128W "1234567890" ;
       OF oWnd ;
       WIDTH 0.10 ;
       SIZE 50
       //MODE "A" ;
       //COLOR RED ;
*/

Return Nil
 
regards, saludos

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

Re: Código de Barras por pantalla.

Post by Antonio Linares »

TBarCodW.prg

Code: Select all

// TBarCodeW Class. Mainly used for show Code Bar at screen.

#include "FiveWin.ch"

#include "Constant.ch"

#define COLOR_BTNFACE     15

#ifdef __XPP__
   #define Super ::TControl
   #define New _New
#endif

//----------------------------------------------------------------------------//

CLASS TBarCodeW FROM TControl

   CLASSDATA lRegistered AS LOGICAL

   DATA   cTipoBar    // Tipo de código de barras.
   DATA   lBanner     // Indicador de si visualitza codi en alfanumèric.
   DATA   cFont       // Nom del tipu sde lletra.
   DATA   lHorizontal   // Indicador de horientació.
   DATA   cMode       // SubTipo del código de barras.
   DATA   lCheck      // Indicador de chequeo para convertir a ceros y unos.
   DATA   cCode       // Codigo recibido.
   DATA   cCodeBar1   // Codigo 1 convertido a ceros y unos.
   DATA   cCodeBar2   // Codigo 2 convertido a ceros y unos.
   DATA   nWidthLine  // Anchura de la línea del código de barras.
   DATA   nHeightLine // Altura de la línea del código de barras.

   METHOD New( nTop, nLeft, cCode, oWnd, lcheck, cMode, nColor, lHorizontal, ;
               nWidthLine, nHeightLine, lBanner, cFont, cTipoBar, lDesign, lPixel ) CONSTRUCTOR

   METHOD EraseBkGnd( hDC )
   METHOD Paint()
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0

   //METHOD Notify( nIdCtrl, nPtrNMHDR ) INLINE ::oWnd:Notify( nIdCtrl, nPtrNMHDR )

   METHOD SetCodeBar( cTipoBar, cMode, lCheck, cCode )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( nTop, nLeft, cCode, oWnd, lcheck, cMode, nColor, lHorizontal, ;
            nWidthLine, nHeightLine, lBanner, cFont, cTipoBar, lDesign, lPixel ) CLASS TBarCodeW

   DEFAULT nTop        := 0, nLeft := 0
   DEFAULT cCode       := ""
   DEFAULT cTipoBar    := "", cMode := "", lCheck := .F.
   DEFAULT oWnd        := GetWndDefault(), ncolor := oWnd:nClrText, cFont := "Arial"
   DEFAULT lHorizontal   := .T., lPixel := .T., lDesign := .F., lBanner := .T.
   DEFAULT nWidthLine  := 0.025 // 1/3 M/mm
   DEFAULT nHeightLine := 1.5 // Cmm.

   #ifdef __XPP__
      DEFAULT ::lRegistered := .f.
   #endif

   ::SetCodeBar( cTipoBar, cMode, lcheck, cCode )
   ::nWidthLine  := nWidthLine
   ::nHeightLine := nHeightLine
   ::lHorizontal := lHorizontal
   ::lBanner     := lBanner
   ::cFont       := cFont

   /*
   Traza( 1, "cTipoBar   =", ::cTipoBar )
   Traza( 1, "cMode      =", ::cMode )
   Traza( 1, "lcheck     =", ::lCheck )
   Traza( 1, "cCode      =", ::cCode )
   Traza( 1, "cCodeBar1  =", ::cCodeBar1 )
   Traza( 1, "cCodeBar2  =", ::cCodeBar2 )
   Traza( 1, "nWidthLine =", ::nWidthLine )
   Traza( 1, "nHeightLine=", ::nHeightLine )
   Traza( 1, "lHorizontal=", ::lHorizontal )
   Traza( 1, "lBanner    =", ::lBanner )
   Traza( 1, "cFont      =", ::cFont )
   */

   ::oWnd        := oWnd
   ::nTop        := If( lPixel, nTop, nTop * MTR_CHARPIX_H )  //14
   ::nLeft       := If( lPixel, nLeft, nLeft *  MTR_CHARPIX_W ) //8

   ::nBottom     := ::nTop  + nCm2Pixels( ::hDC, ::nHeightLine, .T. )
   ::nRight      := ::nLeft + ( nCm2Pixels( ::hDC, ::nWidthLine, .F. ) * Len( ::cCodeBar1 ) )

   ::lDrag       := lDesign
   ::nStyle      := nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN, ;
                  If( ::lDrag, nOr( WS_CLIPSIBLINGS, WS_TABSTOP ), 0 ) )

   ::nId         := ::GetNewId()
   ::lCaptured   := .f.
   ::lUpdate     := .f.

   ::nClrText    := nColor
   ::nClrPane    := iif( Upper( ::oWnd:Classname() ) != "TWINDOW", ;
                                GetSysColor( COLOR_BTNFACE ), ;
                                ::oWnd:nClrPane )
   /*
   Traza( 1, "nTop       =", ::nTop )
   Traza( 1, "nLeft      =", ::nLeft )
   Traza( 1, "nBottom    =", ::nBottom )
   Traza( 1, "nRight     =", ::nRight )
   Traza( 1, "nDrag      =", ::lDrag )
   Traza( 1, "nID        =", ::nId )
   Traza( 1, "lCaptured  =", ::lCaptured )
   Traza( 1, "nClrText   =", ::nClrText )
   Traza( 1, "nClrPane   =", ::nClrPane )
   */

   If ::lDrag
      ::CheckDots()
   endif

   ::Register()

   if ! Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
      if ::oWnd:oBrush != nil
         ::SetBrush( ::oWnd:oBrush )
      endif
   else
      ::oWnd:DefControl( Self )
   endif

return Self

//----------------------------------------------------------------------------//
METHOD SetCodeBar( cTipoBar, cMode, lcheck, cCode ) CLASS TBarCodeW

::cTipoBar  := cTipoBar
::cMode     := cMode
::lCheck    := lCheck
::cCode     := cCode

::cCodeBar1 := ""
::cCodeBar2 := ""

IF ::cTipoBar = "CODE128"
    ::cCodeBar1 := _code128( ::cCode, ::cMode )
ElseIf ::cTipoBar = "CODE3_9"
    ::cCodeBar1 := _code3_9( ::cCode, ::lCheck )
ElseIf ::cTipoBar = "EAN13"
    ::cCodeBar1 := _ean13( ::cCode )
    ::cCodeBar2 := _ean13Bl()
ElseIf ::cTipoBar = "UPCA"
    ::cCodeBar1 := _upc( ::cCode )
    ::cCodeBar2 := _UPCABl( ::cCode )
ElseIf ::cTipoBar = "EAN8"
    ::cCodeBar1 := _upc( ::cCode, 7 )
    ::cCodeBar2 := _ean13Bl(8)
ElseIf ::cTipoBar = "SUP5"
    ::cCodeBar1 := _sup5( ::cCode )
ElseIf ::cTipoBar = "CODABAR"
    ::cCodeBar1 := _codabar( ::cCode )
ElseIf ::cTipoBar = "INT25"
    ::cCodeBar1 := _int25( ::cCode, ::lCheck )
ElseIf ::cTipoBar = "IND25"
    ::cCodeBar1 := _ind25( ::cCode, ::lCheck )
ElseIf ::cTipoBar = "MAT25"
    ::cCodeBar1 := _mat25( ::cCode, ::lCheck )
EndIf

Return Nil

//----------------------------------------------------------------------------//

METHOD EraseBkGnd( hDC ) CLASS TBarCodeW

   if ::oWnd != nil .and. IsAppThemed() .and. ;
      Upper( ::oWnd:ClassName() ) $ "TFOLDER,TREBAR,TGROUP,TPANEL"
      DrawPBack( ::hWnd, hDC )
      return 1
   endif

return 1 // Super:EraseBkGnd( hDC )

//----------------------------------------------------------------------------//

METHOD Paint() CLASS TBarCodeW
Local nLen := 0

IF ::cTipoBar $ "/CODE128/CODE3_9/SUP5/CODABAR/INT25/IND25/MAT25/"
    go_codeW( ::cCodeBar1, ::nTop, ::nLeft, ::oWnd, ::lHorizontal, ::nClrText, ::nWidthLine, ::nHeightLine )
EndIf

If ::cTipoBar $ "/EAN13/UPCA/EAN8/"

    If ::lHorizontal
        go_codeW( ::cCodeBar1, ::nTop, ::nLeft, ::oWnd, ::lHorizontal, ::nClrText, ::nWidthLine, ::nHeightLine * 0.90 )
    Else
        // **********************************************
        // OJO con nLen, no se está usando correctamente.
        // **********************************************
        //nLen :=round  ( nHeigth * 10 * oPrint:nHorzRes() / oPrint:nHorzSize(), 0 ) * 0.1
        //nLen := round  ( nCm2Pixels( ::oWndhDC, nLen, .F. ), 0 ) * 0.1
        nLen := round  ( nCm2Pixels( ::hDC, ::nHeightLine, .F. ), 0 ) * 0.1
       // 10% espacios
        go_codeW( ::cCodeBar1, ::nTop, ::nLeft + nLen, ::oWnd, ::lHorizontal, ::nClrText, ::nWidthLine, ::nHeightLine * 0.90 )
    End
    go_codeW( ::cCodeBar1, ::nTop, ::nLeft, ::oWnd, ::lHorizontal, ::nClrText, ::nWidthLine, ::nHeightLine )

EndIf

If ::cTipoBar = "EAN13"
    If ::lBanner
        barlen13W( ::cCode, ::oWnd, ::nTop, ::nLeft, ::nClrText, ::lHorizontal, ::nWidthLine, ::nHeightLine, ::cFont )
    End
ElseIf ::cTipoBar = "UPCA"
    If ::lBanner
        UPCA_barlenW( ::cCode, ::oWnd, ::nTop, ::nLeft, ::nClrText, ::lHorizontal, ::nWidthLine, ::nHeightLine, ::cFont )
    End
ElseIf ::cTipoBar = "EAN8"
    If ::lBanner
        barlenW( ::cCode, 7, ::oWnd, ::nTop, ::nLeft, ::nClrText, ::lHorizontal, ::nWidthLine, ::nHeightLine, ::cFont )
    End
ElseIf ::cTipoBar = "SUP5"
    If ::lBanner
        ban5W( ::cCode, ::oWnd, ::nTop, ::nLeft, ::nClrText, ::lHorizontal, ::nWidthLine, ::nHeightLine, ::cFont )
    End
EndIf

return nil

//----------------------------------------------------------------------------//
 
regards, saludos

Antonio Linares
www.fivetechsoft.com
FiveWiDi
Posts: 910
Joined: Mon Oct 10, 2005 2:38 pm

Re: Código de Barras por pantalla.

Post by FiveWiDi »

Antonio Linares wrote:Carlos,
Gracias por tu contribución. Copiemos aqui los ficheros pues mediafire se cancela despues de un tiempo,
Gracias Antonio,

después de tantos años leyendo este foro he podido y me venía muy a gusto colaborar un poco.

Un Saludo
Carlos G.
Un Saludo
Carlos G.

FiveWin 19.06 + Harbour 3.2, BCC 7 Windows 10
Post Reply