EAN-13 条码如何生成-已解决问题区-AUTOIT CN

chishingchan 发表于 2020-6-12 17:20:30

EAN-13 条码如何生成

最近研究 EAN-13 条码，搜索本坛竟然没有搜索到！于是搜索英文论坛，搜索到以第三方软件的代码，也不理想。
后来搜索到一个VBA版的，有点意思，看哪个大大有兴趣编写成 au3 代码。

'计算EAN13校验位
Private Function Get_EAN_CheckSum(rawString As String)

Dim checkSum As Integer
checkSum = 0

For i = 2 To 12 Step 2
   checkSum = checkSum + Val(Mid$(rawString, i, 1))
Next

checkSum = checkSum * 3
For i = 1 To 11 Step 2
   checkSum = checkSum + Val(Mid$(rawString, i, 1))
Next

'函数返回值
Get_EAN_CheckSum = (10 - (checkSum Mod 10)) Mod 10

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'填充EAN码区边界
Private Function Fill_EAN_Bounds(ByVal x As Integer, ByVal y As Integer)

'初始化码区尺寸、背景色
For i = 1 To 100
   Cells(y, x + i).ColumnWidth = 0.2
   Cells(y, x + i).RowHeight = 100
   Cells(y, x + i).Interior.ColorIndex = 0

   Cells(y + 1, x + i).ColumnWidth = 0.2
   Cells(y + 1, x + i).RowHeight = 20
   Cells(y + 1, x + i).Interior.ColorIndex = 0
Next

'初始化码区左侧起始线
Cells(y, x + 1).Interior.ColorIndex = 1
Cells(y + 1, x + 1).Interior.ColorIndex = 1

Cells(y, x + 2).Interior.ColorIndex = 0
Cells(y + 1, x + 2).Interior.ColorIndex = 0

Cells(y, x + 3).Interior.ColorIndex = 1
Cells(y + 1, x + 3).Interior.ColorIndex = 1

'初始化码区中间线
Cells(y, x + 46).Interior.ColorIndex = 0
Cells(y + 1, x + 46).Interior.ColorIndex = 0

Cells(y, x + 47).Interior.ColorIndex = 1
Cells(y + 1, x + 47).Interior.ColorIndex = 1

Cells(y, x + 48).Interior.ColorIndex = 0
Cells(y + 1, x + 48).Interior.ColorIndex = 0

Cells(y, x + 49).Interior.ColorIndex = 1
Cells(y + 1, x + 49).Interior.ColorIndex = 1

Cells(y, x + 50).Interior.ColorIndex = 0
Cells(y + 1, x + 50).Interior.ColorIndex = 0

'初始化码区右侧终止线
Cells(y, x + 93).Interior.ColorIndex = 1
Cells(y + 1, x + 93).Interior.ColorIndex = 1

Cells(y, x + 94).Interior.ColorIndex = 0
Cells(y + 1, x + 94).Interior.ColorIndex = 0

Cells(y, x + 95).Interior.ColorIndex = 1
Cells(y + 1, x + 95).Interior.ColorIndex = 1

'函数返回值
Fill_EAN_Bounds = 0

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'填充EAN13条码线
Private Function Fill_EAN_Lines(ByVal x As Integer, ByVal y As Integer, ByVal n As Integer)

For i = 0 To 6
         Cells(y, x + i).Interior.ColorIndex = IIf(n And (2 ^ (6 - i)), 1, 0)
Next

'函数返回值
Fill_EAN_Lines = 0

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'主过程
Private Sub worksheet_change(ByVal Target As Range)

'焦点不在目标区域则退出
If Target.Address <> "$A$1" Then
   Exit Sub
End If

'初始化参量数组
Dim preModeCode, abModeCode, cModeCode
'前置码数组
preModeCode = Array(0, 11, 13, 14, 19, 25, 28, 21, 22, 26)
'AB模式数组
abModeCode = Array(Array(13, 25, 19, 61, 35, 49, 47, 59, 55, 11), Array(39, 51, 27, 33, 29, 57, 5, 17, 9, 23))
'C模式数组
cModeCode = Array(114, 102, 108, 66, 92, 78, 80, 68, 72, 116)

