📄 flatcode.pas
字号:
(a:'5'; b:'5'; c:'21'; data:'213212'; ),
(a:'6'; b:'6'; c:'22'; data:'223112'; ),
(a:'7'; b:'7'; c:'23'; data:'312131'; ),
(a:'8'; b:'8'; c:'24'; data:'311222'; ),
(a:'9'; b:'9'; c:'25'; data:'321122'; ),
(a:':'; b:':'; c:'26'; data:'321221'; ),
(a:';'; b:';'; c:'27'; data:'312212'; ),
(a:'<'; b:'<'; c:'28'; data:'322112'; ),
(a:'='; b:'='; c:'29'; data:'322211'; ),
(a:'>'; b:'>'; c:'30'; data:'212123'; ),
(a:'?'; b:'?'; c:'31'; data:'212321'; ),
(a:'@'; b:'@'; c:'32'; data:'232121'; ),
(a:'A'; b:'A'; c:'33'; data:'111323'; ),
(a:'B'; b:'B'; c:'34'; data:'131123'; ),
(a:'C'; b:'C'; c:'35'; data:'131321'; ),
(a:'D'; b:'D'; c:'36'; data:'112313'; ),
(a:'E'; b:'E'; c:'37'; data:'132113'; ),
(a:'F'; b:'F'; c:'38'; data:'132311'; ),
(a:'G'; b:'G'; c:'39'; data:'211313'; ),
(a:'H'; b:'H'; c:'40'; data:'231113'; ),
(a:'I'; b:'I'; c:'41'; data:'231311'; ),
(a:'J'; b:'J'; c:'42'; data:'112133'; ),
(a:'K'; b:'K'; c:'43'; data:'112331'; ),
(a:'L'; b:'L'; c:'44'; data:'132131'; ),
(a:'M'; b:'M'; c:'45'; data:'113123'; ),
(a:'N'; b:'N'; c:'46'; data:'113321'; ),
(a:'O'; b:'O'; c:'47'; data:'133121'; ),
(a:'P'; b:'P'; c:'48'; data:'313121'; ),
(a:'Q'; b:'Q'; c:'49'; data:'211331'; ),
(a:'R'; b:'R'; c:'50'; data:'231131'; ),
(a:'S'; b:'S'; c:'51'; data:'213113'; ),
(a:'T'; b:'T'; c:'52'; data:'213311'; ),
(a:'U'; b:'U'; c:'53'; data:'213131'; ),
(a:'V'; b:'V'; c:'54'; data:'311123'; ),
(a:'W'; b:'W'; c:'55'; data:'311321'; ),
(a:'X'; b:'X'; c:'56'; data:'331121'; ),
(a:'Y'; b:'Y'; c:'57'; data:'312113'; ),
(a:'Z'; b:'Z'; c:'58'; data:'312311'; ),
(a:'['; b:'['; c:'59'; data:'332111'; ),
(a:'\'; b:'\'; c:'60'; data:'314111'; ),
(a:']'; b:']'; c:'61'; data:'221411'; ),
(a:'^'; b:'^'; c:'62'; data:'431111'; ),
(a:'_'; b:'_'; c:'63'; data:'111224'; ),
(a:' '; b:'`'; c:'64'; data:'111422'; ),
(a:' '; b:'a'; c:'65'; data:'121124'; ),
(a:' '; b:'b'; c:'66'; data:'121421'; ),
(a:' '; b:'c'; c:'67'; data:'141122'; ),
(a:' '; b:'d'; c:'68'; data:'141221'; ),
(a:' '; b:'e'; c:'69'; data:'112214'; ),
(a:' '; b:'f'; c:'70'; data:'112412'; ),
(a:' '; b:'g'; c:'71'; data:'122114'; ),
(a:' '; b:'h'; c:'72'; data:'122411'; ),
(a:' '; b:'i'; c:'73'; data:'142112'; ),
(a:' '; b:'j'; c:'74'; data:'142211'; ),
(a:' '; b:'k'; c:'75'; data:'241211'; ),
(a:' '; b:'l'; c:'76'; data:'221114'; ),
(a:' '; b:'m'; c:'77'; data:'413111'; ),
(a:' '; b:'n'; c:'78'; data:'241112'; ),
(a:' '; b:'o'; c:'79'; data:'134111'; ),
(a:' '; b:'p'; c:'80'; data:'111242'; ),
(a:' '; b:'q'; c:'81'; data:'121142'; ),
(a:' '; b:'r'; c:'82'; data:'121241'; ),
(a:' '; b:'s'; c:'83'; data:'114212'; ),
(a:' '; b:'t'; c:'84'; data:'124112'; ),
(a:' '; b:'u'; c:'85'; data:'124211'; ),
(a:' '; b:'v'; c:'86'; data:'411212'; ),
(a:' '; b:'w'; c:'87'; data:'421112'; ),
(a:' '; b:'x'; c:'88'; data:'421211'; ),
(a:' '; b:'y'; c:'89'; data:'212141'; ),
(a:' '; b:'z'; c:'90'; data:'214121'; ),
(a:' '; b:'{'; c:'91'; data:'412121'; ),
(a:' '; b:'|'; c:'92'; data:'111143'; ),
(a:' '; b:'}'; c:'93'; data:'111341'; ),
(a:' '; b:'~'; c:'94'; data:'131141'; ),
(a:' '; b:' '; c:'95'; data:'114113'; ),
(a:' '; b:' '; c:'96'; data:'114311'; ),
(a:' '; b:' '; c:'97'; data:'411113'; ),
(a:' '; b:' '; c:'98'; data:'411311'; ),
(a:' '; b:' '; c:'99'; data:'113141'; ),
(a:' '; b:' '; c:' '; data:'114131'; ),
(a:' '; b:' '; c:' '; data:'311141'; ),
(a:' '; b:' '; c:' '; data:'411131'; ));
BCData:array[Code25IL..UPC_S5] of TBCData =
((Name:'Code InterLeaved 2.5'; num:True),
(Name:'Code Industrial 2.5'; num:True),
(Name:'Code Matrix 2.5'; num:True),
(Name:'Code 39'; num:False),
(Name:'Code 39 Extended'; num:False),
(Name:'Code 128A'; num:False),
(Name:'Code 128B'; num:False),
(Name:'Code 128C'; num:True),
(Name:'Code 93'; num:False),
(Name:'Code 93 Extended'; num:False),
(Name:'Code MSI'; num:True),
(Name:'Code PostNet'; num:True),
(Name:'Codabar'; num:False),
(Name:'EAN-8'; num:True),
(Name:'EAN-13'; num:True),
(Name:'EAN-128A'; num:False),
(Name:'EAN-128B'; num:False),
(Name:'EAN-128C'; num:True),
(Name:'UPC-A'; num:True),
(Name:'UPC-EODD'; num:True),
(Name:'UPC-EVEN'; num:True),
(Name:'UPC-Supp2'; num:True),
(Name:'UPC-Supp5'; num:True));
{assist function}
function getSupp(Nr : String) : String;
var i,fak,sum : Integer;
tmp : String;
begin
sum := 0;
tmp := copy(nr,1,Length(Nr)-1);
fak := Length(tmp);
for i:=1 to length(tmp) do
begin
if (fak mod 2) = 0 then
sum := sum + (StrToInt(tmp[i])*9)
else
sum := sum + (StrToInt(tmp[i])*3);
dec(fak);
end;
sum:=((sum mod 10) mod 10) mod 10;
result := tmp+IntToStr(sum);
end;
{$ifndef WIN32}
function Trim(const S: string): string; export;
{ Removes leading and trailing whitespace from s}
var
I, L: Integer;
begin
L := Length(S);
I := 1;
while (I <= L) and (S[I] <= ' ') do Inc(I);
if I > L then Result := '' else
begin
while S[L] <= ' ' do Dec(L);
Result := Copy(S, I, L - I + 1);
end;
end;
{$endif}
function Convert(s:string): string;
var i, v : integer;
t : string;
begin
t := '';
for i:=1 to Length(s) do
begin
v := ord(s[i]) - 1;
if odd(i) then
Inc(v, 5);
t := t + Chr(v);
end;
Convert := t;
end;
function Quersumme(x:integer):integer;
var sum:integer;
begin
sum := 0;
while x > 0 do
begin
sum := sum + (x mod 10);
x := x div 10;
end;
result := sum;
end;
constructor TFlatBarcode.Create(Owner:TComponent);
begin
fBitmap := TBitmap.Create;
inherited Create(owner);
Font.OnChange := FontChange;
Height := 50;
Width := 100;
fBarColor := clBlack;
fColor := clWhite;
fRotateType := raNone;
fAutoSize := true;
fRatio := 2.0;
fModul := 1;
fCodeType := EAN13;
fBarHeight := 35;
fBorderWidth := 5;
fBarTop := 5;
fCheckSum := FALSE;
fShowText := True;
fTransparent := false;
fCheckOdd := true;
fText := '0123456789';
end;
destructor TFlatBarcode.destroy;
begin
fBitmap.Free;
inherited Destroy;
end;
function TFlatBarcode.SetLen(pI: byte): string;
begin
Result := fText;
while Length(Result) < pI do
Result:=Result+'0';
end;
function TFlatBarcode.DoCheckSumming(const Data: string;OddCheck:Boolean=True): string;
var i,sum,s : Integer;
begin
sum := 0;
for i:=1 to Length(data) do
begin
s := StrToInt(Data[i]);
if OddCheck then
begin
if odd(i) then
sum := sum + s
else
sum := sum + s*3;
end
else
begin
if odd(i) then
sum := sum + s*3
else
sum := sum + s;
end;
end;
if (sum mod 10) = 0 then
result := data+'0'
else
result := data+IntToStr(10-(sum mod 10));
end;
function TFlatBarcode.GetCheckLen(CodeType:TFlatColeType;Data:String): string;
begin
result := Data;
case CodeType of
EAN13:Begin
if Length(Result)>12 then
result := Copy(Result,1,12)
else
result := SetLen(12);
result := DoCheckSumming(Result,fCheckOdd);
end;
EAN8:begin
if Length(Result)>7 then
result := Copy(Result,1,7)
else
result := SetLen(7);
result := DoCheckSumming(result,fCheckOdd);
end;
UPC_A:begin
if Length(Result)>11 then
result := Copy(Result,1,11)
else
result := SetLen(11);
result := DoCheckSumming(result,fCheckOdd);
end;
UPC_EODD,UPC_EVEN:
begin
if Length(Result)>6 then
result := Copy(Result,1,6)
else
result := SetLen(6);
result := DoCheckSumming(result,fCheckOdd);
end;
UPC_S2:
begin
if Length(Result)>2 then
result := Copy(Result,1,2)
else
result := SetLen(2);
result := getSupp(copy(Result,1,2)+'0');
end;
UPC_S5:
begin
if Length(Result)>5 then
result := Copy(Result,1,5)
else
result := SetLen(5);
result := getSupp(copy(Result,1,5)+'0');
end;
end;
end;
function TFlatBarcode.ClearNotText(Value:String): string;
var inx:Integer;TempValue: string;
begin
result := '';
case CodeType of
Code25IL, Code25IT, Code25Mx,
CodeMSI, PostNet, EAN13, EAN8,
UPC_A, UPC_EODD, UPC_EVEN, UPC_S2,
Code128C,EAN128A,EAN128B,EAN128C,
UPC_S5: begin
TempValue := UpperCase(Value);
for inx:=1 to Length(TempValue) do
if TempValue[Inx] in ['0'..'9'] then
result := result + TempValue[Inx];
result := GetCheckLen(CodeType,result);
end;
Codabar:begin
TempValue := UpperCase(Value);
for inx:=1 to Length(TempValue) do
if TempValue[Inx] in ['0'..'9','A'..'B','-','$',':','/','.','+'] then
Result := result + TempValue[Inx];
end;
Code39, Code93:
Begin
result := UpperCase(Value);
end;
Code93Ext:
Begin
for inx:=0 to Length(Value) do
begin
if ord(Value[inx]) <= 127 then
result := result + BARCode_93x[ord(Value[inx])];
end;
end;
Code39Ext:
begin
for inx:=0 to Length(Value) do
begin
if ord(value[inx]) <= 127 then
result := result + BARCode_39x[ord(value[inx])];
end;
end;
else
result := Value;
end;
end;
function TFlatBarcode.MakeBarText: String;
begin
result := ClearNotText(fText);
end;
function TFlatBarcode.Code_25ILeaved: string;
var i, j: integer;
c : char;
begin
result := result + '5050'; // Startcode
for i:=1 to Length(BarText) div 2 do
begin
for j:= 1 to 5 do
begin
if BARCode_25[BarText[i*2-1], j] = '1' then
c := '6'
else
c := '5';
result := result + c;
if BARCode_25[BarText[i*2], j] = '1' then
c := '1'
else
c := '0';
result := result + c;
end;
end;
result := result + '605'; // Stopcode
end;
function TFlatBarcode.Code_25ITrial: string;
var i, j: integer;
begin
result := result + '606050'; // Startcode
for i:=1 to Length(BarText) do
begin
for j:= 1 to 5 do
begin
if BARCode_25[BarText[i], j] = '1' then
result := result + '60'
else
result := result + '50';
end;
end;
result := result + '605060'; // Stopcode
end;
function TFlatBarcode.Code_25Matrix: string;
var i, j: integer;c :char;
begin
result := result + '705050'; // Startcode
for i:=1 to Length(BarText) do
begin
for j:= 1 to 5 do
begin
if BARCode_25[BarText[i], j] = '1' then
c := '1'
else
c := '0';
if odd(j) then
c := chr(ord(c)+5);
result := result + c;
end;
result := result + '0'; // L點ke zwischen den Zeichen
end;
result := result + '70505'; // Stopcode
end;
function TFlatBarcode.Code_39: string;
function FindIdx(z:char):integer;
var i:integer;
begin
for i:=0 to High(BARCode_39) do
begin
if z = BARCode_39[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -