Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
24.04.2024, 18:41:32

Войти
Хотите поблагодарить участника за дельный совет? Нажмите [Повысить]. Так вы заслуженно поднимите репутацию активному участнику.
33 242 Сообщений в 5 457 Тем от 6 761 Пользователей
Последний пользователь: Halfdoor
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Полезные решения
| | |-+  Генератор штрихкодов Code128
Страниц: [1]   Вниз
Печать
Автор Тема: Генератор штрихкодов Code128  (Прочитано 21401 раз)
0 Пользователей и 1 Гость смотрят эту тему.
yakovleff
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля
« : 13.06.2014, 10:44:59 »

Всем привет,

С тех пор, как был разработан генератор для Code93, я размышлял над генератором для Code128. И вот наконец сделал. Как и ранее, хочу поделиться. Может, кому пригодится  ;).
Алгоритм Code128 оказался намного проще в кодировании и намного мощнее. С его помощью можно очень компактно кодировать цифровые последовательности.

Особенности:
- Принципы кодирования взяты с CODE128 SYMBOLOGY;
- Процедура использует коллекцию Shapes для рисования линий вместо специального шрифта;
- Код рисует штрихкод на целевой Worksheet, начиная от опорной позиции, определяемой начальными координатами (X) и (Y), измеряемыми в мм, требуемой высоты в мм; толщина линий в пунктах (pt);
- Код использует только режимы "B" и "C";
- Для кодирования цифровых последовательностей применен следующий "твик": если цифровая строка нечетной длины, первый символ кодируется в режиме В, остальные - в режиме С. Это значительно сокращает длину кода по сравнению с чистым режимом В.
- При рисовании применено перекрытие штрихов 10% (Excel 2007). При таком значении сканеры читали код наилучшим образом.

Недоделки:
- Код не генерирует специальные управляющие символы с кодами 95-98, 100, 102 в режиме "B" и 102 в режиме "C".
- Код не проверяет длину кодируемой строки;
- Полная длина штрих-кода не высчитывается, поэтому возможны непредсказуемые вылеты;
- Код генерирует только горизонтальные шрихкоды;
- Положение штрихкода правильное, когда выставлен печатный масштаб страницы 100%.
- Код аппаратно-программно-зависимый - на разных версиях ОС, Excel и принтерах может давать разные результаты. НЕ тестировалось!

При разработке применялись Win 7 Ultimate, MS Office 2007.
Собственно, код:
spoiler for Hiden:
Код: (vb)
Sub Code128Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
                  ByRef TargetSheet As Worksheet, ByVal Content As String)
' Supports B and C charsets only; values 00-94, 99,101, 103-105 for B, 00-101, 103-105 for C
' X, Y - top-left corner coordinates
' X in mm (0.376042)
' Y in mm (0.341)
' Height in mm
' LineWeight in pt

Const Tbar_Symbol As String * 2 = "11" ' termination bar
Dim WeightSum As Single
Dim CurBar As Integer
Dim i, j, k, FirstSymbol As Integer
Dim tstr2 As String * 2
Dim tstr1 As String * 1
Dim ContentString As String ' bars sequence

Dim SymbolValue(0 To 106) As Integer ' values
Dim SymbolString(0 To 106) As String * 11 'bits sequence
Dim SymbolCharB(0 To 106) As String * 1  'Chars in B set
Dim SymbolCharC(0 To 106) As String * 2  'Chars in B set

For i = 0 To 106 ' values
    SymbolValue(i) = i
Next i

' Symbols in charset B
For i = 0 To 94
    SymbolCharB(i) = Chr(i + 32)
Next i

' Symbols in charset C
SymbolCharC(0) = "00"
SymbolCharC(1) = "01"
SymbolCharC(2) = "02"
SymbolCharC(3) = "03"
SymbolCharC(4) = "04"
SymbolCharC(5) = "05"
SymbolCharC(6) = "06"
SymbolCharC(7) = "07"
SymbolCharC(8 ) = "08"
SymbolCharC(9) = "09"
For i = 10 To 99
    SymbolCharC(i) = CStr(i)
Next i

