Impresion Horizontal en Visual Basic 6.0
Publicado por fernando (1 intervención) el 12/04/2012 19:10:30
Hola que tal programadores..
Voy directo al grano, necesito ayuda muy urgente en Visual Basic 6.0 puesto que tengo una solucion en esta maravillosa plataforma, y necesito hacer cambios en un formulario.
El requerimiento trata de que pueda imprimir de vertical a horizontalmente unos BarCodes o codigos de barras. Ya que me los imprime verticalmente, Cualquiera que me ayude con las coordenadas o alguna otra forma de resolver esto le agradecere inifnitamente, este es el codigo:
Private Sub pagePrint(x1, x2, XMLDoc)
Dim queryString, sky
Dim codBarWidth, codBarHeight, FontSize
'IMPRIME PAGINA
Call codeBarInit
' imprime contorno de etiqueta
Call codeBarPrintLine(3, 3, 98, 3) ' Horizontal Superior
Call codeBarPrintLine(3, 16, 98, 16) ' Horizontal Header 1
Call codeBarPrintLine(3, 27, 98, 27) ' Horizontal Header 2
Call codeBarPrintLine(3, 148, 98, 148) ' Horizontal Inferior
Call codeBarPrintLine(3, 3, 3, 148) ' Vertical Izquierda
Call codeBarPrintLine(98, 3, 98, 148) ' Vertical Derecha
Call codeBarPrintLine(45, 3, 45, 27) ' Vertical Header
' imprime datos del encabezado
Call codeBarPrintData("ASN :", ASN, 4, 3, 9)
Call codeBarPrintData("HU :", HU, 51, 3, 9)
Call codeBarPrint(ASN, 4, 7, 200, 30)
Call codeBarPrint(HU, 51, 7, 200, 30)
Call codeBarPrintData("OC :", ORDEN_COMPRA, 4, 18, 9)
Call codeBarPrintData("CAJA :", CAJA, 51, 18, 9)
Call codeBarPrintData("ALMACEN :", ALMACEN, 4, 22, 9)
Call codeBarPrintData("PROVEED :", PROVEEDOR_DES, 51, 22, 9)
For i = x1 To x2 Step 1
FontSize = 9
codBarHeight = 35
codBarWidth = 165
queryString = "//MATERIAL/MAT" + CStr(i)
sku = XMLDoc.selectNodes(queryString).Item(0).Text
Private Sub codeBarInit()
' Create a new instance of BarCode-ActiveX
Set oABarCode = CreateObject("ABarCode.ActiveBC.1")
oABarCode.SetLicenseStr ("0sm1rRYaF/2ED0wqowX/WTToNxtPD3" & _
"L/ykDj9rBg93yEn7jzK/Ym2iUxAEKo" & _
"7/XiayA6cAfkDhaI/J0I3i72item55" & _
"yH1Wsv09kBV09KfqGdq0Ol8u336D6n" & _
"evNNTAZAfSYF8J0vg1/QAjH3mWj+wR" & _
"4Wn/BXFf/vGtUBWmcw60CWHTE7pABQ" & _
"NKnJHmWltlPwr9FTtYfmcZJ17RvroH" & _
"bz3NzMJgqAVpPmaRV40K1txkn9T9Bp" & _
"vbOZDIFbVowACpxoCSeTTfGtPGvjSc" & _
"fD7Ya5docVMai8u8X2LrED5xGZlg0k" & _
"79 ziR7wA = ")
oABarCode.BarType = Code128
oABarCode.ShowCheck = False
oABarCode.ShowText = False
oABarCode.BarAlign = 0
Private Sub codeBarPrintLine(x1, y1, x2, y2)
'IMPRIME LA LINEA SUPERIOR DEL CUADRO PRINCIPAL
Printer.Line (x1, y1)-(x2, y2)
End Sub
Private Sub codeBarPrintData(CurentText, CurrentValue, CurrentX, CurrentY, FontSize)
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE ASN
Printer.CurrentX = CurrentX
Printer.CurrentY = CurrentY
Printer.FontSize = FontSize
Printer.Print CurentText & " " & CurrentValue
End Sub
Private Sub codeBarPrint(CurrentValue, x1, y1, width, height)
'IMPRIME CODIGO DE BARRAS
Clipboard.Clear
oABarCode.BarText = CurrentValue
Call oABarCode.CopyToClipboard(width, height)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, x1, y1
End Sub
Private Sub codeBarEnd()
Printer.EndDoc
Set oABarCode = Nothing
End Sub
Private Sub codeBarPrintData1(CurentText, CurrentValue, CurrentX, CurrentY, FontSize)
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE ASN
Printer.CurrentX = 4
Printer.CurrentY = 3
Printer.FontSize = 9
Printer.Print " ASN : " & ASN
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE ALMACEN
Printer.FontSize = 8
Printer.CurrentX = 51
Printer.CurrentY = 3
Printer.Print " ALMACEN : " & ALMACEN; ""
'DEFINE COORDENADAS PARA IMPRIMER EL CODIGO DE BARRAS DE ASN
Clipboard.Clear
oABarCode.BarText = ASN
Call oABarCode.CopyToClipboard(200, 30)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, 12, 7
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE REFACCIONES, CANTIDAD Y MATERIAL DE PROVEEDOR
Printer.Font.Name = "Arial"
Printer.FontSize = 8
Printer.CurrentX = 51
Printer.CurrentY = 6
Printer.Print " " & UCase(DESCALMACEN)
Printer.CurrentX = 51
Printer.CurrentY = 9
Printer.Print " CANTIDAD: " & CANTIDAD & " " & UM
Printer.CurrentX = 51
Printer.CurrentY = 12
Printer.Print " MATPROV : " & MATPROV
'IMPRIME LINEA DEBAJO DE ASN Y LOS DATOS DE ALMACEN
Printer.Line (3, 16)-(100, 16)
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE PROVEEDOR
Printer.CurrentX = 0
Printer.CurrentY = 18
Printer.Print " PROVEEDOR : " & PROVEEDOR_NUM
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE HU
Printer.CurrentX = 60
Printer.CurrentY = 17
Printer.FontSize = 9
Printer.Print " HU : " & HU
'IMPRIME LINA ARRIBA DE HU
Printer.FontSize = 8
Printer.Line (51, 22)-(100, 22)
' DEFINE COORDENADAS E IMPRIME DATOS DE PROVEEDOR
Printer.FontSize = 8
Printer.CurrentX = 0
Printer.CurrentY = 21
Printer.Print " " & PROVEEDOR_DES
'IMPRIME LINEA DESDE ALMACEN A HU
Printer.Line (51, 3)-(51, 32)
'IMPRIME CODIGO DE BARRAS DE HU
Clipboard.Clear
oABarCode.BarText = HU
Call oABarCode.CopyToClipboard(200, 30)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, 60, 23
' IMPRIME LINEA DEBAJO DE LA BARRA DE HU
Printer.Font.Name = "Arial"
Printer.Line (3, 32)-(100, 32)
'Imprime orden de compra
Printer.FontSize = 8
Printer.CurrentX = 0
Printer.CurrentY = 28.5
Printer.Print " OC : " & ORDEN_COMPRA
'DEFINE COORDENADAS E IMPRIME LEYENDA DE SKU
Printer.CurrentX = 0
Printer.CurrentY = 33
'Printer.Print " ORDEN DE COMPRA : " & ORDEN_COMPRA
'Printer.Print " SKU : "
'IMPRIME EL CODIGO DE BARRAS DEL MATERIAL
Clipboard.Clear
oABarCode.BarText = MATERIAL
Call oABarCode.CopyToClipboard(200, 30)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, 4, 33
'DEFINE COORDENANDAS PARA LA IMPRESION DE MATERIAL, DESCRIPCION ESPANOL Y CHINO
Printer.Font.Name = "Arial"
Printer.FontSize = 7
Printer.CurrentY = 41.5
Printer.CurrentX = 0
Printer.Print " SKU : " & MATERIAL
Printer.Print " DESC : " & DESCMAT
Printer.Print " " & DESCMAT_CHI
' DEFINE COORDENADAS E IMPRIME EL NUMERO DE CAJA
Printer.CurrentX = 53
Printer.CurrentY = 35
Printer.FontSize = 16
Printer.Print "CAJA : " & CAJA
' IMPRIME LA IMAGEN DE ITALIKA
Printer.PaintPicture Picture1.Picture, 79, 44, 20, 6.7
' IMPRIME LAS 2 LINEAS LATERALES Y LA INFERIOR DEL CUADRO
Printer.Line (100, 3)-(100, 50)
Printer.Line (3, 50)-(100, 50)
Printer.Line (3, 3)-(3, 50)
'Call oABarCode.EndPrint
Printer.EndDoc
Set oABarCode = Nothing
End Sub
Sub DrawBarcode(ByVal bc_string As String, obj As Control)
Dim xpos!, y1!, y2!, dw%, th!, tw, new_string$
'define barcode patterns
Dim bc(90) As String
bc(1) = "1 1221" 'pre-amble
bc(2) = "1 1221" 'post-amble
bc(48) = "11 221" 'digits
bc(49) = "21 112"
bc(50) = "12 112"
bc(51) = "22 111"
bc(52) = "11 212"
bc(53) = "21 211"
bc(54) = "12 211"
bc(55) = "11 122"
bc(56) = "21 121"
bc(57) = "12 121"
'capital letters
bc(65) = "211 12" 'A
bc(66) = "121 12" 'B
bc(67) = "221 11" 'C
bc(68) = "112 12" 'D
bc(69) = "212 11" 'E
bc(70) = "122 11" 'F
bc(71) = "111 22" 'G
bc(72) = "211 21" 'H
bc(73) = "121 21" 'I
bc(74) = "112 21" 'J
bc(75) = "2111 2" 'K
bc(76) = "1211 2" 'L
bc(77) = "2211 1" 'M
bc(78) = "1121 2" 'N
bc(79) = "2121 1" 'O
bc(80) = "1221 1" 'P
bc(81) = "1112 2" 'Q
bc(82) = "2112 1" 'R
bc(83) = "1212 1" 'S
bc(84) = "1122 1" 'T
bc(85) = "2 1112" 'U
bc(86) = "1 2112" 'V
bc(87) = "2 2111" 'W
bc(88) = "1 1212" 'X
bc(89) = "2 1211" 'Y
bc(90) = "1 2211" 'Z
'Misc
bc(32) = "1 2121" 'space
bc(35) = "" '# cannot do!
bc(36) = "1 1 1 11" '$
bc(37) = "11 1 1 1" '%
bc(43) = "1 11 1 1" '+
bc(45) = "1 1122" '-
bc(47) = "1 1 11 1" '/
bc(46) = "2 1121" '.
bc(64) = "" '@ cannot do!
bc(65) = "1 1221" '*
bc_string = UCase(bc_string)
'dimensions
obj.ScaleMode = 3 'pixels
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40) 'space between bars
If dw < 1 Then dw = 1
'Debug.Print dw
th = obj.TextHeight(bc_string) 'text height
tw = obj.TextWidth(bc_string) 'text width
new_string = Chr$(1) & bc_string & Chr$(2) 'add pre-amble, post-amble
y1 = obj.ScaleTop
y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
obj.width = 1.1 * Len(new_string) * (15 * dw) * obj.width / obj.ScaleWidth
'draw each character in barcode string
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid$(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = bc(c)
'draw each bar
For i = 1 To Len(bc_pattern$)
Select Case Mid$(bc_pattern$, i, 1)
Case " "
'space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
Case "1"
'space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'line
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &H0&, BF
xpos = xpos + dw
Case "2"
'space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'wide line
obj.Line (xpos, y1)-(xpos + 2 * dw, y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next
'1 more space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'final size and text
obj.width = (xpos + dw) * obj.width / obj.ScaleWidth
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = y2 + 0.25 * th
'obj.Print bc_string
'copy to clipboard
obj.Picture = obj.Image
Clipboard.Clear
Clipboard.SetData obj.Image, 2
End Sub
Voy directo al grano, necesito ayuda muy urgente en Visual Basic 6.0 puesto que tengo una solucion en esta maravillosa plataforma, y necesito hacer cambios en un formulario.
El requerimiento trata de que pueda imprimir de vertical a horizontalmente unos BarCodes o codigos de barras. Ya que me los imprime verticalmente, Cualquiera que me ayude con las coordenadas o alguna otra forma de resolver esto le agradecere inifnitamente, este es el codigo:
Private Sub pagePrint(x1, x2, XMLDoc)
Dim queryString, sky
Dim codBarWidth, codBarHeight, FontSize
'IMPRIME PAGINA
Call codeBarInit
' imprime contorno de etiqueta
Call codeBarPrintLine(3, 3, 98, 3) ' Horizontal Superior
Call codeBarPrintLine(3, 16, 98, 16) ' Horizontal Header 1
Call codeBarPrintLine(3, 27, 98, 27) ' Horizontal Header 2
Call codeBarPrintLine(3, 148, 98, 148) ' Horizontal Inferior
Call codeBarPrintLine(3, 3, 3, 148) ' Vertical Izquierda
Call codeBarPrintLine(98, 3, 98, 148) ' Vertical Derecha
Call codeBarPrintLine(45, 3, 45, 27) ' Vertical Header
' imprime datos del encabezado
Call codeBarPrintData("ASN :", ASN, 4, 3, 9)
Call codeBarPrintData("HU :", HU, 51, 3, 9)
Call codeBarPrint(ASN, 4, 7, 200, 30)
Call codeBarPrint(HU, 51, 7, 200, 30)
Call codeBarPrintData("OC :", ORDEN_COMPRA, 4, 18, 9)
Call codeBarPrintData("CAJA :", CAJA, 51, 18, 9)
Call codeBarPrintData("ALMACEN :", ALMACEN, 4, 22, 9)
Call codeBarPrintData("PROVEED :", PROVEEDOR_DES, 51, 22, 9)
For i = x1 To x2 Step 1
FontSize = 9
codBarHeight = 35
codBarWidth = 165
queryString = "//MATERIAL/MAT" + CStr(i)
sku = XMLDoc.selectNodes(queryString).Item(0).Text
Private Sub codeBarInit()
' Create a new instance of BarCode-ActiveX
Set oABarCode = CreateObject("ABarCode.ActiveBC.1")
oABarCode.SetLicenseStr ("0sm1rRYaF/2ED0wqowX/WTToNxtPD3" & _
"L/ykDj9rBg93yEn7jzK/Ym2iUxAEKo" & _
"7/XiayA6cAfkDhaI/J0I3i72item55" & _
"yH1Wsv09kBV09KfqGdq0Ol8u336D6n" & _
"evNNTAZAfSYF8J0vg1/QAjH3mWj+wR" & _
"4Wn/BXFf/vGtUBWmcw60CWHTE7pABQ" & _
"NKnJHmWltlPwr9FTtYfmcZJ17RvroH" & _
"bz3NzMJgqAVpPmaRV40K1txkn9T9Bp" & _
"vbOZDIFbVowACpxoCSeTTfGtPGvjSc" & _
"fD7Ya5docVMai8u8X2LrED5xGZlg0k" & _
"79 ziR7wA = ")
oABarCode.BarType = Code128
oABarCode.ShowCheck = False
oABarCode.ShowText = False
oABarCode.BarAlign = 0
Private Sub codeBarPrintLine(x1, y1, x2, y2)
'IMPRIME LA LINEA SUPERIOR DEL CUADRO PRINCIPAL
Printer.Line (x1, y1)-(x2, y2)
End Sub
Private Sub codeBarPrintData(CurentText, CurrentValue, CurrentX, CurrentY, FontSize)
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE ASN
Printer.CurrentX = CurrentX
Printer.CurrentY = CurrentY
Printer.FontSize = FontSize
Printer.Print CurentText & " " & CurrentValue
End Sub
Private Sub codeBarPrint(CurrentValue, x1, y1, width, height)
'IMPRIME CODIGO DE BARRAS
Clipboard.Clear
oABarCode.BarText = CurrentValue
Call oABarCode.CopyToClipboard(width, height)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, x1, y1
End Sub
Private Sub codeBarEnd()
Printer.EndDoc
Set oABarCode = Nothing
End Sub
Private Sub codeBarPrintData1(CurentText, CurrentValue, CurrentX, CurrentY, FontSize)
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE ASN
Printer.CurrentX = 4
Printer.CurrentY = 3
Printer.FontSize = 9
Printer.Print " ASN : " & ASN
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE ALMACEN
Printer.FontSize = 8
Printer.CurrentX = 51
Printer.CurrentY = 3
Printer.Print " ALMACEN : " & ALMACEN; ""
'DEFINE COORDENADAS PARA IMPRIMER EL CODIGO DE BARRAS DE ASN
Clipboard.Clear
oABarCode.BarText = ASN
Call oABarCode.CopyToClipboard(200, 30)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, 12, 7
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE REFACCIONES, CANTIDAD Y MATERIAL DE PROVEEDOR
Printer.Font.Name = "Arial"
Printer.FontSize = 8
Printer.CurrentX = 51
Printer.CurrentY = 6
Printer.Print " " & UCase(DESCALMACEN)
Printer.CurrentX = 51
Printer.CurrentY = 9
Printer.Print " CANTIDAD: " & CANTIDAD & " " & UM
Printer.CurrentX = 51
Printer.CurrentY = 12
Printer.Print " MATPROV : " & MATPROV
'IMPRIME LINEA DEBAJO DE ASN Y LOS DATOS DE ALMACEN
Printer.Line (3, 16)-(100, 16)
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE PROVEEDOR
Printer.CurrentX = 0
Printer.CurrentY = 18
Printer.Print " PROVEEDOR : " & PROVEEDOR_NUM
'DEFINE COORDENADAS PARA IMPRIMER EL DATO DE HU
Printer.CurrentX = 60
Printer.CurrentY = 17
Printer.FontSize = 9
Printer.Print " HU : " & HU
'IMPRIME LINA ARRIBA DE HU
Printer.FontSize = 8
Printer.Line (51, 22)-(100, 22)
' DEFINE COORDENADAS E IMPRIME DATOS DE PROVEEDOR
Printer.FontSize = 8
Printer.CurrentX = 0
Printer.CurrentY = 21
Printer.Print " " & PROVEEDOR_DES
'IMPRIME LINEA DESDE ALMACEN A HU
Printer.Line (51, 3)-(51, 32)
'IMPRIME CODIGO DE BARRAS DE HU
Clipboard.Clear
oABarCode.BarText = HU
Call oABarCode.CopyToClipboard(200, 30)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, 60, 23
' IMPRIME LINEA DEBAJO DE LA BARRA DE HU
Printer.Font.Name = "Arial"
Printer.Line (3, 32)-(100, 32)
'Imprime orden de compra
Printer.FontSize = 8
Printer.CurrentX = 0
Printer.CurrentY = 28.5
Printer.Print " OC : " & ORDEN_COMPRA
'DEFINE COORDENADAS E IMPRIME LEYENDA DE SKU
Printer.CurrentX = 0
Printer.CurrentY = 33
'Printer.Print " ORDEN DE COMPRA : " & ORDEN_COMPRA
'Printer.Print " SKU : "
'IMPRIME EL CODIGO DE BARRAS DEL MATERIAL
Clipboard.Clear
oABarCode.BarText = MATERIAL
Call oABarCode.CopyToClipboard(200, 30)
Picture2.Picture = Clipboard.GetData
Printer.PaintPicture Picture2.Picture, 4, 33
'DEFINE COORDENANDAS PARA LA IMPRESION DE MATERIAL, DESCRIPCION ESPANOL Y CHINO
Printer.Font.Name = "Arial"
Printer.FontSize = 7
Printer.CurrentY = 41.5
Printer.CurrentX = 0
Printer.Print " SKU : " & MATERIAL
Printer.Print " DESC : " & DESCMAT
Printer.Print " " & DESCMAT_CHI
' DEFINE COORDENADAS E IMPRIME EL NUMERO DE CAJA
Printer.CurrentX = 53
Printer.CurrentY = 35
Printer.FontSize = 16
Printer.Print "CAJA : " & CAJA
' IMPRIME LA IMAGEN DE ITALIKA
Printer.PaintPicture Picture1.Picture, 79, 44, 20, 6.7
' IMPRIME LAS 2 LINEAS LATERALES Y LA INFERIOR DEL CUADRO
Printer.Line (100, 3)-(100, 50)
Printer.Line (3, 50)-(100, 50)
Printer.Line (3, 3)-(3, 50)
'Call oABarCode.EndPrint
Printer.EndDoc
Set oABarCode = Nothing
End Sub
Sub DrawBarcode(ByVal bc_string As String, obj As Control)
Dim xpos!, y1!, y2!, dw%, th!, tw, new_string$
'define barcode patterns
Dim bc(90) As String
bc(1) = "1 1221" 'pre-amble
bc(2) = "1 1221" 'post-amble
bc(48) = "11 221" 'digits
bc(49) = "21 112"
bc(50) = "12 112"
bc(51) = "22 111"
bc(52) = "11 212"
bc(53) = "21 211"
bc(54) = "12 211"
bc(55) = "11 122"
bc(56) = "21 121"
bc(57) = "12 121"
'capital letters
bc(65) = "211 12" 'A
bc(66) = "121 12" 'B
bc(67) = "221 11" 'C
bc(68) = "112 12" 'D
bc(69) = "212 11" 'E
bc(70) = "122 11" 'F
bc(71) = "111 22" 'G
bc(72) = "211 21" 'H
bc(73) = "121 21" 'I
bc(74) = "112 21" 'J
bc(75) = "2111 2" 'K
bc(76) = "1211 2" 'L
bc(77) = "2211 1" 'M
bc(78) = "1121 2" 'N
bc(79) = "2121 1" 'O
bc(80) = "1221 1" 'P
bc(81) = "1112 2" 'Q
bc(82) = "2112 1" 'R
bc(83) = "1212 1" 'S
bc(84) = "1122 1" 'T
bc(85) = "2 1112" 'U
bc(86) = "1 2112" 'V
bc(87) = "2 2111" 'W
bc(88) = "1 1212" 'X
bc(89) = "2 1211" 'Y
bc(90) = "1 2211" 'Z
'Misc
bc(32) = "1 2121" 'space
bc(35) = "" '# cannot do!
bc(36) = "1 1 1 11" '$
bc(37) = "11 1 1 1" '%
bc(43) = "1 11 1 1" '+
bc(45) = "1 1122" '-
bc(47) = "1 1 11 1" '/
bc(46) = "2 1121" '.
bc(64) = "" '@ cannot do!
bc(65) = "1 1221" '*
bc_string = UCase(bc_string)
'dimensions
obj.ScaleMode = 3 'pixels
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40) 'space between bars
If dw < 1 Then dw = 1
'Debug.Print dw
th = obj.TextHeight(bc_string) 'text height
tw = obj.TextWidth(bc_string) 'text width
new_string = Chr$(1) & bc_string & Chr$(2) 'add pre-amble, post-amble
y1 = obj.ScaleTop
y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
obj.width = 1.1 * Len(new_string) * (15 * dw) * obj.width / obj.ScaleWidth
'draw each character in barcode string
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid$(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = bc(c)
'draw each bar
For i = 1 To Len(bc_pattern$)
Select Case Mid$(bc_pattern$, i, 1)
Case " "
'space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
Case "1"
'space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'line
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &H0&, BF
xpos = xpos + dw
Case "2"
'space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'wide line
obj.Line (xpos, y1)-(xpos + 2 * dw, y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next
'1 more space
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'final size and text
obj.width = (xpos + dw) * obj.width / obj.ScaleWidth
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = y2 + 0.25 * th
'obj.Print bc_string
'copy to clipboard
obj.Picture = obj.Image
Clipboard.Clear
Clipboard.SetData obj.Image, 2
End Sub
Valora esta pregunta
0