📄 flatcode.pas
字号:
var i, idx , checksum:integer;
begin
checksum := 0;// Startcode
result := BARCode_39[FindIdx('*')].data + '0';
for i:=1 to Length(BarText) do
begin
idx := FindIdx(BarText[i]);
if idx < 0 then
continue;
result := result + BARCode_39[idx].data + '0';
Inc(checksum, BARCode_39[idx].chk);
end;// Calculate Checksum Data
if FCheckSum then
begin
checksum := checksum mod 43;
for i:=0 to High(BARCode_39) do
if checksum = BARCode_39[i].chk then
begin
result := result + BARCode_39[i].data + '0';
break;
end;
end;// Stopcode
result := result + BARCode_39[FindIdx('*')].data;
end;
{Code 128}
function TFlatBarcode.Code_128: string;
function Find_Code128AB(c:char):integer; // find Code 128 Codeset A or B
var i:integer; v:char;
begin
for i:=0 to High(BARCode_128) do
begin
if FCodeType = Code128A then
v := BARCode_128[i].a
else
v := BARCode_128[i].b;
if c = v then
begin
result := i;
exit;
end;
end;
result := -1;
end;
function Find_Code128C(c:String):integer; // find Code 128 Codeset C
var i:integer;
begin
for i:=0 to High(BARCode_128) do
begin
if c = BARCode_128[i].C then
begin
result := i;
exit;
end;
end;
result := -1;
end;
var i, idx , j: integer;
startcode,Tmp: string;
checksum : integer;
codeword_pos : integer;
begin
checksum := 103;
case CodeType of
Code128A,EAN128A: begin checksum := 103; startcode:= StartA; end;
Code128B,EAN128B: begin checksum := 104; startcode:= StartB; end;
Code128C,EAN128C: begin checksum := 105; startcode:= StartC; end;
end;
result := Convert(startcode); // Startcode
codeword_pos := 1;
Tmp := BarText;
case CodeType of
EAN128A,
EAN128B,
EAN128C:
begin
result := result + Convert(BARCode_128[102].data);
inc(checksum, 102*codeword_pos);
Inc(codeword_pos);
if FCheckSum then Tmp:=DoCheckSumming(Tmp);
end;
end;
if (CodeType = Code128C) or (CodeType = EAN128C) then
begin
if ODD(Length(Tmp)) then //check Length(Tmp) for ODD or EVEN;//
Tmp:='0'+Tmp;
for i:=1 to (Length(Tmp) div 2) do
begin
j:=(i-1)*2+1;
idx:=Find_Code128C(copy(Tmp,j,2));
if idx < 0 then
idx := Find_Code128C('00');
result := result + Convert(BARCode_128[idx].data);
Inc(checksum, idx*codeword_pos);
Inc(codeword_pos);
end;
end
else
for i:=1 to Length(Tmp) do
begin
idx := Find_Code128AB(Tmp[i]);
if idx < 0 then
idx := Find_Code128AB(' ');
result := result + Convert(BARCode_128[idx].data);
Inc(checksum, idx*i);
end;
checksum := checksum mod 103;
result := result + Convert(BARCode_128[checksum].data);
result := result + Convert(Stop); {Stopcode}
end;
function TFlatBarcode.Code_93: string;
function Find_Code93(c:char):integer;// find Code 93
var i:integer;
begin
for i:=0 to High(BARCode_93) do
begin
if c = BARCode_93[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end;
var i, idx : integer;
checkC, checkK, // Checksums
weightC, weightK : integer;
begin
result := Convert('111141');
for i:=1 to Length(BarText) do
begin
idx := Find_Code93(BarText[i]);
if idx < 0 then
raise Exception.CreateFmt('%s:Code93 bad Data <%s>', [self.ClassName,BarText]);
result := result + Convert(BARCode_93[idx].data);
end;
checkC := 0;
checkK := 0;
weightC := 1;
weightK := 2;
for i:=Length(BarText) downto 1 do
begin
idx := Find_Code93(BarText[i]);
Inc(checkC, idx*weightC);
Inc(checkK, idx*weightK);
Inc(weightC);
if weightC > 20 then weightC := 1;
Inc(weightK);
if weightK > 15 then weightC := 1;
end;
Inc(checkK, checkC);
checkC := checkC mod 47;
checkK := checkK mod 47;
result := result + Convert(BARCode_93[checkC].data) +
Convert(BARCode_93[checkK].data);
result := result + Convert('1111411'); // Stopcode
end;
function TFlatBarcode.Code_MSI: string;
var i,check_even, check_odd, checksum:integer;
begin
result := '60'; // Startcode
check_even := 0;
check_odd := 0;
for i:=1 to Length(BarText) do
begin
if odd(i-1) then
check_odd := check_odd*10+ord(BarText[i])
else
check_even := check_even+ord(BarText[i]);
result := result + BARCode_MSI[BarText[i]];
end;
checksum := quersumme(check_odd*2) + check_even;
checksum := checksum mod 10;
if checksum > 0 then
checksum := 10-checksum;
result := result + BARCode_MSI[chr(ord('0')+checksum)];
result := result + '515'; // Stopcode
end;
function TFlatBarcode.Code_PostNet: string;
var i:integer;
begin
result := '51';
for i:=1 to Length(BarText) do
begin
result := result + BARCode_PostNet[BarText[i]];
end;
result := result + '5';
end;
function TFlatBarcode.Code_CodaBar: string;
function Find_Codabar(c:char):integer;
var i:integer;
begin
for i:=0 to High(BARCode_Codabar) do
begin
if c = BARCode_Codabar[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end;
var i, idx : integer;
begin
result := BARCode_Codabar[Find_Codabar('A')].data + '0';
for i:=1 to Length(BarText) do
begin
idx := Find_Codabar(BarText[i]);
result := result + BARCode_Codabar[idx].data + '0';
end;
result := result + BARCode_Codabar[Find_Codabar('B')].data;
// result := result + BARCode_Codabar[Find_Codabar('A')].data;
end;
function TFlatBarcode.Code_EAN13: string;
var I, LK: integer;
tmp : String;
begin
LK := StrToInt(BarText[1]);
tmp := copy(BarText,2,12);
result := '505';{Startcode}
for i:=1 to 6 do
begin
case BARCode_ParityEAN13[LK,i] of
'A' : result := result + BARCode_EAN_A[tmp[i]];
'B' : result := result + BARCode_EAN_B[tmp[i]] ;
'C' : result := result + BARCode_EAN_C[tmp[i]] ;
end;
end;
result := result + '05050';{Center Guard Pattern}
for i:=7 to 12 do
result := result + BARCode_EAN_C[tmp[i]] ;
result := result + '505';{Stopcode}
end;
function TFlatBarcode.Code_EAN8: string;
var i : integer;
begin
result := '505';{Startcode}
for i:=1 to 4 do
result := result + BARCode_EAN_A[BarText[i]] ;
result := result + '05050';{Center Guard Pattern}
for i:=5 to 8 do
result := result + BARCode_EAN_C[BarText[i]] ;
result := result + '505';{Stopcode}
end;
function TFlatBarcode.Code_Supp2: string;
var i,j : integer;
mS : String;
begin
i:=StrToInt(Copy(BarText,1,2));
case i mod 4 of
3: mS:='EE';
2: mS:='EO';
1: mS:='OE';
0: mS:='OO';
end;
result := '506';{Startcode}
for i:=1 to 2 do
begin
if mS[i]='E' then
begin
for j:= 1 to 4 do
result := result + BARCode_EAN_C[BarText[i],5-j];
end
else
begin
result := result + BARCode_EAN_A[BarText[i]];
end;
if i<2 then
result:=result+'05'; // character delineator
end;
end;
function TFlatBarcode.Code_Supp5: string;
var i,j : integer;
c : char;
begin
c:=BarText[6];
result := '506';{Startcode}
for i:=1 to 5 do
begin
if BARCode_UPC_E[c,(6-5)+i]='E' then
begin
for j:= 1 to 4 do result := result + BARCode_EAN_C[BarText[i],5-j];
end
else
begin
result := result + BARCode_EAN_A[BarText[i]];
end;
if i<5 then result:=result+'05'; // character delineator
end;
end;
function TFlatBarcode.Code_UPC_A: string;
var i : integer;
begin
result := '505';{Startcode}
for i:=1 to 6 do
result := result + BARCode_EAN_A[BarText[i]];
result := result + '05050';{Trennzeichen}
for i:=7 to 12 do
result := result + BARCode_EAN_C[BarText[i]];
result := result + '505';{Stopcode}
end;
function TFlatBarcode.Code_UPC_EODD: string;
var i,j : integer;
c : char;
begin
c:=BarText[7];
result := '505';{Startcode}
for i:=1 to 6 do
begin
if BARCode_UPC_E[c,i]='E' then
begin
for j:= 1 to 4 do
result := result + BARCode_EAN_C[BarText[i],5-j];
end
else
begin
result := result + BARCode_EAN_A[BarText[i]];
end;
end;
result := result + '0505';{Stopcode}
end;
function TFlatBarcode.Code_UPC_EVEN: string;
var i,j : integer;
c : char;
begin
c:=BarText[7];
result := '505';{Startcode}
for i:=1 to 6 do
begin
if BARCode_UPC_E[c,i]='E' then
begin
result := result + BARCode_EAN_A[BarText[i]];
end
else
begin
for j:= 1 to 4 do
result := result + BARCode_EAN_C[BarText[i],5-j];
end;
end;
result := result + '0505';{Stopcode}
end;
procedure TFlatBarcode.GetABCED(Var a,b,c,d,orgin:TPoint;xadd,Width,Height:Integer);
begin
a.x := xadd;
a.y := Orgin.y;//0
b.x := xadd;
b.y := Orgin.y+height;
c.x := xadd+width-1;
c.y := Orgin.y+height;
d.x := xadd+width-1;
d.y := Orgin.y;//0
end;
function TFlatBarcode.MakeData;
begin
case CodeType of
Code25IL : result := Code_25ILeaved;
Code25IT : result := Code_25ITrial;
Code25Mx : result := Code_25Matrix;
Code39,
Code39Ext : result := Code_39;
Code93,
Code93Ext : result := Code_93;
CodeMSI : result := Code_MSI;
PostNet : result := Code_PostNet;
CodaBar : result := Code_CodaBar;
EAN8 : Result := Code_EAN8;
EAN13 : Result := Code_EAN13;
UPC_A : Result := Code_UPC_A;
UPC_EODD : Result := Code_UPC_EODD;
UPC_EVEN : Result := Code_UPC_EVEN;
UPC_S2 : Result := Code_Supp2;
UPC_S5 : Result := Code_Supp5;
else
result := Code_128; //for Code128A,Code128B,Code128C;EAN128A,EAN128B,EAN128C
end;
end;
function TFlatBarcode.MakeModules:TFlatModules;
begin
case CodeType of
Code25IL, Code25IT, Code39,
Code39Ext, Codabar, EAN8, EAN13,
UPC_A, UPC_EODD, UPC_EVEN, UPC_S2,
UPC_S5:begin
if fRatio <> 2.0 then
fRatio := 2.0;
end;
Code25Mx :begin
if fRatio < 2.25 then
fRatio := 2.25;
if fRatio > 3.0 then
fRatio := 3.0;
end;
Code128A, Code128B, Code128C,
EAN128A, EAN128B, EAN128C,
Code93,Code93Ext, CodeMSI,
PostNet:;
end;
Result[0] := fModul;
Result[1] := Round(fModul*fRatio);
Result[2] := Result[1] * 3 div 2;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -