|
|
|
(обращений: 45667 с 16.10.2002)
Разделы:
Отчеты
|
(статью можно редактировать)
Описание: Для того, чтобы встроить в отчет на Access бар-код EAN13 необходимо установить на компьютер прилагаемый шрифт, сформировать строку баркода из 12 символов, добавить к ней контрольную сумму (функция CheckBar), получить значение кода для корректного отображения его данным фонтом (функция EAN13p36TT) и подставить полученное значение в качестве ControlSource для TextBoxа на отчете, для которого установлен данный шрифт.
:)
Объяснил сумбурно, но думаю разобраться можно :)
Кстати, чтобы установить шрифт можно воспользоваться вот этой API-функцией
Public Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As _
Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Public Const HWND_BROADCAST = &HFFFF&
Public Const WM_FONTCHANGE = &H1D
После добавления шрифта необходимо оповестить приложения об этом:
Call SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Автор: Отдел IT ТД Русьимпорт :)
Option Compare Database
Option Explicit
Public Function CheckBar(Bar As Currency) As Integer
'выcчитывает по первым 12 цифрам тринадцатую (контрольную сумму)
Dim Cod(12)
Dim c
Dim s
Dim i As Integer
If Len(Trim(str(Bar))) <> 12 Then
MsgBox "Штрих код должен содержать 12 цифр", vbCritical
Else
s = 0
For i = 1 To 12
c = mID(Bar, i, 1)
s = s + IIf(i Mod 2 = 0, c * 3, c)
Next
s = s Mod 10
CheckBar = 10 - s
End If
End Function
Public Function EAN13(BarCode As String) As String
'Строку из 13 цифр преобразует в Штрих-код EAN-13.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC.
Const a As Integer = 48
Const b As Integer = 65
Const c As Integer = 97
Const d As Integer = 75
Dim i As Integer
Dim Cod(13, 2) As Integer
Dim f(6, 10) As Integer
Dim strEAN13 As String
If Len(BarCode) <> 13 Then
EAN13 = ""
MsgBox "Штрих код за пределами отведенного диапазона.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
If Right(BarCode, 1) <> EAN13Check(BarCode) Then
EAN13 = ""
MsgBox "Ошибка контрольной суммы.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
f(1, 0) = a: f(1, 1) = a: f(1, 2) = a: f(1, 3) = a: f(1, 4) = a
f(1, 5) = a: f(1, 6) = a: f(1, 7) = a: f(1, 8) = a: f(1, 9) = a
f(2, 0) = a: f(2, 1) = a: f(2, 2) = a: f(2, 3) = a: f(2, 4) = b
f(2, 5) = b: f(2, 6) = b: f(2, 7) = b: f(2, 8) = b: f(2, 9) = b
f(3, 0) = a: f(3, 1) = b: f(3, 2) = b: f(3, 3) = b: f(3, 4) = a
f(3, 5) = b: f(3, 6) = b: f(3, 7) = a: f(3, 8) = a: f(3, 9) = b
f(4, 0) = a: f(4, 1) = a: f(4, 2) = b: f(4, 3) = b: f(4, 4) = a
f(4, 5) = a: f(4, 6) = b: f(4, 7) = b: f(4, 8) = b: f(4, 9) = a
f(5, 0) = a: f(5, 1) = b: f(5, 2) = a: f(5, 3) = b: f(5, 4) = b
f(5, 5) = a: f(5, 6) = a: f(5, 7) = a: f(5, 8) = b: f(5, 9) = b
f(6, 0) = a: f(6, 1) = b: f(6, 2) = b: f(6, 3) = a: f(6, 4) = b
f(6, 5) = b: f(6, 6) = a: f(6, 7) = b: f(6, 8) = a: f(6, 9) = a
For i = 1 To 13
Cod(i, 1) = val(mID(BarCode, i, 1))
Next
For i = 2 To 7
Cod(i, 2) = f(i - 1, Cod(1, 1))
Next
strEAN13 = Chr(Cod(1, 1) + 75)
strEAN13 = strEAN13 + Chr(120)
For i = 2 To 7
strEAN13 = strEAN13 + Chr(Cod(i, 1) + Cod(i, 2))
Next
strEAN13 = strEAN13 + Chr(88)
For i = 8 To 13
strEAN13 = strEAN13 + Chr(Cod(i, 1) + c)
Next
strEAN13 = strEAN13 + Chr(120)
EAN13 = strEAN13
End Function
Public Function EAN13Check(BarCode As String) As String
'Выcчитывает контрольную сумму штрих-кода EAN-13.
'Использует первые 12 символов передаваемой строки.
Dim Cod(12)
Dim c As Long
Dim s As Long
Dim i As Integer
s = 0
For i = 1 To 12
c = val(mID(BarCode, i, 1))
s = s + IIf(i Mod 2 = 0, c * 3, c)
Next
s = s Mod 10
EAN13Check = Right(Trim(str(10 - s)), 1)
End Function
Public Function EAN13p36TT(BarCode As String) As String
'Строку из 13 цифр преобразует в Штрих-код EAN-13.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC.
Const a As Integer = 48
Const b As Integer = 65
Const c As Integer = 97
Const d As Integer = 35
Dim i As Integer
Dim Cod(13, 2) As Integer
Dim f(6, 10) As Integer
Dim strEAN13 As String
If Len(BarCode) <> 13 Then
EAN13p36TT = ""
MsgBox "Штрих код за пределами отведенного диапазона.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
If Right(BarCode, 1) <> EAN13Check(BarCode) Then
EAN13p36TT = ""
MsgBox "Ошибка контрольной суммы.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
f(1, 0) = a: f(1, 1) = a: f(1, 2) = a: f(1, 3) = a: f(1, 4) = a
f(1, 5) = a: f(1, 6) = a: f(1, 7) = a: f(1, 8) = a: f(1, 9) = a
f(2, 0) = a: f(2, 1) = a: f(2, 2) = a: f(2, 3) = a: f(2, 4) = b
f(2, 5) = b: f(2, 6) = b: f(2, 7) = b: f(2, 8) = b: f(2, 9) = b
f(3, 0) = a: f(3, 1) = b: f(3, 2) = b: f(3, 3) = b: f(3, 4) = a
f(3, 5) = b: f(3, 6) = b: f(3, 7) = a: f(3, 8) = a: f(3, 9) = b
f(4, 0) = a: f(4, 1) = a: f(4, 2) = b: f(4, 3) = b: f(4, 4) = a
f(4, 5) = a: f(4, 6) = b: f(4, 7) = b: f(4, 8) = b: f(4, 9) = a
f(5, 0) = a: f(5, 1) = b: f(5, 2) = a: f(5, 3) = b: f(5, 4) = b
f(5, 5) = a: f(5, 6) = a: f(5, 7) = a: f(5, 8) = b: f(5, 9) = b
f(6, 0) = a: f(6, 1) = b: f(6, 2) = b: f(6, 3) = a: f(6, 4) = b
f(6, 5) = b: f(6, 6) = a: f(6, 7) = b: f(6, 8) = a: f(6, 9) = a
For i = 1 To 13
Cod(i, 1) = val(mID(BarCode, i, 1))
Next
For i = 2 To 7
Cod(i, 2) = f(i - 1, Cod(1, 1))
Next
strEAN13 = Chr(Cod(1, 1) + 35)
strEAN13 = strEAN13 + Chr(33)
For i = 2 To 7
strEAN13 = strEAN13 + Chr(Cod(i, 1) + Cod(i, 2))
Next
strEAN13 = strEAN13 + Chr(45)
For i = 8 To 13
strEAN13 = strEAN13 + Chr(Cod(i, 1) + c)
Next
strEAN13 = strEAN13 + Chr(33)
EAN13p36TT = strEAN13
End Function
|
[Back]
|
Текущий рейтинг:
5 из 5 (проголосовало:4).
 |
