home *** CD-ROM | disk | FTP | other *** search
/ CD Direkt 1995 #6 / CDD_6_95.ISO / cdd / winanw / bartest / sample2 / macro.txt < prev   
Text File  |  1994-11-08  |  5KB  |  163 lines
  1. ' (c) Copyright 1994, HEX Technology, All rights reserved.
  2. ' You must purchase a license for barcodes.dll before you
  3. ' are permitted to use this code in commerical software.
  4.  
  5. Declare Function CreatePlaceableBarcode Lib "barcodes.DLL"(\
  6.                                 fileName As String,  \
  7.                                 hDC As Integer, \
  8.                                 iStyle As Integer, \
  9.                                 lpData As String, \
  10.                                 lpText As String, \
  11.                                 iDisplayFlags As Integer, \
  12.                                 iBarRatio As Integer, \
  13.                                 lpFontFace As String, \
  14.                                 iFontFlags As Integer, \
  15.                                 iFontAdjust As Integer, \
  16.                                 clrFront As Long, \
  17.                                 clrBack As Long, \
  18.                                 iReturnWidth As String, \
  19.                                 iReturnHeight As String, \
  20.                                 iBarcodeWidth As String, \
  21.                                 iBarcodeHeight As String) As Integer
  22. '
  23. '  A couple of support API functions
  24. '---------------------------------------------------------
  25. Declare Function GetDC Lib "USER.EXE"(hWnd As Integer) As Integer
  26. Declare Sub ReleaseDC Lib "USER.EXE"(hWnd As Integer, hDC As Integer)
  27.  
  28. ' Start of macro
  29. '---------------------------------------------------------
  30. Sub MAIN
  31.  
  32.     ' Set m_Data to m_UserData if you want current selection
  33.     ' converted to barcode
  34.      m_UserData$ = CleanString$(Selection$())
  35.  
  36.     'Data to encode by barcode (remember to include start/stop 
  37.     ' if necessary - set barole.hlp - barcode styles section) 
  38.     ' replace hard coded string with current selection or another
  39.     ' variable e.g. m_UserData
  40.     m_sData$ = m_UserData$     'or fixed string eg "R62-0105-000"
  41.     
  42.     If Len(m_sData$) < 1 Then  
  43.         MsgBox "Please select a string in your document and try again.", "BARCODE MACRO", 16
  44.         Stop
  45.     End If
  46.  
  47.     ' Just for UPC-A in this example also check that we
  48.     ' have 12 digits of data
  49.  
  50.     ' Barcode STYLE_ ( See barcodes.h for possible values)
  51.     m_iStyle = 17    ' UPC-A = 5
  52.  
  53.     If Len(m_sData$) <> 12 Then  
  54.         MsgBox "This example requires that you enter and select a number that has exactly 12 digits, please try again.", "BARCODE MACRO", 16
  55.         Stop
  56.     End If
  57.  
  58.     
  59.     ' Text to show under barcode instead of data
  60.     m_sText$ = "HEX TECHNOLOGY"                ' eg   "*R62-0105-000*"
  61.  
  62.     ' Bar color RGB
  63.     m_cBarColor = 0        ' BLACK = 0
  64.  
  65.     ' Background Color RGB
  66.     m_cBackColor = 16777215    ' WHITE = 16777215
  67.  
  68.     ' General FLAG_XXXX ( See barcodes.h)  Add Values together
  69.     ' Example: Show Text and Show Spacer ... m_Flags = 17
  70.     ' Remember to include CheckDigit all the time
  71.     m_iDisplayFlags = 9  'Show Text + Include Check
  72.  
  73.     ' Font face..USE ONLY FIXED SPACE FONTS FOR EAN/UPC !!!!!!
  74.     ' If you have OCR-B TT please use it
  75.     m_sFont$ = "Courier New"
  76.  
  77.     ' FONT_ Flags  BOLD and/or ITALIC  (See barcodes.h) (Add values)
  78.     m_sFontFlags = 0
  79.  
  80.     ' Font Adjustment Tweak Value (See to + or - number to adjust
  81.     ' size of choosen font size if you are not happy with it
  82.     m_iFontAdjust = 0
  83.  
  84.     ' 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
  85.     ' Please use a higher ratio for code 3 of 9 or Code 39
  86.     m_iBarRatio = 0    
  87.     
  88.     ' Final size of barcode bars in millimeters ( MM )
  89.     ' Actual size of entire barcode image will be larger if
  90.     ' text at bottom or bearer bars used or spacer character shown
  91.     m_width = 31            '  3.1 cm
  92.     m_height = 21            '  2.1 cm
  93.  
  94.     ' Temporary disk file.. disk not matter what name
  95.     m_fileName$ = "barcode.wmf"     
  96.  
  97.     'On return rw holds the width of the entire barcode
  98.     rw$ = "0"
  99.     'On return rh holds the height of the entire barcode
  100.     rh$ = "0"
  101.     'On return bw holds the width of just the barcode bars
  102.     bw$ = "0"
  103.     'On return bh holds the height of just the barcode bars
  104.     bh$ = "0"
  105.  
  106.     hWnd = GetActiveWindow
  107.     ' Any DC will do, does not actually have to be for form or 
  108.     ' document window
  109.     hDC = GetDC(hWnd)
  110.  
  111.     If hDC = 0 Then
  112.         MsgBox "Not Enough GDI Memory", "BARCODE MACRO", 16
  113.         Stop
  114.     End If
  115.     
  116.     ' Create the metafile file to m_fileName
  117. 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$)
  118.  
  119.     ' Release the DC as soon as possible
  120.     ReleaseDC(hWnd, hDC)
  121.  
  122.     ' If file was not created then you supplied wrong data
  123.     ' disk error... check data digits and check disk space
  124.  
  125.     If Files$(m_fileName$) = "" Then
  126.         MsgBox "Invalid Barcode Data", "BARCODE MACRO", 16
  127.         Stop
  128.     End If
  129.  
  130.     ' Determine new scaled size so that barcode bars are exactly
  131.     ' m_width and m_height in millimeters
  132.     ' NOTE:  Assumes WORD 6.0 measurements are in MM
  133.     ' DO N0T CHANGE THIS !!!!!
  134.  
  135.     'calculate increased barcode size to allow for text and gaps
  136.     'this ensure that just the barcode bars fit the required m_width 
  137.     ' and m_height
  138.      XPoints =  (Asc(Left$(rw$, 1)) / Asc(Left$(bw$, 1))) * m_width
  139.      YPoints =  (Asc(Left$(rh$, 1)) / Asc(Left$(bh$, 1))) * m_height
  140.  
  141.      'convert from mm to inches and convert to points (72 per inch)
  142.        XPoints = (XPoints / 25.4) * 72
  143.       YPoints = (YPoints / 25.4) * 72
  144.  
  145.     ' Load the picture from disk
  146.     ' May result in error message if file was not created
  147.     ' but this should be trapped with above If(m_fileName)
  148.     InsertPicture .Name = m_FileName$
  149.  
  150.     ' Select picture and apply scaling
  151.     ExtendSelection            ' Turn ON        
  152.     CharLeft 1                ' Select BARCODE
  153.      
  154.     FormatPicture .SetSize = 1, .SizeX =   XPoints, .SizeY =  YPoints
  155.     Cancel    
  156.     'ExtendSelection         ' Turn OFF
  157.      
  158.  
  159.     ' Delete the file ... but you might want to keep it
  160.     ' Kill m_FileName$
  161.  
  162. End Sub
  163.