Галактика в вопросах и ответах

Код: Выделить всё

.Var
 iShtrix_Func:Shtrix_Func;
.endVar
!============ Получить штрихкод документа
.Function GetShtrixCode( ww:string) :string;
begin
  GetShtrixCode:=iShtrix_Func.Interleaved_2of5(ww,True);
end.
!============ Получить штрихкод документа по году и номеру документа
.Function GetShtrixCodeNoDoc(ww_type:word;ww_nodoc:string;ww_ddoc:date) :string;
begin
  GetShtrixCodeNoDoc:=GetShtrixCode(string(ww_type)+'_'+string(year(ww_ddoc))+'_'+ww_nodoc);
end.
!==================================

Код: Выделить всё

//=========================================
// функции для работы с целевым учетом
//=========================================
#ifndef _Shtrix_Func_INCLUDED_
#define _Shtrix_Func_INCLUDED_
#ifdef ComponentVersion
#component "F_USERREPORT"
#endif

objinterface iShtrix_Func;
//===========================================
//Определение набора полос Code 128 по ID
//===========================================
Function Code_128_ID(ID :Integer):String;
//===========================================
//Определение набора полос Code 2 of 7 по символу
//===========================================
Function Codabar_Ch(Ch:String):String;
//===========================================
//Определение набора полос Code 39 по символу
//===========================================
Function Code_39_Ch(Ch:String):String;
//===========================================
//Определение ширины полос Interleaved 2 of 5 для одного символа
//===========================================
Function Code_2of5_Ch(Ch:String):String;
//===========================================
//Определение набора полос Interleaved 2 of 5 по двум символам
//===========================================
Function Interleaved_2of5_Pair(Pair:String):String;
//===========================================
//Штриховые символы шрифта iQs Code 128 по набору полос
//===========================================
Function Code_Char(A:String):String;
//===========================================
//Строка штрих-кода в кодировке Code 128
//===========================================
Function Code_128(A:String):String;
//===========================================
//Строка штрих-кода в кодировке Codabar
//===========================================
Function Codabar(A:String): String;
//===========================================
//Строка штрих-кода в кодировке Code 39
//===========================================
Function Code_39(A:String):string;
//===========================================
//Строка штрих-кода в кодировке Interleaved 2 of 5
//===========================================
Function Interleaved_2of5(A:String; Check : Boolean):string;


end;

vipinterface Shtrix_Func implements iShtrix_Func
#ifdef ATL51
Licensed (free) 
#end
;

#end

Код: Выделить всё

//===========================================
// Фунуции по работе со штрихкодом
//===========================================
// Для вывода требуется установить в систему шрифт Barcode.ttf
// Для вывода в форме вставить поле Interleaved_2of5(штрихкод)
//===========================================
#component "F_USERREPORT"


#include Shtrix_Func.Vih
//===========================================
Interface Shtrix_Func;
//===========================================


//Function Code_Char(A:String):String;Forward;

//===========================================
//Определение набора полос Code 128 по ID
//===========================================
Function Code_128_ID(ID :Integer):String;
var  S:String;
{
  Case ID of 
  0: S:= '212222';
  1: S:= '222122';
  2: S:= '222221';
  3: S:= '121223';
  4: S:= '121322';
  5: S:= '131222';
  6: S:= '122213';
  7: S:= '122312';
  8: S:= '132212';
  9: S:= '221213';
  10: S:= '221312';
  11: S:= '231212';
  12: S:= '112232';
  13: S:= '122132';
  14: S:= '122231';
  15: S:= '113222';
  16: S:= '123122';
  17: S:= '123221';
  18: S:= '223211';
  19: S:= '221132';
  20: S:= '221231';
  21: S:= '213212';
  22: S:= '223112';
  23: S:= '312131';
  24: S:= '311222';
  25: S:= '321122';
  26: S:= '321221';
  27: S:= '312212';
  28: S:= '322112';
  29: S:= '322211';
  30: S:= '212123';
  31: S:= '212321';
  32: S:= '232121';
  33: S:= '111323';
  34: S:= '131123';
  35: S:= '131321';
  36: S:= '112313';
  37: S:= '132113';
  38: S:= '132311';
  39: S:= '211313';
  40: S:= '231113';
  41: S:= '231311';
  42: S:= '112133';
  43: S:= '112331';
  44: S:= '132131';
  45: S:= '113123';
  46: S:= '113321';
  47: S:= '133121';
  48: S:= '313121';
  49: S:= '211331';
  50: S:= '231131';
  51: S:= '213113';
  52: S:= '213311';
  53: S:= '213131';
  54: S:= '311123';
  55: S:= '311321';
  56: S:= '331121';
  57: S:= '312113';
  58: S:= '312311';
  59: S:= '332111';
  60: S:= '314111';
  61: S:= '221411';
  62: S:= '431111';
  63: S:= '111224';
  64: S:= '111422';
  65: S:= '121124';
  66: S:= '121421';
  67: S:= '141122';
  68: S:= '141221';
  69: S:= '112214';
  70: S:= '112412';
  71: S:= '122114';
  72: S:= '122411';
  73: S:= '142112';
  74: S:= '142211';
  75: S:= '241211';
  76: S:= '221114';
  77: S:= '413111';
  78: S:= '241112';
  79: S:= '134111';
  80: S:= '111242';
  81: S:= '121142';
  82: S:= '121241';
  83: S:= '114212';
  84: S:= '124112';
  85: S:= '124211';
  86: S:= '411212';
  87: S:= '421112';
  88: S:= '421211';
  89: S:= '212141';
  90: S:= '214121';
  91: S:= '412121';
  92: S:= '111143';
  93: S:= '111341';
  94: S:= '131141';
  95: S:= '114113';
  96: S:= '114311';
  97: S:= '411113';
  98: S:= '411311';
  99: S:= '113141';
  100: S:= '114131';
  101: S:= '311141';
  102: S:= '411131';
  103: S:= '211412';
  104: S:= '211214';
  105: S:= '211232';
  106: S:= '2331112';
  End;
  Code_128_ID := S
} //Function Code_128_ID(ID :Integer):String;