' bit sequences
SymbolString(0) = "11011001100"
SymbolString(1) = "11001101100"
SymbolString(2) = "11001100110"
SymbolString(3) = "10010011000"
SymbolString(4) = "10010001100"
SymbolString(5) = "10001001100"
SymbolString(6) = "10011001000"
SymbolString(7) = "10011000100"
SymbolString(8 ) = "10001100100"
SymbolString(9) = "11001001000"
SymbolString(10) = "11001000100"
SymbolString(11) = "11000100100"
SymbolString(12) = "10110011100"
SymbolString(13) = "10011011100"
SymbolString(14) = "10011001110"
SymbolString(15) = "10111001100"
SymbolString(16) = "10011101100"
SymbolString(17) = "10011100110"
SymbolString(18) = "11001110010"
SymbolString(19) = "11001011100"
SymbolString(20) = "11001001110"
SymbolString(21) = "11011100100"
SymbolString(22) = "11001110100"
SymbolString(23) = "11101101110"
SymbolString(24) = "11101001100"
SymbolString(25) = "11100101100"
SymbolString(26) = "11100100110"
SymbolString(27) = "11101100100"
SymbolString(28) = "11100110100"
SymbolString(29) = "11100110010"
SymbolString(30) = "11011011000"
SymbolString(31) = "11011000110"
SymbolString(32) = "11000110110"
SymbolString(33) = "10100011000"
SymbolString(34) = "10001011000"
SymbolString(35) = "10001000110"
SymbolString(36) = "10110001000"
SymbolString(37) = "10001101000"
SymbolString(38) = "10001100010"
SymbolString(39) = "11010001000"
SymbolString(40) = "11000101000"
SymbolString(41) = "11000100010"
SymbolString(42) = "10110111000"
SymbolString(43) = "10110001110"
SymbolString(44) = "10001101110"
SymbolString(45) = "10111011000"
SymbolString(46) = "10111000110"
SymbolString(47) = "10001110110"
SymbolString(48) = "11101110110"
SymbolString(49) = "11010001110"
SymbolString(50) = "11000101110"
SymbolString(51) = "11011101000"
SymbolString(52) = "11011100010"
SymbolString(53) = "11011101110"
SymbolString(54) = "11101011000"
SymbolString(55) = "11101000110"
SymbolString(56) = "11100010110"
SymbolString(57) = "11101101000"
SymbolString(58) = "11101100010"
SymbolString(59) = "11100011010"
SymbolString(60) = "11101111010"
SymbolString(61) = "11001000010"
SymbolString(62) = "11110001010"
SymbolString(63) = "10100110000"
SymbolString(64) = "10100001100"
SymbolString(65) = "10010110000"
SymbolString(66) = "10010000110"
SymbolString(67) = "10000101100"
SymbolString(68) = "10000100110"
SymbolString(69) = "10110010000"
SymbolString(70) = "10110000100"
SymbolString(71) = "10011010000"
SymbolString(72) = "10011000010"
SymbolString(73) = "10000110100"
SymbolString(74) = "10000110010"
SymbolString(75) = "11000010010"
SymbolString(76) = "11001010000"
SymbolString(77) = "11110111010"
SymbolString(78) = "11000010100"
SymbolString(79) = "10001111010"
SymbolString(80) = "10100111100"
SymbolString(81) = "10010111100"
SymbolString(82) = "10010011110"
SymbolString(83) = "10111100100"
SymbolString(84) = "10011110100"
SymbolString(85) = "10011110010"
SymbolString(86) = "11110100100"
SymbolString(87) = "11110010100"
SymbolString(88) = "11110010010"
SymbolString(89) = "11011011110"
SymbolString(90) = "11011110110"
SymbolString(91) = "11110110110"
SymbolString(92) = "10101111000"
SymbolString(93) = "10100011110"
SymbolString(94) = "10001011110"
SymbolString(95) = "10111101000"
SymbolString(96) = "10111100010"
SymbolString(97) = "11110101000"
SymbolString(98 ) = "11110100010"
SymbolString(99) = "10111011110"
SymbolString(100) = "10111101110"
SymbolString(101) = "11101011110"
SymbolString(102) = "11110101110"
SymbolString(103) = "11010000100"
SymbolString(104) = "11010010000"
SymbolString(105) = "11010011100"
SymbolString(106) = "11000111010"

