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"
Here is a very basic sample for CC:
The same for PB Win:
use and enjoy
Hans
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
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
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
Hans