'获取输入的条码
Dim inText As String
inText = Range("$A$1").Text

'将输入的EAN13码拆分为输入码数组
ReDim inCode(0 To Len(inText) - 1)
For i = 0 To Len(inText) - 1
   inCode(i) = Mid(inText, i + 1, 1)
Next

'计算校验位
Dim checkSum As Integer
checkSum = Get_EAN_CheckSum(inText)
'将校验位压入数组
inCode(Len(inText) - 1) = checkSum

'要绘制的坐标位置
Dim startX, startY As Integer
startX = 3
startY = 3

'绘制码区边界
Dim f, p, t, s As Integer
f = Fill_EAN_Bounds(startX, startY)

p = preModeCode(inCode(0))
For i = 0 To 5
   t = IIf(p And (2 ^ (5 - i)), 1, 0)
   s = Fill_EAN_Lines(4 + startX + 7 * i, startY, abModeCode(t)(inCode(i + 1)))
Next

For i = 6 To 11
   s = Fill_EAN_Lines(9 + startX + 7 * i, startY, cModeCode(inCode(i + 1)))
Next

End Sub

afan 发表于 2020-6-12 18:54:08

https://www.autoitscript.com/forum/topic/141103-barcode-udf/

afan 发表于 2020-6-12 19:19:05

chishingchan 发表于 2020-6-12 22:28:10

afan 发表于 2020-6-12 18:54
https://www.autoitscript.com/forum/topic/141103-barcode-udf/
谢谢a大！

chishingchan 发表于 2020-6-13 19:23:11

afan 发表于 2020-6-12 19:19

不知a大有没有空写一写这个条码生成程序？
类似于公章那个程序，纯属以计算方法生成绘图形式，不依赖字体及第三方控件、库。

afan 发表于 2020-6-13 20:12:24

chishingchan 发表于 2020-6-13 19:23
不知a大有没有空写一写这个条码生成程序？
类似于公章那个程序，纯属以计算方法生成绘图形式，不依赖字 ...

我看看~

afan 发表于 2020-6-14 02:09:00

本帖最后由 afan 于 2020-6-14 15:10 编辑

写了个雏版，费劲，体力活……

chishingchan 发表于 2020-6-14 10:49:11

afan 发表于 2020-6-14 02:09
写了个雏版，费劲，体力活……

a大也制作成一个 Barcode - UDF，将英文论坛的比下去！
条码一般是要符合个人意愿或许会大量排版，所以希望 a 大届时能以 Barcode - UDF 发布，如果制作成单一的保存图片意义就不大。期待 a大的作品！

chishingchan 发表于 2020-6-14 10:54:43

EAN-13 是最常见的条码之一，以下好像也是在英文论坛找到的 Code39，仅供参考：

Stripped Down Code39 Demo.au3

#include <GUIConstantsEx.au3>#include <StaticConstants.au3>

Local $AllowedCode39 = StringSplit("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%", ""), $Code39HorInc = 1, $Code39Hor

$Code39 = "test of code39"

If _VerifyCode39($Code39) == True Then
$BC = GUICreate("Label Image", 384, 155, 1, 1)
GUISetBkColor(0xffffff, $BC)
GUISetFont(Default, Default, Default, "Arial")
$BarcodeDigitsDisplay = GUICtrlCreateLabel(StringUpper($Code39), 5, 105, 380, 20, $SS_CENTER)
GUICtrlSetFont($BarcodeDigitsDisplay, 11, 400, 0, "Verdana")
$BCBox = GUICtrlCreateGraphic(4, 75, 380, 33)
GUICtrlSetGraphic($BCBox, $GUI_GR_PENSIZE, 1)
GUICtrlSetGraphic($BCBox, $GUI_GR_COLOR, 0)
_BarCode39($Code39)
GUISetState(@SW_SHOW, $BC)
Do
$MSG = GUIGetMsg()
If $MSG == $GUI_EVENT_CLOSE Then Exit
Until True == False
EndIf

Func _VerifyCode39($sCode39)
If $sCode39 == "" Then
MsgBox(48, "ERROR", "You have not provided a Code 39 code.")
Return False
EndIf
$Break = StringSplit(StringUpper($sCode39), "")
If $Break > 16 Then
MsgBox(48, "ERROR", "You have too many characters in the provided Code 39 code.Maximum length is 16 characters.")
Return False
EndIf
For $a = 1 To $Break
$GoodChar = False
For $b = 1 To $AllowedCode39
If $Break[$a] == $AllowedCode39[$b] Then $GoodChar = True
Next
If $GoodChar == False Then
MsgBox(48, "ERROR, Character " & $a & "-> " & Chr(34) & $Break[$a] & Chr(34), "You have an illegal character in the provided Code 39 code.Allowed characters are:" & @CR & @CR & "0-9" & @TAB & "(numbers)" & @CR & "A-Z" & @TAB & "(letters)" & @CR & "-" & @TAB & "(hyphen, minus, dash)" & @CR & "." & @TAB & "(period)" & @CR & " " & @TAB & "(space)" & @CR & "$" & @TAB & "(dollar)" & @CR & "/" & @TAB & "(forward slash, divide)" & @CR & "+" & @TAB & "(plus)" & @CR & "%" & @TAB & "(percent)")
Return False
EndIf
Next
Return True
EndFunc ;==>_VerifyCode39

Func _BarCode39($ThisCode)
; B = 3 black
; b = 1 black
; W = 3 white
; w = 1 white
$Code39Hor = 5
$CodeBreak = StringSplit(StringUpper($ThisCode), "")
$Diff = (16 - $CodeBreak) * 10 ; max char = 16, find diff and * 10 since each char is 19.8 pixels
$Code39Hor += $Diff

