2. В форме использовать объект и по примеру функции из файла ниже.
Shtrix_Func.Frn
Код: Выделить всё
.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. // Конец фейса