//===========================================
//Определение набора полос Code 2 of 7 по символу
//===========================================
Function Codabar_Ch(Ch:String):String;
{       Var S:String;
  Case Ch of
  '0': S:= '11111331';
  '1': S:= '11113311';
  '2': S:= '11131131';
  '3': S:= '33111111';
  '4': S:= '11311311';
  '5': S:= '31111311';
  '6': S:= '13111131';
  '7': S:= '13113111';
  '8': S:= '13311111';
  '9': S:= '31131111';
  '-': S:= '11133111';
  '$': S:= '11331111';
  ':': S:= '31113131';
  '/': S:= '31311131';
  '.': S:= '31313111';
  '+': S:= '11313131';
  'a': S:= '11331111';
  'b': S:= '13131131';
  'c': S:= '11131331';
  'd': S:= '11133311';
  't': S:= '11331311';
  'n': S:= '13131131';
  '*': S:= '11131331';
  'e': S:= '11133311';
  Else S:= '' ;
  End ;
  Codabar_Ch := S
} //Function Codabar_Ch(Ch:String;):String;


//===========================================
//Определение набора полос Code 39 по символу
//===========================================
Function Code_39_Ch(Ch:String):String;
{ Var S:String;
  Case Ch of
  '1': S:= '3113111131';
  '2': S:= '1133111131';
  '3': S:= '3133111111';
  '4': S:= '1113311131';
  '5': S:= '3113311111';
  '6': S:= '1133311111';
  '7': S:= '1113113131';
  '8': S:= '3113113111';
  '9': S:= '1133113111';
  '0': S:= '1113313111';
  'A': S:= '3111131131';
  'B': S:= '1131131131';
  'C': S:= '3131131111';
  'D': S:= '1111331131';
  'E': S:= '3111331111';
  'F': S:= '1131331111';
  'G': S:= '1111133131';
  'H': S:= '3111133111';
  'I': S:= '1131133111';
  'J': S:= '1111333111';
  'K': S:= '3111111331';
  'L': S:= '1131111331';
  'M': S:= '3131111311';
  'N': S:= '1111311331';
  'O': S:= '3111311311';
  'P': S:= '1131311311';
  'Q': S:= '1111113331';
  'R': S:= '3111113311';
  'S': S:= '1131113311';
  'T': S:= '1111313311';
  'U': S:= '3311111131';
  'V': S:= '1331111131';
  'W': S:= '3331111111';
  'X': S:= '1311311131';
  'Y': S:= '3311311111';
  'Z': S:= '1331311111';
  '-': S:= '1311113131';
  '.': S:= '3311113111';
  ' ': S:= '1331113111';
  '*': S:= '1311313111';
  '$': S:= '1313131111';
  '/': S:= '1313111311';
  '+': S:= '1311131311';
  '%': S:= '1113131311';
  Else S:= '' ;
  End ;
  Code_39_Ch := S
} //Function Code_39_Ch(Ch:String):String;

//===========================================
//Определение ширины полос Interleaved 2 of 5 для одного символа
//===========================================
Function Code_2of5_Ch(Ch:String):String;
{ Var S:String;
  Case Ch of
  '0': S:= '11331';
  '1': S:= '31113';
  '2': S:= '13113';
  '3': S:= '33111';
  '4': S:= '11313';
  '5': S:= '31311';
  '6': S:= '13311';
  '7': S:= '11133';
  '8': S:= '31131';
  '9': S:= '13131';
  End;
  Code_2of5_Ch := S;
} //Function Code_2of5_Ch(Ch:String):String;

//===========================================
//Определение набора полос Interleaved 2 of 5 по двум символам
//===========================================
Function Interleaved_2of5_Pair(Pair:String):String;
{   Var S1:String;
    Var S2:String;
    Var S:String;
    Var I:Integer;
    S1 := Code_2of5_Ch(SubStr(Pair, 1, 1))
    S2 := Code_2of5_Ch(SubStr(Pair, 2, 1))
    S  := ''
    For(I:=1;I<=Length(S1);I++)
      S := S + SubStr(S1, I, 1) + SubStr(S2, I, 1)
    Interleaved_2of5_Pair := S
} //Function Interleaved_2of5_Pair(Pair:String):String;

//===========================================
//Штриховые символы шрифта iQs Code 128 по набору полос
//===========================================
Function Code_Char(A:String):String;
{ Var S:String;
  Var I : Integer
  Var B:String;
  case A of
  '211412': S:= 'A';
  '211214': S:= 'B';
  '211232': S:= 'C';
  '2331112': S:= '@';
  Else
  { S := ''
    For(I:=0;I<=Length(A) / 2 - 1;I++)
    { Case SubStr(A, 2 * I + 1, 2) of
      '11': S:= S + '0';
      '21': S:= S + '1';
      '31': S:= S + '2';
      '41': S:= S + '3';
      '12': S:= S + '4';
      '22': S:= S + '5';
      '32': S:= S + '6';
      '42': S:= S + '7';
      '13': S:= S + '8';
      '23': S:= S + '9';
      '33': S:= S + ':';
      '43': S:= S + ';';
      '14': S:= S + '<';
      '24': S:= S + '=';
      '34': S:= S + '>';
      '44': S:= S + '?';
      end;
    } //For(I:=0;I<=To Length(A) / 2 - 1;I++)  
  } // ELSE
  End; //  case A of

  Code_Char := S
} //Function Code_Char(A:String):String;

//===========================================
//Строка штрих-кода в кодировке Code 128
//===========================================
Function Code_128(A:String):String;
{ Var BCode: array [0..1023] of Integer
  Var BInd : Integer
  Var CurMode:String;
  Var Ch : Integer
  Var Ch2 : Integer
  Var I : Integer
  Var LenA : Integer
  Var CCode : Integer
  Var S:String;
  Var BarArray : Variant
    
  //Собираем строку кодов
  BInd := 0
  CurMode := ''
  I := 1
  LenA := Length(A)
  While I <= LenA
  { //'Текущий символ в строке
    Ch:= Ord(SubStr(A, I, 1))
    I := I + 1
    //'Разбираем только символы от 0 до 127
    If Ch <= 127 Then
    // 'Следующий символ
    { If I <= LenA Then
        Ch2 := Ord(SubStr(A, I, 1))
      Else
        Ch2 := 0
      //'Пара цифр - режим С
      If (48 <= Ch) And (Ch <= 57) And  (48 <= Ch2) And (Ch2 <= 57) Then
      { I := I + 1
        If BInd = 0 Then
        { //'Начало с режима С
          CurMode := 'C'
          BCode[BInd] := 105
          BInd := BInd + 1
        }  
        Else
        If CurMode <> 'C' Then
        { // 'Переключиться на режим С
          CurMode := 'C'
          BCode[BInd] := 99
          BInd := BInd + 1
        }
       //'Добавить символ режима С
        BCode[BInd] := Integer(Chr(Ch) + Chr(Ch2))
        BInd := BInd + 1
      }  
      Else // If (48 <= Ch) And (Ch <= 57) And  (48 <= Ch2) And (Ch2 <= 57) Then
      {
        If BInd = 0 Then
        { If Ch < 32 Then
          { // 'Начало с режима A
            CurMode := 'A'
            BCode[BInd] := 103
            BInd := BInd + 1
          }  
          Else
          { //'Начало с режима B
            CurMode := 'B'
            BCode[BInd] := 104
            BInd := BInd + 1
          }
        } //If BInd = 0 Then
        //'Переключение по надобности в режим A
        If (Ch < 32) And (CurMode <> 'A') Then
        { CurMode := 'A'
          BCode[BInd] := 101
          BInd := BInd + 1
        }  
        //'Переключение по надобности в режим B
        Else
        If ((64 <= Ch) And (CurMode <> 'B')) Or (CurMode = 'C') Then
        {  CurMode := 'B'
           BCode[BInd] := 100
           BInd := BInd + 1
        }
        //'Служебные символы
        If (Ch < 32) Then
        {  BCode[BInd] := Ch + 64
          BInd := BInd + 1
        }    
        //'Все другие символы
        Else
        { BCode[BInd] := Ch - 32
          BInd := BInd + 1
        }
      } //else If (48 <= Ch) And (Ch <= 57) And     (48 <= Ch2) And (Ch2 <= 57) T
    } //If Ch <= 127 Then
  } //While I <= LenA
  
  
  //'Подсчитываем контрольную сумму
  CCode := BCode[0] Mod 103
  For(I:= 1;I<=BInd - 1;I++)
  { CCode := (CCode + BCode[I] * I) Mod 103
  } //For(I:= 1;I<=BInd - 1;I++)
  BCode[BInd] := CCode
  BInd := BInd + 1
  //  'Завершающий символ
  BCode(BInd) := 106
  BInd := BInd + 1
  /*
  'Собираем строку символов шрифта
  'BarArray = Array('155', '515', '551', '449', '485', '845', '458', '494', '854', _
  '548', '584', '944', '056', '416', '452', '065', '425', '461', '560', '506', _
  '542', '164', '524', '212', '245', '605', '641', '254', '614', '650', '119', _
  '191', '911', '089', '809', '881', '098', '818', '890', '188', '908', '980', _
  '01:', '092', '812', '029', '0:1', '821', '221', '182', '902', '128', '1:0', _
  '122', '209', '281', ':01', '218', '290', ':10', '230', '5<0', ';00', '04=', _
  '0<5', '40=', '4<1', '<05', '<41', '05<', '0=4', '41<', '4=0', '<14', '<50', _
  '=40', '50<', '320', '=04', '830', '047', '407', '443', '074', '434', '470', _
  '344', '704', '740', '113', '131', '311', '00;', '083', '803', '038', '0;0', _
  '308', '380', '023', '032', '203', '302', 'A', 'B', 'C', '@')
  */
  S := ''
  For(I:=0;I<=BInd - 1;I++)
  { S := S + Code_Char(Code_128_ID(BCode[I]))
    //'S = S + BarArray(BCode[I])
  } //For(I:=0;I<=BInd - 1;I++)
  Code_128 := S
} //Function Code_128(A:String):String;

//===========================================
//Строка штрих-кода в кодировке Codabar
//===========================================
Function Codabar(A:String) :string;
{ Var I : Integer
  Var S:String;
  S:= ''
  For(I:= 1;I<=Length(A);I++)
  { S := S + Code_Char(Codabar_Ch(SubStr(A, I, 1)))
  } //For(I:= 1;I<=Length(A);I++)
  //  'Старт/стоп d/e. Возможные варианты a/t b/n c/* d/e
  Codabar := Code_Char(Codabar_Ch('d')) + S + Code_Char(Codabar_Ch('e'))
} //Function Codabar(A:String) :string;

//===========================================
//Строка штрих-кода в кодировке Code 39
//===========================================
Function Code_39(A:String):string;
{ Var I : Integer
  Var S:String;
  S := ''
  For(I:=1;I<=Length(A);I++)
  { S := S + Code_Char(Code_39_Ch(SubStr(A, I, 1)))
  }
  //'Старт/стоп - символ *
  Code_39 := Code_Char(Code_39_Ch('*')) + S + Code_Char(Code_39_Ch('*'))
} //Function Code_39(A:String):string;



//===========================================
//Строка штрих-кода в кодировке Interleaved 2 of 5
//===========================================
Function Interleaved_2of5(A:String; Check : Boolean):string;
{ Var I : Integer
  Var D:String;
  Var S:String;
  Var Ch : Integer
  Var K : Integer
  //  'Преобразование к строке фифр
  D := ''
  For(I := 1;I<=Length(A);I++)
  { Ch := Ord(SubStr(A, I, 1))
    If (48 <= Ch) And (Ch <= 57) Then
    {  D := D + Chr(Ch)
    }
  } //For(I := 1;I<=Length(A);I++)
  //  'Добавить лидирующий 0
  If ((Length(D) Mod 2 > 0) And (Not Check)) Or ((Length(D) Mod 2 = 0) And Check) Then
  { D := '0' + D
  }
  //  'Расчет и добавление контрольного разряда
  If Check Then
  { K := 0
    For(I := 1;I<=Length(D);I++)
    { If I Mod 2 > 0 Then
        K := K + Integer(SubStr(D, I, 1)) * 3
      Else
        K := K + Integer(SubStr(D, I, 1))
    } //For(I := 1;I<=Length(D);I++)
    K := 10 - (K Mod 10)
    D := D + string(K)
  } //If Check Then
  //  'Составление строки кода по парам цифр
  S := ''
  For(I:= 0;I<=Length(D) / 2 - 1;I++)
  { S := S + Code_Char(Interleaved_2of5_Pair(SubStr(D, I * 2 + 1, 2)))
  }
  //  'Добавить старт/стоп символы
  Interleaved_2of5 := Code_Char('1111') + S + Code_Char('3111')
} //Function Interleaved_2of5(A:String; Check : Boolean):string;

end. // Конец фейса