powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Function ean128 перевод из VB в Delphi
5 сообщений из 5, страница 1 из 1
Function ean128 перевод из VB в Delphi
    #37978616
Ужжаз
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
Function ean128(chaine As String) As String

  'This function is governed by the GNU Lesser General Public License (GNU LGPL)
  'V 2.0.0
  'Parameters : a string
  'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
  '         * an empty string if the supplied parameter is no good
  
  Dim i%, checksum&, mini%, dummy%, tableB As Boolean
  ean128 = ""
  If Len(chaine) > 0 Then
  'Check for valid characters
    For i% = 1 To Len(chaine)
      Select Case Asc(Mid(chaine, i%, 1))
      Case 32 To 126, 203, 207
      Case Else
        i% = 0
        Exit For
      End Select
    Next
    'Calculation of the code string with optimized use of tables B and C
    ean128 = ""
    tableB = True
    If i% > 0 Then
      i% = 1 'i% become the string index
      Do While i% <= Len(chaine)
        If tableB Then
          'See if interesting to switch to table C
          'yes for 4 digits at start or end, else if 6 digits
          mini% = IIf(i% = 1 Or i% + 3 = Len(chaine), 4, 6)
          GoSub TestNumOrFnc1
          If mini% < 0 Then 'Choice of table C
            If i% = 1 Then 'Starting with table C
              ean128 = Chr(210)
            Else 'Switch to table C
              ean128 = ean128 & Chr(204)
            End If
            tableB = False
          Else
            If i% = 1 Then ean128 = Chr(209) 'Starting with table B
          End If
        End If
        If Not tableB Then
          'We are on table C, try to process 2 digits or К
          If Asc(Mid(chaine, i%, 2)) = 207 Then
            'We process the Fnc1 (К)
            ean128 = ean128 & Mid(chaine, i%, 1)
            i% = i% + 1
          Else
            mini% = 2
            GoSub TestNum
            If mini% < 0 Then 'OK for 2 digits, process it
              dummy% = Val(Mid(chaine, i%, 2))
              dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 105)
              ean128 = ean128 & Chr(dummy%)
              i% = i% + 2
            Else 'We haven't 2 digits, switch to table B
              ean128 = ean128 & Chr(205)
              tableB = True
            End If
          End If
        End If
        If tableB Then
          'Process 1 digit with table B
          ean128 = ean128 & Mid(chaine, i%, 1)
          i% = i% + 1
        End If
      Loop
      'Calculation of the checksum
      For i% = 1 To Len(ean128)
        dummy% = Asc(Mid(ean128, i%, 1))
        dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 105)
        If i% = 1 Then checksum& = dummy%
        checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
      Next
      'Calculation of the checksum ASCII code
      checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 105)
      'Add the checksum and the STOP
      ean128 = ean128 & Chr(checksum&) & Chr(211)
    End If
  End If
  Exit Function
TestNum:
  'if the mini% characters from i% are numeric, then mini%=0
  mini% = mini% - 1
  If i% + mini% <= Len(chaine) Then
    Do While mini% >= 0
      If Asc(Mid(chaine, i% + mini%, 1)) < 48 Or Asc(Mid(chaine, i% + mini%, 1)) > 57 Then Exit Do
      mini% = mini% - 1
    Loop
  End If
Return
TestNumOrFnc1:
  'if the mini% characters from i% are numeric or Fnc1, then mini%=0
  mini% = mini% - 1
  If i% + mini% <= Len(chaine) Then
    Do While mini% >= 0
      If (Asc(Mid(chaine, i% + mini%, 1)) < 48 Or Asc(Mid(chaine, i% + mini%, 1)) > 57) And Asc(Mid(chaine, i% + mini%, 1)) <> 207 Then Exit Do
      mini% = mini% - 1
    Loop
  End If
Return
End Function


Есть такая функция, необходимо её перевести на Дельфи или UDF MSSQL.
Как буду делать я: смотрю функцию, переделываю и так построчно.
Вопрос: насколько это муторно? Есть ли какие-то аналоги, чтобы не переделывать.
Спасибо.
...
Рейтинг: 0 / 0
Function ean128 перевод из VB в Delphi
    #37978710
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
Function ean128 перевод из VB в Delphi
    #37978739
Ужжаzzzzzzzzz
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
забыл сказать, сторонние продукты не рассматриваются, т.к. функционал будет реализован посредством сторонней ЕРП, имеющей кастрированный интерпретатор Дельфи.
Никаких компонент, библиотек к нему не прицепить.
Даже не уверен, что если я смогу это сделать в Дельфи, можно это будет повторить в интерпретаторе.
Спасибо.
...
Рейтинг: 0 / 0
Function ean128 перевод из VB в Delphi
    #37984700
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Этот ужас легче выбросить и переписать по-людски....
...
Рейтинг: 0 / 0
Function ean128 перевод из VB в Delphi
    #38035722
igara
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
На основании информации code128.narod.ru
переписал на SQL для CODE-128. Остальные элементарно переписать по аналогии
Код во вложении
...
Рейтинг: 0 / 0
5 сообщений из 5, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Function ean128 перевод из VB в Delphi
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]