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;