Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

barcode code39

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • barcode code39

    Hello,

    for some of my projects i needed to print some barcode. Fonts were out of question because i could not ensure that they were always intstalled correctly on the target machine. I couldn't find anything suiting my requierements. So i taylored my own solution useing some information and code snips i found here in the forums. It can be equaly used in PB CC and PB Win.

    XPRINT ATTACH must be done before you call "Barcode"

    store this as "barcode39.inc"

    Code:
    'Function to print a Barcode
    '                useing XPrint and when compiled with PBwin optional showing preview
    'Parameter:
    '     inText: text to be printed as barcode, is converted to upper case since the code contains only upper case characters
    '          X: start positon for printing the barcode (X-axis)
    '          Y: start positon for printing the barcode (Y-axis)
    '          h: height of the barcode
    '          w: width of the barcode
    '   labelPos: 0=no label / 1=label left,bottom / 2=label center,bottom / 3=label right, bottom
    '             4=label left,top / 5=label center,top / 6=label right,top
    '             choose font setting befor calling "barcode" with XPRINT FONT .....
    '        win: Hdlg of the dialog showing the preview
    '       crtl: ID of the Graphic-Control showing the preview
    ' the density of the barcode printed or previewed is adjusted to fill the space given by h and w or the size of the preview-graphic control
    ' there is no checksum but you may calculated it by your own if you really need it
    '
    ' xprint attach must be happend before "barcode" is called
     
    DECLARE FUNCTION encode3of9 (inText AS STRING) AS STRING
    
    FUNCTION barcode (inText AS STRING,x AS LONG,y AS LONG,w AS LONG,h AS LONG, OPTIONAL BYVAL labelPos AS LONG, OPTIONAL BYVAL win AS DWORD, OPTIONAL BYVAL ctrl AS WORD)AS LONG
        LOCAL temptext AS STRING,xx AS LONG,n AS LONG,ww AS LONG, tw AS LONG, th AS LONG, gw AS LONG
    
        temptext=encode3of9 (inText)
        ww=2                     'ratio wide/narrow
        tw=13*(LEN(inText)+2)-1  'CodeWidth=nummer of elements per character * number of characters
        gw=1                     'width of an element
    'preview, only possible IF compiled WITH PB Win
    #IF %DEF(%PB_WIN32)
         IF win<>0 THEN
          GRAPHIC ATTACH win,ctrl
          GRAPHIC SCALE (0,0)-(tw,h)
          xx=0
          FOR n = 1 TO LEN(tempText)
            SELECT CASE MID$(tempText, n, 1)
              CASE "b"
                  GRAPHIC BOX (xx,0)-(xx+gw,h),,%BLACK, %BLACK
                  xx=xx+gw
              CASE "B"
                  GRAPHIC BOX (xx,0)-(xx+ww*gw,h),,%BLACK, %BLACK
                  xx=xx+ww*gw
              CASE "w"
                  GRAPHIC BOX (xx,0)-(xx+gw,h),,%WHITE, %WHITE
                  xx=xx+gw
              CASE "W"
                  GRAPHIC BOX (xx,0)-(xx+ww*gw,h),,%WHITE, %WHITE
                  xx=xx+ww*gw
            END SELECT
          NEXT
          GRAPHIC REDRAW
        END IF
    #ENDIF
    'printer
        xx=x
        XPRINT SET POS (x,y)
        gw=w/tw
        FOR n = 1 TO LEN(tempText)
            SELECT CASE MID$(tempText, n, 1)
              CASE "b"
                  XPRINT BOX (xx,y)-(xx+gw,y+h),,%BLACK, %BLACK
                  xx=xx+gw
              CASE "B"
                  XPRINT BOX (xx,y)-(xx+ww*gw,y+h),,%BLACK, %BLACK
                  xx=xx+ww*gw
              CASE "w"
                  XPRINT BOX (xx,y)-(xx+gw,y+h),,%WHITE, %WHITE
                  xx=xx+gw
              CASE "W"
                  XPRINT BOX (xx,y)-(xx+ww*gw,y+h),,%WHITE, %WHITE
                  xx=xx+ww*gw
            END SELECT
        NEXT
        XPRINT TEXT SIZE inText TO tw, th
        SELECT CASE labelPos
            CASE 0
                'no label
            CASE 1   'left bottom
                XPRINT SET POS (x,y+h+10)
                XPRINT inText
            CASE 2   'center bottom
                XPRINT SET POS (x+((w-tw)/2),y+h+10)
                XPRINT inText
            CASE 3   'right bottom
                XPRINT SET POS (x+(w-tw),y+h+10)
                XPRINT inText
            CASE 4   'left top
                XPRINT SET POS (x,y-th-10)
                XPRINT inText
            CASE 5   'center top
                XPRINT SET POS (x+((w-tw)/2),y-th-10)
                XPRINT inText
            CASE 6   'right top
                XPRINT SET POS (x+(w-tw),y-th-10)
                XPRINT inText
        END SELECT
    END FUNCTION
    
    FUNCTION encode3of9 (inText AS STRING) AS STRING
          LOCAL tempTxt AS STRING,encTxt AS STRING, n AS LONG
          tempTxt = "*" +UCASE$(inText)+ "*"
          encTxt = ""
          FOR n = 1 TO LEN(tempTxt)
            SELECT CASE MID$(tempTxt, n, 1)
              CASE "1"
                encTxt = encTxt + "110100101011"
              CASE "2"
                encTxt = encTxt + "101100101011"
              CASE "3"
                encTxt = encTxt + "110110010101"
              CASE "4"
                encTxt = encTxt + "101001101011"
              CASE "5"
                encTxt = encTxt + "110100110101"
              CASE "6"
                encTxt = encTxt + "101100110101"
              CASE "7"
                encTxt = encTxt + "101001011011"
              CASE "8"
                encTxt = encTxt + "110100101101"
              CASE "9"
                encTxt = encTxt + "101100101101"
              CASE "0"
                encTxt = encTxt + "101001101101"
              CASE "A"
                encTxt = encTxt + "110101001011"
              CASE "B"
                encTxt = encTxt + "101101001011"
              CASE "C"
                encTxt = encTxt + "110110100101"
              CASE "D"
                encTxt = encTxt + "101011001011"
              CASE "E"
                encTxt = encTxt + "110101100101"
              CASE "F"
                encTxt = encTxt + "101101100101"
              CASE "G"
                encTxt = encTxt + "101010011011"
              CASE "H"
                encTxt = encTxt + "110101001101"
              CASE "I"
                encTxt = encTxt + "101101001101"
              CASE "J"
                encTxt = encTxt + "101011001101"
              CASE "K"
                encTxt = encTxt + "110101010011"
              CASE "L"
                encTxt = encTxt + "101101010011"
              CASE "M"
                encTxt = encTxt + "110110101001"
              CASE "N"
                encTxt = encTxt + "101011010011"
              CASE "O"
                encTxt = encTxt + "110101101001"
              CASE "P"
                encTxt = encTxt + "101101101001"
              CASE "Q"
                encTxt = encTxt + "101010110011"
              CASE "R"
                encTxt = encTxt + "110101011001"
              CASE "S"
                encTxt = encTxt + "101101011001"
              CASE "T"
                encTxt = encTxt + "101011011001"
              CASE "U"
                encTxt = encTxt + "110010101011"
              CASE "V"
                encTxt = encTxt + "100110101011"
              CASE "W"
                encTxt = encTxt + "110011010101"
              CASE "X"
                encTxt = encTxt + "100101101011"
              CASE "Y"
                encTxt = encTxt + "110010110101"
              CASE "Z"
                encTxt = encTxt + "100110110101"
              CASE "-"
                encTxt = encTxt + "100101011011"
              CASE "."
                encTxt = encTxt + "110010101101"
              CASE " "
                encTxt = encTxt + "100110101101"
              CASE "*"
                encTxt = encTxt + "100101101101"
              CASE "$"
                encTxt = encTxt + "100100100101"
              CASE "/"
                encTxt = encTxt + "100100100101"
              CASE "+"
                encTxt = encTxt + "100101001001"
              CASE "%"
                encTxt = encTxt + "101001001001"
              CASE ELSE
                BEEP
                EXIT FUNCTION
            END SELECT
            encTxt = encTxt + "0"
          NEXT n
          encTxt=LEFT$(encTxt,LEN(encTxt)-1)
          REPLACE "11" WITH "B" IN encTxt
          REPLACE "1" WITH "b" IN encTxt
          REPLACE "00" WITH "W" IN encTxt
          REPLACE "0" WITH "w" IN encTxt
          FUNCTION=encTxt
    END FUNCTION
    Here is a very basic sample for CC:

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "barcode39.inc"
    FUNCTION PBMAIN () AS LONG
      LOCAL temp AS STRING
      INPUT "Please enter data for Barcode:  ",temp
      XPRINT ATTACH CHOOSE, "Barcode"
      barcode (temp,200,1000,400,100,2)       'the last 2 parameters are optional and not neccesary in CC
      XPRINT FORMFEED
      XPRINT CLOSE
    END FUNCTION
    The same for PB Win:

    Code:
    #PBFORMS CREATED V1.51
    '------------------------------------------------------------------------------
    ' The first line in this file is a PB/Forms metastatement.
    ' It should ALWAYS be the first line of the file. Other
    ' PB/Forms metastatements are placed at the beginning and
    ' end of "Named Blocks" of code that should be edited
    ' with PBForms only. Do not manually edit or delete these
    ' metastatements or PB/Forms will not be able to reread
    ' the file correctly.  See the PB/Forms documentation for
    ' more information.
    ' Named blocks begin like this:    #PBFORMS BEGIN ...
    ' Named blocks end like this:      #PBFORMS END ...
    ' Other PB/Forms metastatements such as:
    '     #PBFORMS DECLARATIONS
    ' are used by PB/Forms to insert additional code.
    ' Feel free to make changes anywhere else in the file.
    '------------------------------------------------------------------------------
    
    #COMPILE EXE
    #DIM ALL
    
    '------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN INCLUDES
    %USEMACROS = 1
    #IF NOT %DEF(%WINAPI)
        #INCLUDE "WIN32API.INC"
    #ENDIF
    #IF NOT %DEF(%COMMCTRL_INC)
        #INCLUDE "COMMCTRL.INC"
    #ENDIF
    #INCLUDE "PBForms.INC"
    #PBFORMS END INCLUDES
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN CONSTANTS
    %IDD_DIALOG1  =  101
    %IDC_GRAPHIC1 = 1001
    %IDC_TEXTBOX1 = 1002
    %IDC_BUTTON1  = 1003
    #PBFORMS END CONSTANTS
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Declarations **
    '------------------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
    DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS DECLARATIONS
    '------------------------------------------------------------------------------
    #INCLUDE "Barcode39.inc"
    
    '------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
            %ICC_INTERNET_CLASSES)
    
        ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
        LOCAL temp AS STRING
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                ' Initialization handler
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CBCTL
                    CASE %IDC_GRAPHIC1
    
                    CASE %IDC_TEXTBOX1
    
                    CASE %IDC_BUTTON1
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            CONTROL GET TEXT CBHNDL,%IDC_TEXTBOX1 TO temp
                            XPRINT ATTACH CHOOSE, "Barcode"
                            XPRINT
                            'xprint font "Arial",6,2
                            barcode (temp,200,1000,400,100,2,CBHNDL,%IDC_GRAPHIC1)
                            XPRINT FORMFEED
                            XPRINT CLOSE
                        END IF
    
                END SELECT
        END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
    
    #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
        LOCAL hDlg  AS DWORD
    
        DIALOG NEW PIXELS, hParent, "barcode", 156, 91, 662, 166, %WS_POPUP OR _
            %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
            %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
            %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
            %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC1, "", 15, 16, 637, 82
        CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "", 8, 106, 649, 16
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "show", 112, 138, 114, 15
    #PBFORMS END DIALOG
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    #PBFORMS END CLEANUP
    
        FUNCTION = lRslt
    END FUNCTION
    use and enjoy

    Hans
Working...
X