Здравствуйте!
Для участия в рейтинге необходимо залогиниться на сайт.
Это сделано для того, чтобы более точно производить оценку статей (чтобы одному и тому же человеку было труднее голосовать несколько раз, портя тем самым статистику.
Эта процедура очень быстрая и, надеюсь, Вас не затруднит :).
Все мысли по поводу работы сайта всегда можно высказать на форуме!
Вход на сайт
|
|
|
|
|
|
|
|
| Хорошо бы шрифт в zip запаковать, а то его очень проблематично скачать (не из-за размера :)). |
| 17.10.2002 14:54 |
|
|
| запаковал :) |
| 18.10.2002 11:59 |
|
|
| Shrift dla ispolzafanija freeware, il eto nelegalnaja veshitsa ??? |
| 25.10.2002 12:52 |
|
|
2Dmitrijis:
Opa...
A vot ne znaju. Font nayden v inete (vrode by, tochno ne znaju)
Esli kto predyavit prava - uberu s sayta.
|
| 25.10.2002 12:57 |
|
|
Как не странно но...
http://www.atomictype.co.uk/brock_page.html
бесплатный сыр... |
| 03.12.2002 11:00 |
|
|
спасибо очень помогло и работает из vb6 отлично
но нужен код 128 если можно помогите.
спасибо. |
| 18.12.2002 01:26 |
|
|
| Разных генераторов ШК (от ActiveX-компонент до готового ПО) нашел уйму. А вот теперь понадобился модуль для ЧТЕНИЯ штрихкода.Если кто что знает - плз, отпишите на мыло... |
| 07.03.2003 22:24 |
|
|
Для чтения мы используем обычное текстовое поле и сканер штрих-кода, который включается в разрыв клавиатуры, так что считываешь сканером значение - оно уже в виде текста в поле...
|
| 11.03.2003 10:55 |
|
|
В чем функциональная разница функций EAN13 и EAN13p36TT ?
Не могу въехать.
Public Function EAN13(BarCode As String) As String
'Строку из 13 цифр преобразует в Штрих-код EAN-13.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC.
---------------------------------------------
Public Function EAN13p36TT(BarCode As String) As String
'Строку из 13 цифр преобразует в Штрих-код EAN-13.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC. |
| 07.08.2003 17:50 |
|
|
насколько я помню - вроде бы они для разных фонтов...
Для того, который можно скачать здесь надо юзать EAN13p36TT.
Вроде так. |
| 07.08.2003 17:54 |
|
|
Функция CheckBar должна выдавать 1 знак.
Почему:
CheckBar(240000007777)=10
??? |
| 15.08.2003 10:46 |
|
|
Почему:
CheckBar(240000007777)=10
видимо не очень хорошая функция 
Попробуйте использовать EAN13Check. |
| 15.08.2003 11:23 |
|
|
 Помогите, надо увидеть визуально штрих-код в отчете: код из 12 цифр, а рядом его изображение, т.е. сам штрих-код. |
| 14.10.2003 09:54 |
|
|
| | Светлана писал: | | Помогите, надо увидеть визуально штрих-код в отчете: код из 12 цифр, а рядом его изображение, т.е. сам штрих-код. |
А если перейти в сааамый верх статьи и ещё раз прочитать её внимательно?
Именно для того чтобы показать как напечатать сам штрих код в отчете она и была опубликована... |
| 14.10.2003 09:59 |
|
|
| Реально решило проблемо! |
| 05.02.2004 11:17 |
|
|
 Спасибо!
Все работает замечательно. |
| 23.05.2004 17:12 |
|
|
| А для Code 39 кто-нить знает, где взять ф-ции для пользования? |
| 21.06.2004 11:08 |
|
|
| А как переделать эту байду под EAN8. Как будто бы всё переправил, в статьях разных пишется, что контрольная цифра считается также как и в EAN13, но вот на самом деле не также :((. Подскажите, что надо изменить, может функцию EAN13Check?, я оставил тотже набор символов. VErY need |
| 25.06.2004 11:30 |
|
|
Разобрался, что к чему. Если кому надо, то вот немного переделанные функции под EAN8. А вот ссылка на инфу: http://www.retail.ru/biblio/code02.htm
'*****то же самое для EAN8
'
'
Public Function Bar8(n As Double) As String ' для EAN-8
Dim sBar As String
sBar = Format(n, "0000000")
sBar = sBar & EAN8Check(sBar)
Bar8 = EAN8p36TT(sBar)
End Function
Public Function EAN8Check(BarCode As String) As String
'Выcчитывает контрольную сумму штрих-кода EAN-8.
'Использует первые 7 символов передаваемой строки.
Dim Cod(7)
Dim c As Long
Dim S As Long
Dim I As Integer
S = 0
For I = 1 To 7
c = val(Mid(BarCode, I, 1))
S = S + IIf(I Mod 2 = 0, c, c * 3) 'здесь на 3 умножается нечетный эл-т
Next
S = S Mod 10
EAN8Check = right(Trim(str(10 - S)), 1)
End Function
Public Function EAN8p36TT(BarCode As String) As String
'Строку из 8 цифр преобразует в Штрих-код EAN-8.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC.
Const a As Integer = 48 'комбинация А
Const b As Integer = 65 'комбинация B
Const c As Integer = 97 'комбинация C
'Const d As Integer = 35 'первый символ
Dim I As Integer
Dim Cod(8) As Integer
Dim strEAN8 As String
If Len(BarCode) <> 8 Then
EAN8p36TT = ""
msgbox "Штрих код за пределами отведенного диапазона.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
If right(BarCode, 1) <> EAN8Check(BarCode) Then
EAN8p36TT = ""
msgbox "Ошибка контрольной суммы.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
For I = 1 To 8
Cod(I) = val(Mid(BarCode, I, 1))
Next
strEAN8 = Chr(33) ' краевой штрих
For I = 1 To 4
strEAN8 = strEAN8 + Chr(Cod(I) + a) 'первые 4 цифры выполнены в комбинации А
Next
strEAN8 = strEAN8 + Chr(45) 'центральный штрих
For I = 5 To 8
strEAN8 = strEAN8 + Chr(Cod(I) + c) 'последние 4 цифры выполнены в комбинации С
Next
strEAN8 = strEAN8 + Chr(33) ' краевой штрих
EAN8p36TT = strEAN8
End Function
|
| 28.06.2004 11:31 |
|
|
| а у меня какая-то ерунда получилась с квадратиками... может, я чего не так делаю? |
| 07.07.2005 12:59 |
|
|
| Господа! А все-таки, как можно программно распечать (сгенерировать) штрих-код Code128&? |
| 08.08.2005 21:35 |
|
|
| Мне пришлось исправить эту ошибку в функции CheckBar - в конце функции поставь проверку - если s=10 то s=0. И все будет ОК. |
| 01.02.2006 22:43 |
|
|
хорошая прога !
Всё работает ! (с поправками)
спасиб огромный ! |
| 04.07.2006 15:33 |
|
|
Вот нашел в и-нете. Может кому пригодится.
Разработчик: TradeSoft
Адрес сайта: http://www.tradesoft.ru/products/barcode/
Программа "Расшифровщик штрихкода" предназначена для расшифровки 13-разрядного кода (EAN-13), а также проверки контрольного разряда.
Возможности программы:
- Расшифровка кода EAN-13
- Получение полной информации о производителе товара
- Получение полной информации о товаре и его характеристиках
- Просмотр кода страны, производителя, товара
- Возможность проверки контрольного разряда
- Сохранение найденной информации в базу данных для удобства поиска
- Сворачивание программы в системный трей и возможность вызова по горячей клавише
- Автоматическая проверка наличия обновления на сайте разработчика
|
| Присоединенный файл:ean13rus.rar (Размер: 866975 байт, Скачиваний:1757) |
| 19.11.2007 14:35 |
|
|
А почему-то ссылка http://www.atomictype.co.uk/brock_page.html не работает...
Кто успел скачать бесплатный сыр? Помогите, плиззз!!!
Нужны шрифты штриховых кодов. |
| 21.11.2007 10:37 |
|
|
Заинтересовала данная статья но... я как малоопытный писака на VB не могу отладить данную программулину.
Помогите!!! |
| 27.01.2012 11:26 |
|
|
| Подобные вопросы надо задавать на форуме, а не в статье. И подробнее, что значит - "не могу отладить" |
| 27.01.2012 12:35 |
|
|
Я не против организовать свой вопрос на форуме но... боюсь он утонет в потоке информации и более важных вопросов.
Я не обижусь, если мои посты передвинут или вообще удалят. Нубов нигде не любят. они всегда топчутся под ногами.
Запросы делать могу всех видов, формы делать могу. Сделал для себя не одну базу данных. Но никогда не работал с отчётами и слабо владею VB.
Для меня не понятно само начало, как в отчёте: "... сформировать строку баркода из 12 символов..." , если брать информацию для штрихкода из поля "Код" таблицы "Товары" |
27.01.2012 16:52 (последнее изменение - 27.01.2012 17:22)  |
|
|
| Вопрос Avokado перенесён в форум. |
| 30.01.2012 12:07 (последнее изменение - 30.01.2012 16:56) |
|
|
| А где сам шрифт на EAN-8 взять? |
| 24.03.2012 23:15 |
|