1. Пользоваться форумом на планшетах и телефонах стало удобнее благодаря Tapatalk

Автоматическая расстановка штрих-кодов

Тема в разделе "CorelDraw", создана пользователем -, 25 апр 2006.

Модераторы: Артер
  1. Guest

    Помогите пожалуйста. Нужно научиться менять штрих-кода с нумерацией например с 9099000013001 до 9099000015001. Подскажите что-нибудь. До сих пор набиваю вручную через Corel BarCode
     
  2. Kerch

    Kerch Активный участник

    С нами с:
    13.09.2006
    Сообщения:
    63
    Симпатии:
    0
    Баллы:
    5
    Ищи спецшрифт
     
  3. Guest

    Да поискал я. Нет. Это раз. И два - как же автоматизацию на 20000 различных номеров сделать?
     
  4. Kerch

    Kerch Активный участник

    С нами с:
    13.09.2006
    Сообщения:
    63
    Симпатии:
    0
    Баллы:
    5
    Поищи в поиске. Тема неоднократно обсуждалась
     
  5. Guest

    SNX Уже выяснил.
     
  6. Guest

    Сделал я скрипт, все по совковым ГОСТам делает
    Читается замечательно, лучше чем Corelовским Barcod ом
    Можно через скрипт задавать поворот, редукцию штрихов, расположение, проверяет соответствие ГОСТам, ну а остальное ручками если надо, или доработаю

    Пример использования
    EAN13(MMInInch(5), MMInInch(5), "481183800002", , , 0.8, 30, 0, 0.02)
    EAN13(MMInInch(50), MMInInch(5), "481183800008")
    Set TempShape = EAN13(MMInInch(100), MMInInch(5), "481183802356", MMInInch(42), MMInInch(33), 2, 30, 90, 0.06)

    А вообще делал, программку для печатания бирок для швейников с базой данных из которой брались артикулы, госты, размеры, EAN коды для каждой модели и размера

    Если что пишите
     
  7. Kerch

    Kerch Активный участник

    С нами с:
    13.09.2006
    Сообщения:
    63
    Симпатии:
    0
    Баллы:
    5
    Выкладывайте.
    Будет интересно взглянуть.
     
  8. Guest

    Как приверженец той мысли что, ЕСЛИ ХОЧЕШЬ ЧЕГО-ТО ПОЛУЧИТЬ ТО НАПРЯГАЙСЯ ИЛИ ПОМОГИ ЧЕЛОВЕКУ КТО ПОМОГАЕТ ТЕБЕ

    ДЛЯ ТЕХ КТО УМЕЕТ НАПРЯГАТЬСЯ ЧАСТЬ КОДА, остальные пишите будем договариваться :)

    Public Function EAN13(x As Double, y As Double, Kod As String, Optional W As Double, Optional H As Double, _
    Optional SKScale As Double, Optional SKTruncation As Double, _
    Optional SRotate As Double, Optional SXPrintErr As Double) As Shape

    Call SetMyConst(Kod)

    If (SKScale = 0) Then KScale = 1 Else: _
    If SKScale > 2 Then KScale = 2 Else: _
    If SKScale < 0.8 Then KScale = 0.8 Else KScale = SKScale

    If SKTruncation = 0 Then KTruncation = 0 Else: _
    If SKTruncation > 30 Then KTruncation = 30 Else KTruncation = SKTruncation

    If SRotate = 0 Then Rotate = 0 Else Rotate = SRotate

    If SXPrintErr = 0 Then XPrintErr = 0 Else XPrintErr = MMInInch(SXPrintErr)
    XPrintErr2 = XPrintErr / 2

    If (Len(Kod) <> 12) Then Exit Function
    For i = 1 To 12
    TKod(i) = CByte(Mid(Kod, i, 1))
    Next i

    W1 = W: H1 = H
    x1 = XPage + x: y1 = YPage + y


    XW = MMInInch(0.33)
    XH = MMInInch(22.85)
    XH = XH - XH / 100 * KTruncation

    XAddH = 5 * XW
    XH1 = XH + XAddH

    'Проверяем ширину и высоту прямоугольника
    W3 = 113 * XW: H3 = XH + XW * 10
    W2 = W3 * KScale: H2 = H3 * KScale
    If W2 > W1 Then W1 = W3
    If H2 > H1 Then H1 = H3

    'Определяем базовые точки X, Y для рисования штрихов
    LW = XW * 11 ': RW = XW * 7
    W4 = (W1 - W3) / 2: H4 = (H1 - H3) / 2
    XHt0 = x1 + LW + W4: YHt0 = y1 + XW * 4 + H4


    'Рамка кода
    Set EANSh = ActiveLayer.CreateRectangle2(x1, y1, W1, H1)
    EANSh.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
    EANSh.Outline.SetProperties 0#
    EANSh.ObjectData("Name").Value = "EANRamka"
    EANOb.Add EANSh
    'Определение последней цифры
    Numbe0 = VerifyN(TKod)
    If Numbe0 <> False Then TKod(13) = CByte(Numbe0) 'Else Exit Sub

    'Перевод в двоичную кодировку
    Call ToDooble(TKod)

    'Прорисовка кода
    Pk = "0"
    PXHt = XHt0

    For i = 1 To 5
    PL = Len(TDo01(i, 0))
    For j = 1 To PL
    PN = Mid(TDo01(i, 0), j, 1)
    If PN = "1" Then
    If PL = j Then
    PXWH = PXWH + XW
    Call Shtrih(TDo01(i, 1), PXHt, YHt0, PXWH, XH, XH1, XAddH)
    PXHt = PXHt + PXWH: PXWH = 0
    Else
    PXWH = PXWH + XW: Pk = "1"
    End If
    Else
    If Pk = "1" Then
    Call Shtrih(TDo01(i, 1), PXHt, YHt0, PXWH, XH, XH1, XAddH)
    PXHt = PXHt + PXWH + XW: PXWH = 0: Pk = "0"
    Else
    PXHt = PXHt + XW
    End If
    End If
    Next j
    Next i

    'Написание цифр
    PTX = XHt0 - 10 * XW
    TY = YHt0 - 3 * XW
    For i = 1 To 13
    Set EANSh = ActiveLayer.CreateArtisticText(PTX, TY, TKod(i), cdrEnglishUS, , "OCR-B 10 BT", 10, , , , cdrLeftAlignment)
    EANSh.ObjectData("Name").Value = "EANS"
    EANOb.Add EANSh
    If i = 1 Then
    PTX = PTX + 14 * XW
    ElseIf i = 7 Then
    PTX = PTX + 11 * XW
    Else
    PTX = PTX + 7 * XW
    End If
    Next i
    PTX = PTX + 4 * XW
    Set EANSh = ActiveLayer.CreateArtisticText(PTX, TY, ">", cdrEnglishUS, , "OCR-B 10 BT", 10, , , , cdrLeftAlignment)
    EANSh.ObjectData("Name").Value = "EANS"
    EANOb.Add EANSh

    'Группировка
    Dim EanGr1 As Shape
    'Set EanGr1 = EANSh
    ActiveDocument.CreateSelection
    For Each EANSh In EANOb
    ActiveDocument.AddToSelection EANSh
    Next EANSh
    Set EANGr = ActiveSelection.Group
    EANGr.ObjectData("Name").Value = "EAN" + Kod

    'Масштабирование
    EANGr.GetPosition x, y


    EANGr.SetSizeEx x, y, W1 * KScale
    'Поворот относительно центра
    EANGr.RotateEx Rotate, x + EANGr.SizeWidth / 2, y - EANGr.SizeHeight / 2

    For Num = 1 To EANOb.Count ' Remove name from the collection.
    EANOb.Remove 1 ' Since collections are reindexed automatically, remove the first
    Next
    Set EAN13 = EANGr

    End Function

    Sub Shtrih(PsLen, PsXHt, YHt0, PsXLH, SXH, SXH1, SXAddH) '(Длинный/короткий штрих, координата X, координата Y, ширина штриха, высота штриха, высота длинного штриха, разница в высоте)
    If PsLen Then PsYLHt = SXH: PsYHt = SXAddH Else PsYLHt = SXH1: PsYHt = 0
    Set EANSh = ActiveLayer.CreateRectangle2(PsXHt, YHt0 + PsYHt + XPrintErr2, PsXLH - XPrintErr, PsYLHt)
    EANSh.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
    EANSh.Outline.SetProperties 0#
    EANSh.ObjectData("Name").Value = "EANI"
    EANOb.Add EANSh
    End Sub

    Public Function VerifyN(Key)
    Vk1 = 0
    Vk2 = 0
    For i = 1 To 12 Step 2
    Vk1 = Vk1 + Key(i)
    Next i
    For i = 2 To 12 Step 2
    Vk2 = Vk2 + Key(i)
    Next i
    VerifyN = CByte(Right(CStr(10 - CByte(Right(CStr(Vk1 + Vk2 * 3), 1))), 1))

    End Function

     
  9. Tipograph

    Tipograph Пользователь сайта

    С нами с:
    23.06.2006
    Сообщения:
    10
    Симпатии:
    0
    Баллы:
    2
    Привет Дмитрий Сацевич.
    " ИЛИ ПОМОГИ ЧЕЛОВЕКУ КТО ПОМОГАЕТ ТЕБЕ" Давай я помогу тебе советом. Если можешь скинь скрипт на ящик: Houme@mail.kz
     
Модераторы: Артер

Поделиться этой страницей