CODIGO BARRA 128EAN - DANFE/DACTE

Citação:

:
Colega JHONSTEVE,

Não precisa ser picture box.

é converter a chave para o formato de barras 128 e aplicar uma função do Crystal Reports.

Eu tenho aqui.

é quase meio-dia e tenho um compromisso, mas depois publico para você.

Tudo de bom.

Citação:

eu ate imaginei algo parecido... tipo baixar uma fonte de codigo 128EAN instalar no pc.. e la no crystal mudar a fonte para essa.. mais nao deu certo kkkk

Citação:

eu ate imaginei algo parecido... tipo baixar uma fonte de codigo 128EAN instalar no pc.. e la no crystal mudar a fonte para essa.. mais nao deu certo kkkk

Citação:

Então, eu faço isso para gerar etiquetas, mas é com a C39, e da certo, agora com a 128 não sei, quer mandar para eu testar ? Vc tem essa font ?
Embora a solução do SINCLAIR, me parece a melhor.

Public Function fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128(str_Numero_para_Codificar)
  
  [ô]Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
  [ô]This function is governed by the GNU Lesser General Public License (GNU LGPL)
  [ô]V 2.0.0
  [ô]Paramètres : une chaine
  [ô]Parameters : a string
  [ô]Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
  [ô]         * une chaine vide si paramètre fourni incorrect
  [ô]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
  fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = [Ô][Ô]
  If Len(str_Numero_para_Codificar) > 0 Then
  [ô]Vérifier si caractères valides
  [ô]Check for valid characters
    For i% = 1 To Len(str_Numero_para_Codificar)
      Select Case Asc(Mid$(str_Numero_para_Codificar, i%, 1))
      Case 32 To 126, 203
      Case Else
        i% = 0
        Exit For
      End Select
    Next
    [ô]Calculer la chaine de code en optimisant l[ô]usage des tables B et C
    [ô]Calculation of the code string with optimized use of tables B and C
    fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = [Ô][Ô]
    tableB = True
    If i% > 0 Then
      i% = 1 [ô]i% devient l[ô]index sur la chaine / i% become the string index
      Do While i% <= Len(str_Numero_para_Codificar)
        If tableB Then
          [ô]Voir si intéressant de passer en table C / See if interesting to switch to table C
          [ô]Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres / yes for 4 digits at start or end, else if 6 digits
          mini% = IIf(i% = 1 Or i% + 3 = Len(str_Numero_para_Codificar), 4, 6)
          GoSub testnum
          If mini% < 0 Then [ô]Choix table C / Choice of table C
            If i% = 1 Then [ô]Débuter sur table C / Starting with table C
              fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = Chr$(210)
            Else [ô]Commuter sur table C / Switch to table C
              fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 & Chr$(204)
            End If
            tableB = False
          Else
            If i% = 1 Then fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = Chr$(209) [ô]Débuter sur table B / Starting with table B
          End If
        End If
        If Not tableB Then
          [ô]On est sur la table C, essayer de traiter 2 chiffres / We are on table C, try to process 2 digits
          mini% = 2
          GoSub testnum
          If mini% < 0 Then [ô]OK pour 2 chiffres, les traiter / OK for 2 digits, process it
            dummy% = Val(Mid$(str_Numero_para_Codificar, i%, 2))
            dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 105)
            fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 & Chr$(dummy%)
            i% = i% + 2
          Else [ô]On n[ô]a pas 2 chiffres, repasser en table B / We haven[ô]t 2 digits, switch to table B
            fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 & Chr$(205)
            tableB = True
          End If
        End If
        If tableB Then
          [ô]Traiter 1 caractère en table B / Process 1 digit with table B
          fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 & Mid$(str_Numero_para_Codificar, i%, 1)
          i% = i% + 1
        End If
      Loop
      [ô]Calcul de la clé de contrôle / Calculation of the checksum
      For i% = 1 To Len(fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128)
        dummy% = Asc(Mid$(fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128, i%, 1))
        dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 105)
        If i% = 1 Then checksum& = dummy%
        checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
      Next
      [ô]Calcul du code ASCII de la clé / Calculation of the checksum ASCII code
      checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 105)
      [ô]Ajout de la clé et du STOP / Add the checksum and the STOP
      fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 = fnc_Codifica_Numero_para_Usar_com_TTF_de_Codigo_de_Barras_Code_128 & Chr$(checksum&) & Chr$(211)
    End If
  End If
  Exit Function
testnum:
  [ô]si les mini% caractères à partir de i% sont numériques, alors mini%=0
  [ô]if the mini% characters from i% are numeric, then mini%=0
  mini% = mini% - 1
  If i% + mini% <= Len(str_Numero_para_Codificar) Then
    Do While mini% >= 0
      If Asc(Mid$(str_Numero_para_Codificar, i% + mini%, 1)) < 48 Or Asc(Mid$(str_Numero_para_Codificar, i% + mini%, 1)) > 57 Then Exit Do
      mini% = mini% - 1
    Loop
  End If
Return
End Function

  Só ha suporte para fontes TrueType. Esta não é uma fonte TrueType. 

Citação:

:
JOHNSTEVE,

Depois de descompactar, tu copiou e colou na pasta Fonts do Windows?

Citação:

:
JOHNSTEVE,

Algum problema ai.

Baixei o anexo aqui, instalei a fonte em uma Máquina Virtual que tenho no notebook e funcionou corretamente.