X = X / 0.376042 'mm to pt
Y = Y / 0.341 'mm to pt
Height = Height / 0.341 'mm to pt

If IsNumeric(Content) = True Then  ' value is numeric
   i = 1 'symbol and weight index
   If Len(Content) Mod 2 = 1 Then 'odd
       WeightSum = SymbolValue(104) ' start-b
       ContentString = ContentString + SymbolString(104)
      tstr1 = Mid(Content, 1, 1)
      k = 0
      Do While tstr1 <> SymbolCharB(k)
         k = k + 1
      Loop
      WeightSum = WeightSum + i * SymbolValue(k)
      ContentString = ContentString + SymbolString(k)
      i = i + 1
      WeightSum = WeightSum + i * SymbolValue(99) 'Code-C
      ContentString = ContentString + SymbolString(99) 'Code-C
      Content = Right(Content, Len(Content) - 1) 'cut 1st symbol
   Else 'even
      WeightSum = SymbolValue(105) ' start-c
      ContentString = ContentString + SymbolString(105)
      i = 0
   End If
  
   For j = 1 To Len(Content) Step 2
      tstr2 = Mid(Content, j, 2)
      i = i + 1
      k = 0
      Do While tstr2 <> SymbolCharC(k)
         k = k + 1
      Loop
      WeightSum = WeightSum + i * SymbolValue(k)
      ContentString = ContentString + SymbolString(k)
   Next j
   ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
   ContentString = ContentString + SymbolString(106)

  
   Else ' alpha-numeric
   WeightSum = SymbolValue(104) ' start-b
   ContentString = ContentString + SymbolString(104)
   i = 0 ' symbol count
   For j = 1 To Len(Content) Step 1
      tstr1 = Mid(Content, j, 1)
      i = i + 1
      k = 0
      Do While tstr1 <> SymbolCharB(k)
         k = k + 1
      Loop
      WeightSum = WeightSum + i * SymbolValue(k)
      ContentString = ContentString + SymbolString(k)
   Next j
   ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
   ContentString = ContentString + SymbolString(106)

End If

ContentString = ContentString + Tbar_Symbol

'Barcode drawing
CurBar = 0

For i = 1 To Len(ContentString)
    Select Case Mid(ContentString, i, 1)
    Case 0
        CurBar = CurBar + 1
    Case 1
        CurBar = CurBar + 1
' (CurBar * LineWeight) * 0.9 -  here is 10% overlapping :-)
        With TargetSheet.Shapes.AddLine(X + (CurBar * LineWeight) * 0.9, Y, X + (CurBar * LineWeight) * 0.9, (Y + Height)).Line
        .Weight = LineWeight
        .ForeColor.RGB = vbBlack ' my Excel writes light-blue lines by default, so the color is forcibly switched
        End With
    End Select
Next i

End Sub
Тестирование проводилось на Android-телефоне (Accusoft Barcode Scanner) и на хардовых сканерах PROTON IMS-3100 и дешевом китайском (PAN.CODE A500).

Надеюсь, кому-нибудь пригодится!  ;)
Просьба комментировать, если будете использовать в своих приложениях.

Yakovleff
« Последнее редактирование: 13.06.2014, 11:00:36 от The_Prist » Записан
yakovleff
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля
« Ответ #1 : 13.06.2014, 10:50:58 »

Из-за особенностей форума строки кода
SymbolCharC(img src="http://www.excel-vba.ru/forum/Smileys/default/cool.gif" alt="Крутой" border="0"> = "08"  
и
SymbolString(img src="http://www.excel-vba.ru/forum/Smileys/default/cool.gif" alt="Крутой" border="0"> = "10001100100"  

должны писаться как:
SymbolCharC(8 ) = "08"  
и
SymbolString(8 ) = "10001100100"  

Прошу прощения, не знаю как это контролировать при написании поста.
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 831



Просмотр профиля WWW
« Ответ #2 : 13.06.2014, 11:02:32 »

Исправил. Движок форума интерпретирует эту связку как смайлик. Контролировать просто - писать "8" и ")" с пробелом.
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru