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
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    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
    Tags: None
    • Likes 1
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree