' (c) Copyright 1994, HEX Technology, All rights reserved. ' You must purchase a license for barcodes.dll before you ' are permitted to use this code in commerical software. Declare Function CreatePlaceableBarcode Lib "barcodes.DLL"(\ fileName As String, \ hDC As Integer, \ iStyle As Integer, \ lpData As String, \ lpText As String, \ iDisplayFlags As Integer, \ iBarRatio As Integer, \ lpFontFace As String, \ iFontFlags As Integer, \ iFontAdjust As Integer, \ clrFront As Long, \ clrBack As Long, \ iReturnWidth As String, \ iReturnHeight As String, \ iBarcodeWidth As String, \ iBarcodeHeight As String) As Integer ' ' A couple of support API functions '--------------------------------------------------------- Declare Function GetDC Lib "USER.EXE"(hWnd As Integer) As Integer Declare Sub ReleaseDC Lib "USER.EXE"(hWnd As Integer, hDC As Integer) ' Start of macro '--------------------------------------------------------- Sub MAIN ' Set m_Data to m_UserData if you want current selection ' converted to barcode m_UserData$ = CleanString$(Selection$()) 'Data to encode by barcode (remember to include start/stop ' if necessary - set barole.hlp - barcode styles section) ' replace hard coded string with current selection or another ' variable e.g. m_UserData m_sData$ = m_UserData$ 'or fixed string eg "R62-0105-000" If Len(m_sData$) < 1 Then MsgBox "Please select a string in your document and try again.", "BARCODE MACRO", 16 Stop End If ' Just for UPC-A in this example also check that we ' have 12 digits of data ' Barcode STYLE_ ( See barcodes.h for possible values) m_iStyle = 17 ' UPC-A = 5 If Len(m_sData$) <> 12 Then MsgBox "This example requires that you enter and select a number that has exactly 12 digits, please try again.", "BARCODE MACRO", 16 Stop End If ' Text to show under barcode instead of data m_sText$ = "HEX TECHNOLOGY" ' eg "*R62-0105-000*" ' Bar color RGB m_cBarColor = 0 ' BLACK = 0 ' Background Color RGB m_cBackColor = 16777215 ' WHITE = 16777215 ' General FLAG_XXXX ( See barcodes.h) Add Values together ' Example: Show Text and Show Spacer ... m_Flags = 17 ' Remember to include CheckDigit all the time m_iDisplayFlags = 9 'Show Text + Include Check ' Font face..USE ONLY FIXED SPACE FONTS FOR EAN/UPC !!!!!! ' If you have OCR-B TT please use it m_sFont$ = "Courier New" ' FONT_ Flags BOLD and/or ITALIC (See barcodes.h) (Add values) m_sFontFlags = 0 ' Font Adjustment Tweak Value (See to + or - number to adjust ' size of choosen font size if you are not happy with it m_iFontAdjust = 0 ' Bar ratio Units (has side-effect of adjusting scaled font size ' also) 1 = 1.75 2 = 2.0 3 = 2.25 etc to 7 = 3.0 ' Please use a higher ratio for code 3 of 9 or Code 39 m_iBarRatio = 0 ' Final size of barcode bars in millimeters ( MM ) ' Actual size of entire barcode image will be larger if ' text at bottom or bearer bars used or spacer character shown m_width = 31 ' 3.1 cm m_height = 21 ' 2.1 cm ' Temporary disk file.. disk not matter what name m_fileName$ = "barcode.wmf" 'On return rw holds the width of the entire barcode rw$ = "0" 'On return rh holds the height of the entire barcode rh$ = "0" 'On return bw holds the width of just the barcode bars bw$ = "0" 'On return bh holds the height of just the barcode bars bh$ = "0" hWnd = GetActiveWindow ' Any DC will do, does not actually have to be for form or ' document window hDC = GetDC(hWnd) If hDC = 0 Then MsgBox "Not Enough GDI Memory", "BARCODE MACRO", 16 Stop End If ' Create the metafile file to m_fileName hMetaFile = CreatePlaceableBarcode(m_fileName$, hDC, m_iStyle, m_sData$, m_sText$, m_iDisplayFlags, m_iBarRatio, m_sFont$, m_iFontFlags, m_iFontAdjust, m_cBarColor, m_cBackColor, rw$, rh$, bw$, bh$) ' Release the DC as soon as possible ReleaseDC(hWnd, hDC) ' If file was not created then you supplied wrong data ' disk error... check data digits and check disk space If Files$(m_fileName$) = "" Then MsgBox "Invalid Barcode Data", "BARCODE MACRO", 16 Stop End If ' Determine new scaled size so that barcode bars are exactly ' m_width and m_height in millimeters ' NOTE: Assumes WORD 6.0 measurements are in MM ' DO N0T CHANGE THIS !!!!! 'calculate increased barcode size to allow for text and gaps 'this ensure that just the barcode bars fit the required m_width ' and m_height XPoints = (Asc(Left$(rw$, 1)) / Asc(Left$(bw$, 1))) * m_width YPoints = (Asc(Left$(rh$, 1)) / Asc(Left$(bh$, 1))) * m_height 'convert from mm to inches and convert to points (72 per inch) XPoints = (XPoints / 25.4) * 72 YPoints = (YPoints / 25.4) * 72 ' Load the picture from disk ' May result in error message if file was not created ' but this should be trapped with above If(m_fileName) InsertPicture .Name = m_FileName$ ' Select picture and apply scaling ExtendSelection ' Turn ON CharLeft 1 ' Select BARCODE FormatPicture .SetSize = 1, .SizeX = XPoints, .SizeY = YPoints Cancel 'ExtendSelection ' Turn OFF ' Delete the file ... but you might want to keep it ' Kill m_FileName$ End Sub