Prikazi cijelu temu 15.04.2015 08:27
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Lokacija:-


Predmet:Re: Prihodi i rashodi
Zatim ovaj modul nazovi ga: mod_BarCode_Generator_Code39

PreuzmiIzvorni kôd (Text):
  1. Option Compare Database   'Use database order for string comparisons
  2. Option Explicit
  3. '
  4. ' mod_BarCode_Generator_Code39
  5. '
  6. ' Barcode Generator for Code 3 of 9, Code 39, and Mil-spec Logmars.
  7. '
  8. ' version 2.0 (updated for MsAccess 97)
  9. '
  10. ' (c) 1993-1999 James Isle Mercanti, Cocoa Beach, FL 32931  USA
  11. ' Permission granted for public use and royalty-free distribution.
  12. ' No mention of source or credits is required. All rights reserved.
  13. '
  14. ' TO USE THIS CODE:
  15. '
  16. '   1 - Create Report with a TextBox control. (example named Barcode)
  17. '       Make sure the Visible property is set to "No".
  18. '   2 - Set On-Print property of section to [Event Procedure]
  19. '       by clicking on the [...] and selecting "Code Builder"
  20. '   3 - Confirm that the following code matches yours...
  21. '
  22. '      Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
  23. '
  24. '         Result = MD_Barcode39(Barcode, Me)
  25. '
  26. '      End Sub
  27. '
  28. '   4 - NOTE: The name of the section is "Detail1" for example only!
  29. '       Your section might show a different name. Ditto for "Barcode".
  30. '
  31. '   5 - NOTE: To use on sub-forms, the Report name should be hard-coded
  32. '       into the function. i.e. Rpt = Reports!MainForm!SubForm.Report.
  33. '       The easy method is to just avoid using sub-forms and sub-reports.
  34. '
  35.  
  36. Function MD_Barcode39(Ctrl As control, rpt As Report)
  37.    
  38.     On Error GoTo ErrorTrap_BarCode39
  39.    
  40.     Dim Nbar As Single, Wbar As Single, Qbar As Single, Nextbar As Single
  41.     Dim CountX As Single, CountY As Single, CountR As Single
  42.     Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
  43.     Dim Stripes As String, BarType As String, Barcode As String
  44.     Dim Mx As Single, my As Single, Sx As Single, Sy As Single
  45.     Const White = 16777215: Const Black = 0
  46.     Const Nratio = 20, Wratio = 55, Qratio = 35
  47.    
  48.     'Get control size and location properties.
  49.     Sx = Ctrl.Left: Sy = Ctrl.TOP: Mx = Ctrl.Width: my = Ctrl.Height
  50.    
  51.     'Set handle on control.
  52.     Barcode = Ctrl
  53.    
  54.     'Calculate actual and relative pixels values.
  55.     Parts = (Len(Barcode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
  56.     Pix = (Mx / Parts):
  57.     Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)
  58.    
  59.     'Initialize bar index and color.
  60.     Nextbar = Sx
  61.     Color = White
  62.    
  63.     'Pad each end of string with start/stop characters.
  64.     BarCodePlus = "*" & UCase(Barcode) & "*"
  65.    
  66.     'Walk through each character of the barcode contents.
  67.     For CountX = 1 To Len(BarCodePlus)
  68.        
  69.         'Get Barcode 1/0 string for indexed character.
  70.         Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
  71.         For CountY = 1 To 9
  72.            
  73.             'For each 1/0, draw a wide/narrow bar.
  74.             BarType = Mid$(Stripes, CountY, 1)
  75.            
  76.             'Toggle the color (black/white).
  77.             If Color = White Then Color = Black Else Color = White
  78.             Select Case BarType
  79.                
  80.                 Case "1"
  81.                     'Draw a wide bar.
  82.                     rpt.Line (Nextbar, Sy)-Step(Wbar, my), Color, BF
  83.                     Nextbar = Nextbar + Wbar
  84.                
  85.                 Case "0"
  86.                     'Draw a narrow bar.
  87.                     rpt.Line (Nextbar, Sy)-Step(Nbar, my), Color, BF
  88.                     Nextbar = Nextbar + Nbar
  89.            
  90.             End Select
  91.         Next CountY
  92.        
  93.         'Toggle the color (black/white).
  94.         If Color = White Then Color = Black Else Color = White
  95.        
  96.         'Draw intermediate "quiet" bar.
  97.         rpt.Line (Nextbar, Sy)-Step(Qbar, my), Color, BF
  98.         Nextbar = Nextbar + Qbar
  99.        
  100.     Next CountX
  101.    
  102. Exit_BarCode39:
  103.     Exit Function
  104.  
  105. ErrorTrap_BarCode39:
  106.     Resume Exit_BarCode39
  107.  
  108. End Function
  109.  
  110. Function MD_BC39(CharCode As String) As String
  111.    
  112.     On Error GoTo ErrorTrap_BC39
  113.  
  114.     ReDim BC39(90)
  115.  
  116.     BC39(32) = "011000100" ' space
  117.     BC39(36) = "010101000" ' $
  118.     BC39(37) = "000101010" ' %
  119.     BC39(42) = "010010100" ' * Start/Stop
  120.     BC39(43) = "010001010" ' +
  121.     BC39(45) = "010000101" ' |
  122.     BC39(46) = "110000100" ' .
  123.     BC39(47) = "010100010" ' /
  124.     BC39(48) = "000110100" ' 0
  125.     BC39(49) = "100100001" ' 1
  126.     BC39(50) = "001100001" ' 2
  127.     BC39(51) = "101100000" ' 3
  128.     BC39(52) = "000110001" ' 4
  129.     BC39(53) = "100110000" ' 5
  130.     BC39(54) = "001110000" ' 6
  131.     BC39(55) = "000100101" ' 7
  132.     BC39(56) = "100100100" ' 8
  133.     BC39(57) = "001100100" ' 9
  134.     BC39(65) = "100001001" ' A
  135.     BC39(66) = "001001001" ' B
  136.     BC39(67) = "101001000" ' C
  137.     BC39(68) = "000011001" ' D
  138.     BC39(69) = "100011000" ' E
  139.     BC39(70) = "001011000" ' F
  140.     BC39(71) = "000001101" ' G
  141.     BC39(72) = "100001100" ' H
  142.     BC39(73) = "001001100" ' I
  143.     BC39(74) = "000011100" ' J
  144.     BC39(75) = "100000011" ' K
  145.     BC39(76) = "001000011" ' L
  146.     BC39(77) = "101000010" ' M
  147.     BC39(78) = "000010011" ' N
  148.     BC39(79) = "100010010" ' O
  149.     BC39(80) = "001010010" ' P
  150.     BC39(81) = "000000111" ' Q
  151.     BC39(82) = "100000110" ' R
  152.     BC39(83) = "001000110" ' S
  153.     BC39(84) = "000010110" ' T
  154.     BC39(85) = "110000001" ' U
  155.     BC39(86) = "011000001" ' V
  156.     BC39(87) = "111000000" ' W
  157.     BC39(88) = "010010001" ' X
  158.     BC39(89) = "110010000" ' Y
  159.     BC39(90) = "011010000" ' Z
  160.    
  161.     MD_BC39 = BC39(Asc(CharCode))
  162.  
  163. Exit_BC39:
  164.     Exit Function
  165.  
  166. ErrorTrap_BC39:
  167.     MD_BC39 = ""
  168.     Resume Exit_BC39
  169.  
  170. End Function
Miro