_Draw39("bWbwBwBwb") ; start (*)
$Code39Hor += $Code39HorInc * 2
For $a = 1 To $CodeBreak
If $CodeBreak[$a] == "0" Then _Draw39("bwbWBwBwb")
If $CodeBreak[$a] == "1" Then _Draw39("BwbWbwbwB")
If $CodeBreak[$a] == "2" Then _Draw39("bwBWbwbwB")
If $CodeBreak[$a] == "3" Then _Draw39("BwBWbwbwb")
If $CodeBreak[$a] == "4" Then _Draw39("bwbWBwbwB")
If $CodeBreak[$a] == "5" Then _Draw39("BwbWBwbwb")
If $CodeBreak[$a] == "6" Then _Draw39("bwBWBwbwb")
If $CodeBreak[$a] == "7" Then _Draw39("bwbWbwBwB")
If $CodeBreak[$a] == "8" Then _Draw39("BwbWbwBwb")
If $CodeBreak[$a] == "9" Then _Draw39("bwBWbwBwb")
If $CodeBreak[$a] == "A" Then _Draw39("BwbwbWbwB")
If $CodeBreak[$a] == "B" Then _Draw39("bwBwbWbwB")
If $CodeBreak[$a] == "C" Then _Draw39("BwBwbWbwb")
If $CodeBreak[$a] == "D" Then _Draw39("bwbwBWbwB")
If $CodeBreak[$a] == "E" Then _Draw39("BwbwBWbwb")
If $CodeBreak[$a] == "F" Then _Draw39("bwBwBWbwb")
If $CodeBreak[$a] == "G" Then _Draw39("bwbwbWBwB")
If $CodeBreak[$a] == "H" Then _Draw39("BwbwbWBwb")
If $CodeBreak[$a] == "I" Then _Draw39("bwBwbWBwb")
If $CodeBreak[$a] == "J" Then _Draw39("bwbwBWBwb")
If $CodeBreak[$a] == "K" Then _Draw39("BwbwbwbWB")
If $CodeBreak[$a] == "L" Then _Draw39("bwBwbwbWB")
If $CodeBreak[$a] == "M" Then _Draw39("BwBwbwbWb")
If $CodeBreak[$a] == "N" Then _Draw39("bwbwBwbWB")
If $CodeBreak[$a] == "O" Then _Draw39("BwbwBwbWb")
If $CodeBreak[$a] == "P" Then _Draw39("bwBwBwbWb")
If $CodeBreak[$a] == "Q" Then _Draw39("bwbwbwBWB")
If $CodeBreak[$a] == "R" Then _Draw39("BwbwbwBWb")
If $CodeBreak[$a] == "S" Then _Draw39("bwBwbwBWb")
If $CodeBreak[$a] == "T" Then _Draw39("bwbwBwBWb")
If $CodeBreak[$a] == "U" Then _Draw39("BWbwbwbwB")
If $CodeBreak[$a] == "V" Then _Draw39("bWBwbwbwB")
If $CodeBreak[$a] == "W" Then _Draw39("BWBwbwbwb")
If $CodeBreak[$a] == "X" Then _Draw39("bWbwBwbwB")
If $CodeBreak[$a] == "Y" Then _Draw39("BWbwBwbwb")
If $CodeBreak[$a] == "Z" Then _Draw39("bWBwBwbwb")
If $CodeBreak[$a] == "-" Then _Draw39("bWbwbwBwB")
If $CodeBreak[$a] == "." Then _Draw39("BWbwbwBwb")
If $CodeBreak[$a] == " " Then _Draw39("bWBwbwBwb")
If $CodeBreak[$a] == "$" Then _Draw39("bWbWbWbwb")
If $CodeBreak[$a] == "/" Then _Draw39("bWbWbwbWb")
If $CodeBreak[$a] == "+" Then _Draw39("bWbwbWbWb")
If $CodeBreak[$a] == "%" Then _Draw39("bwbWbWbWb")
$Code39Hor += $Code39HorInc * 2
Next
_Draw39("bWbwBwBwb") ; finish (*)
EndFunc ;==>_BarCode39
Func _Draw39($Pattern)
$PatternBreak = StringSplit($Pattern, "")
For $a = 1 To $PatternBreak
If $PatternBreak[$a] == "B" Then
GUICtrlSetGraphic($BCBox, $GUI_GR_MOVE, $Code39Hor, 2)
GUICtrlSetGraphic($BCBox, $GUI_GR_LINE, $Code39Hor, 29)
$Code39Hor += $Code39HorInc
GUICtrlSetGraphic($BCBox, $GUI_GR_MOVE, $Code39Hor, 2)
GUICtrlSetGraphic($BCBox, $GUI_GR_LINE, $Code39Hor, 29)
$Code39Hor += $Code39HorInc
GUICtrlSetGraphic($BCBox, $GUI_GR_MOVE, $Code39Hor, 2)
GUICtrlSetGraphic($BCBox, $GUI_GR_LINE, $Code39Hor, 29)
$Code39Hor += $Code39HorInc
EndIf
If $PatternBreak[$a] == "b" Then
GUICtrlSetGraphic($BCBox, $GUI_GR_MOVE, $Code39Hor, 2)
GUICtrlSetGraphic($BCBox, $GUI_GR_LINE, $Code39Hor, 29)
$Code39Hor += $Code39HorInc
EndIf
If $PatternBreak[$a] == "W" Then
$Code39Hor += $Code39HorInc
$Code39Hor += $Code39HorInc
$Code39Hor += $Code39HorInc
EndIf
If $PatternBreak[$a] == "w" Then
$Code39Hor += $Code39HorInc
$Code39Hor += $Code39HorInc
EndIf
Next
EndFunc ;==>_Draw39

afan 发表于 2020-6-14 14:44:19

chishingchan 发表于 2020-6-14 10:49
a大也制作成一个 Barcode - UDF，将英文论坛的比下去！
条码一般是要符合个人意愿或许会大量排版，所以 ...

https://www.autoitx.com/forum.php?mod=viewthread&tid=72053&fromuid=7644923

cashiba 发表于 2020-6-27 11:12:01

涨姿势了....
{:1_206:}

页: [1]

AUTOIT CN's Archiver

EAN-13 条码如何生成