delphi6中有什么控件可以实现条形码的形成呀？(50分)

delphi6中有什么控件可以实现条形码的形成呀？
或是谁有类似的程序吗？可否给一个我呀？

在www.vclxx.org上面就有很多，找找看吧。。

条形码控件

我們用Duck Barcode

unit CBarCode;

interface

uses Classes, SysUtils, Types, Graphics;

function CheckSumModulo10(const Data: string): string;

type
TBarCodeType = (
bcCode_2_5_Interleaved,
bcCode_2_5_Industrial,
bcCode_2_5_Matrix,
bcCode39,
bcCode39Extended,
bcCode128A,
bcCode128B,
bcCode128C,
bcCode93,
bcCode93Extended,
bcCodeMSI,
bcCodePostNet,
bcCodeCodabar,
bcCodeEAN8,
bcCodeEAN13,
bcCodeUPC_A,
bcCodeUPC_E0,
bcCodeUPC_E1,
bcCodeUPC_Supp2, { UPC 2 digit supplemental }
bcCodeUPC_Supp5, { UPC 5 digit supplemental }
bcCodeEAN128A,
bcCodeEAN128B,
bcCodeEAN128C);

TBarLineType = (white, black, black_half); {for internal use only}
{ black_half means a black line with 2/5 height (used for PostNet) }

TCBarCode = class(TComponent)
private
FBarHeight: Integer;
FText: string;
FBarTop: Integer;
FBarLeft: Integer;
FModulo: Integer;
FRatio: Double;
FBarCodeType: TBarCodeType;
FCheckSum: Boolean;
FAngle: Double;
FColor: TColor;
FLineColor: TColor;
FShowNum: Boolean;
FNumFont: TFont;

Modules: array[0..3] of ShortInt;

procedure OneBarProps(Code: Char; var Width: Integer;
var LT: TBarLineType);
procedure DoLines(Data: string; Canvas: TCanvas);
function SetLen(L: Byte): string;

function Code_2_5_Interleaved: string;
function Code_2_5_Industrial: string;
function Code_2_5_Matrix: string;
function Code_39: string;
function Code_39Extended: string;
function Code_128: string;
function Code_93: string;
function Code_93Extended: string;
function Code_MSI: string;
function Code_PostNet: string;
function Code_Codabar: string;
function Code_EAN8: string;
function Code_EAN13: string;
function Code_UPC_A: string;
function Code_UPC_E0: string;
function Code_UPC_E1: string;
function Code_Supp5: string;
function Code_Supp2: string;

procedure MakeModules;

procedure SetModulo(V: Integer);


function DoCheckSumming(const Data: string): string;

procedure SetNumFont(const Value: TFont);
protected
function MakeData: string;

public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;

function GetWidth(C: TCanvas): Integer;
function GetHeight(C: TCanvas): Integer;
procedure DrawBarCode(Canvas: TCanvas);
published
property BarHeight: Integer read FBarHeight write FBarHeight;
property Text: string read FText write FText;
property BarTop: Integer read FBarTop write FBarTop;
property BarLeft: Integer read FBarLeft write FBarLeft;

property Modulo: Integer read FModulo write SetModulo;
property Ratio: Double read FRatio write FRatio;
property BarCodeType: TBarCodeType read FBarCodeType write FBarCodeType
default bcCodeEAN13;

property CheckSum: Boolean read FCheckSum write FCheckSum default False;

property Angle: Double read FAngle write FAngle;

property ShowNum: Boolean read FShowNum write FShowNum default True;
property NumFont: TFont read FNumFont write SetNumFont;
property Color: TColor read FColor write FColor default clWhite;
property LineColor: TColor read FLineColor write FLineColor default clBlack;
end;

implementation

function CheckSumModulo10(const Data: string): string;
var i, Fak, Sum : Integer;
begin
Sum := 0;
Fak := Length(Data);
for i := 1 to Length(data) do
begin
if (Fak mod 2) = 0 then
Sum := Sum + (StrToInt(Data) * 1)
else
Sum := Sum + (StrToInt(Data) * 3);
Dec(Fak);
end;
if (Sum mod 10) = 0 then
Result := Data + '0'
else
Result := Data + IntToStr(10 - (Sum mod 10));
end;

type
TBCdata = record
Name: string; { Name of Barcode }
num: Boolean; { numeric data only }
end;

const BCdata: array[bcCode_2_5_Interleaved..bcCodeEAN128C] of TBCdata = (
(Name: '2_5_Interleaved'; num: True),
(Name: '2_5_Industrial'; num: True),
(Name: '2_5_Matrix'; num: True),
(Name: 'Code39'; num: False),
(Name: 'Code39 Extended'; num: False),
(Name: 'Code128A'; num: False),
(Name: 'Code128B'; num: False),
(Name: 'Code128C'; num: True),
(Name: 'Code93'; num: False),
(Name: 'Code93 Extended'; num: False),
(Name: 'MSI'; num: True),
(Name: 'PostNet'; num: True),
(Name: 'Codebar'; num: False),
(Name: 'EAN8'; num: True),
(Name: 'EAN13'; num: True),
(Name: 'UPC_A'; num: True),
(Name: 'UPC_E0'; num: True),
(Name: 'UPC_E1'; num: True),
(Name: 'UPC Supp2'; num: True),
(Name: 'UPC Supp5'; num: True),
(Name: 'EAN128A'; num: False),
(Name: 'EAN128B'; num: False),
(Name: 'EAN128C'; num: True)
);

{
converts a string from '321' to the internal representation '715'
i need this function because some pattern tables have a different
format: '00111' converts to '05161'
}
function Convert(S: string): string;
var
i, v: integer;
t: string;
begin
t := '';
for i := 1 to Length(s) do
begin
v := Ord(s) - 1;

if Odd(i) then Inc(v, 5);
t := t + Chr(v);
end;
Convert := t;
end;

(*
* Berechne die Quersumme aus einer Zahl x
* z.B.: Quersumme von 1234 ist 10
*)
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;

{
Rotate a Point by Angle 'alpha'
}
function Rotate2D(p: TPoint; alpha: Double): TPoint;
var
sinus, cosinus: Extended;
begin
sinus := sin(alpha);
cosinus := cos(alpha);
Result.x := Round(p.x * cosinus + p.y * sinus);
Result.y := Round(-p.x * sinus + p.y * cosinus);
end;

{
Move Point "a" by Vector "b"
}
function Translate2D(a, b: TPoint): TPoint;
begin
Result.x := a.x + b.x;
Result.y := a.y + b.y;
end;

{ TCBarCode }

function TCBarCode.Code_128: string;
type
TCode128 = record
a, b: char;
c: string[2];
data: string[6];
end;

const Table_128: array[0..102] of TCode128 = (
( a: ' '; b: ' '; c: '00'; data: '212222'),
( a: '!'; b: '!'; c: '01'; data: '222122'),
( a: '"'; b: '"'; c: '02'; data: '222221'),
( a: '#'; b: '#'; c: '03'; data: '121223'),
( a: '$'; b: '$'; c: '04'; data: '121322'),
( a: '%'; b: '%'; c: '05'; data: '131222'),
( a: '&'; b: '&'; c: '06'; data: '122213'),
( a: ''''; b: ''''; c: '07'; data: '122312'),
( a: '('; b: '('; c: '08'; data: '132212'),
( a: ')'; b: ')'; c: '09'; data: '221213'),
( a: '*'; b: '*'; c: '10'; data: '221312'),
( a: '+'; b: '+'; c: '11'; data: '231212'),
( a: '?; b: '?; c: '12'; data: '112232'),
( a: '-'; b: '-'; c: '13'; data: '122132'),
( a: '.'; b: '.'; c: '14'; data: '122231'),
( a: '/'; b: '/'; c: '15'; data: '113222'),
( a: '0'; b: '0'; c: '16'; data: '123122'),
( a: '1'; b: '1'; c: '17'; data: '123221'),
( a: '2'; b: '2'; c: '18'; data: '223211'),
( a: '3'; b: '3'; c: '19'; data: '221132'),
( a: '4'; b: '4'; c: '20'; data: '221231'),
( 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') { FNC1 }
);

StartA = '211412';
StartB = '211214';
StartC = '211232';
Stop = '2331112';

{find Code 128 Codeset A or B}
function Find_Code128AB(c: Char): Integer;
var
i: Integer;
v: Char;
begin
for i := 0 to High(Table_128) do
begin
if FBarCodeType = bcCode128A then
v := Table_128.a
else
v := Table_128.b;

if c = v then
begin
Result := i;
Exit;
end;
end;
Result := -1;
end;

{ find Code 128 Codeset C }
function Find_Code128C(c: string):integer;
var i: Integer;
begin
for i := 0 to High(Table_128) do begin
if Table_128.c = c then
begin
Result := i;
Exit;
end;
end;
Result := -1;
end;

var
i, j, idx: Integer;
startcode: string;
checksum: Integer;
codeword_pos: Integer;
begin
checksum := 0;
case FBarCodeType of
bcCode128A, bcCodeEAN128A:
begin checksum := 103; startcode:= StartA; end;
bcCode128B, bcCodeEAN128B:
begin checksum := 104; startcode:= StartB; end;
bcCode128C, bcCodeEAN128C:
begin checksum := 105; startcode:= StartC; end;
end;

Result := Convert(startcode); {Startcode}

codeword_pos := 1;

case FBarCodeType of
bcCodeEAN128A, bcCodeEAN128B, bcCodeEAN128C:
begin
{special identifier
FNC1 = function code 1
for EAN 128 barcodes
}
Result := Result + Convert(Table_128[102].data);
Inc(checksum, 102 * codeword_pos);
Inc(codeword_pos);
{
if there is no checksum at the end of the string
the EAN128 needs one (modulo 10)
}
if FCheckSum then FText := DoCheckSumming(FText);
end;
end;

if (FBarCodeType = bcCode128C) or (FBarCodeType = bcCodeEAN128C) then
begin
if (Length(FText) mod 2 <> 0) then FText := '0' + FText;
for i := 1 to (Length(FText) div 2) do
begin
j := (i - 1) * 2 + 1;
idx := Find_Code128C(Copy(FText, j, 2));
if idx < 0 then idx := Find_Code128C('00');
Result := Result + Convert(Table_128[idx].data);
Inc(checksum, idx * codeword_pos);
Inc(codeword_pos);
end;
end
else
for i := 1 to Length(FText) do
begin
idx := Find_Code128AB(FText);
if idx < 0 then idx := Find_Code128AB(' ');
Result := Result + Convert(Table_128[idx].data);
Inc(checksum, idx * codeword_pos);
Inc(codeword_pos);
end;

checksum := checksum mod 103;
Result := Result + Convert(Table_128[checksum].data);

Result := Result + Convert(Stop); {Stopcode}
end;

const Table_2_5: array['0'..'9', 1..5] of char = (
('0', '0', '1', '1', '0'), {'0'}
('1', '0', '0', '0', '1'), {'1'}
('0', '1', '0', '0', '1'), {'2'}
('1', '1', '0', '0', '0'), {'3'}
('0', '0', '1', '0', '1'), {'4'}
('1', '0', '1', '0', '0'), {'5'}
('0', '1', '1', '0', '0'), {'6'}
('0', '0', '0', '1', '1'), {'7'}
('1', '0', '0', '1', '0'), {'8'}
('0', '1', '0', '1', '0') {'9'}
);

function TCBarCode.Code_2_5_Industrial: string;
var
i, j: integer;
begin
Result := '606050'; {Startcode}

for i := 1 to Length(FText) do
begin
for j := 1 to 5 do
begin
if Table_2_5[FText, j] = '1' then
Result := Result + '60'
else
Result := Result + '50';
end;
end;

Result := Result + '605060'; {Stopcode}
end;

function TCBarCode.Code_2_5_Interleaved: string;
var
i, j: integer;
c: char;
begin
Result := '5050'; {Startcode}

for i := 1 to Length(FText) div 2 do
begin
for j := 1 to 5 do
begin
if Table_2_5[FText[i * 2 - 1], j] = '1' then
c := '6'
else
c := '5';
Result := Result + c;
if Table_2_5[FText[i * 2], j] = '1' then
c := '1'
else
c := '0';
Result := Result + c;
end;
end;

Result := Result + '605'; {Stopcode}
end;

function TCBarCode.Code_2_5_Matrix: string;
var
i, j: integer;
c: char;
begin
Result := '705050'; {Startcode}

for i := 1 to Length(FText) do
begin
for j := 1 to 5 do
begin
if Table_2_5[FText, j] = '1' then
c := '1'
else
c := '0';

if Odd(j) then
c := Chr(Ord(c)+5);
Result := Result + c;
end;
Result := Result + '0';
end;

Result := Result + '70505'; {Stopcode}
end;

function TCBarCode.Code_39: string;
type
TCode39 = record
c: Char;
data: array[0..9] of Char;
chk: ShortInt;
end;

const Table_39: array[0..43] of TCode39 = (
( c: '0'; data: '505160605'; chk: 0 ),
( c: '1'; data: '605150506'; chk: 1 ),
( c: '2'; data: '506150506'; chk: 2 ),
( c: '3'; data: '606150505'; chk: 3 ),
( c: '4'; data: '505160506'; chk: 4 ),
( c: '5'; data: '605160505'; chk: 5 ),
( c: '6'; data: '506160505'; chk: 6 ),
( c: '7'; data: '505150606'; chk: 7 ),
( c: '8'; data: '605150605'; chk: 8 ),
( c: '9'; data: '506150605'; chk: 9 ),
( c: 'A'; data: '605051506'; chk: 10),
( c: 'B'; data: '506051506'; chk: 11),
( c: 'C'; data: '606051505'; chk: 12),
( c: 'D'; data: '505061506'; chk: 13),
( c: 'E'; data: '605061505'; chk: 14),
( c: 'F'; data: '506061505'; chk: 15),
( c: 'G'; data: '505051606'; chk: 16),
( c: 'H'; data: '605051605'; chk: 17),
( c: 'I'; data: '506051605'; chk: 18),
( c: 'J'; data: '505061605'; chk: 19),
( c: 'K'; data: '605050516'; chk: 20),
( c: 'L'; data: '506050516'; chk: 21),
( c: 'M'; data: '606050515'; chk: 22),
( c: 'N'; data: '505060516'; chk: 23),
( c: 'O'; data: '605060515'; chk: 24),
( c: 'P'; data: '506060515'; chk: 25),
( c: 'Q'; data: '505050616'; chk: 26),
( c: 'R'; data: '605050615'; chk: 27),
( c: 'S'; data: '506050615'; chk: 28),
( c: 'T'; data: '505060615'; chk: 29),
( c: 'U'; data: '615050506'; chk: 30),
( c: 'V'; data: '516050506'; chk: 31),
( c: 'W'; data: '616050505'; chk: 32),
( c: 'X'; data: '515060506'; chk: 33),
( c: 'Y'; data: '615060505'; chk: 34),
( c: 'Z'; data: '516060505'; chk: 35),
( c: '-'; data: '515050606'; chk: 36),
( c: '.'; data: '615050605'; chk: 37),
( c: ' '; data: '516050605'; chk: 38),
( c: '*'; data: '515060605'; chk: 0 ),
( c: '$'; data: '515151505'; chk: 39),
( c: '/'; data: '515150515'; chk: 40),
( c: '+'; data: '515051515'; chk: 41),
( c: '%'; data: '505151515'; chk: 42)
);


function FindIdx(z: Char): Integer;
var
i: Integer;
begin
for i := 0 to High(Table_39) do
begin
if z = Table_39.c then
begin
Result := i;
Exit;
end;
end;
Result := -1;
end;

var
i, idx: Integer;
checksum: Integer;
begin
checksum := 0;
{Startcode}
Result := Table_39[FindIdx('*')].data + '0';

for i := 1 to Length(FText) do
begin
idx := FindIdx(FText);
if idx < 0 then Continue;
Result := Result + Table_39[idx].data + '0';
Inc(checksum, Table_39[idx].chk);
end;

{Calculate Checksum Data}
if FCheckSum then
begin
checksum := checksum mod 43;
for i:=0 to High(Table_39) do
if checksum = Table_39.chk then
begin
Result := Result + Table_39.data + '0';
Break;
end;
end;

{Stopcode}
Result := Result + Table_39[FindIdx('*')].data;
end;

function TCBarCode.Code_39Extended: string;
const Code39x : array[0..127] of string[2] = (
('%U'), ('$A'), ('$B'), ('$C'), ('$D'), ('$E'), ('$F'), ('$G'),
('$H'), ('$I'), ('$J'), ('$K'), ('$L'), ('$M'), ('$N'), ('$O'),
('$P'), ('$Q'), ('$R'), ('$S'), ('$T'), ('$U'), ('$V'), ('$W'),
('$X'), ('$Y'), ('$Z'), ('%A'), ('%B'), ('%C'), ('%D'), ('%E'),
(' '), ('/A'), ('/B'), ('/C'), ('/D'), ('/E'), ('/F'), ('/G'),
('/H'), ('/I'), ('/J'), ('/K'), ('/L'), ('/M'), ('/N'), ('/O'),
('0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
('8'), ('9'), ('/Z'), ('%F'), ('%G'), ('%H'), ('%I'), ('%J'),
('%V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
('X'), ('Y'), ('Z'), ('%K'), ('%L'), ('%M'), ('%N'), ('%O'),
('%W'), ('+A'), ('+B'), ('+C'), ('+D'), ('+E'), ('+F'), ('+G'),
('+H'), ('+I'), ('+J'), ('+K'), ('+L'), ('+M'), ('+N'), ('+O'),
('+P'), ('+Q'), ('+R'), ('+S'), ('+T'), ('+U'), ('+V'), ('+W'),
('+X'), ('+Y'), ('+Z'), ('%P'), ('%Q'), ('%R'), ('%S'), ('%T')
);

var
save: string;
i: integer;
begin
save := FText;
FText := '';

for i := 1 to Length(save) do
begin
if Ord(save) <= 127 then
FText := FText + Code39x[Ord(save)];
end;
Result := Code_39;
FText := save;
end;

function TCBarCode.Code_93: string;
type
TCode93 = record
c: Char;
data: array[0..5] of Char;
end;

const Table_93: array[0..46] of TCode93 = (
( c:'0'; data:'131112' ),
( c:'1'; data:'111213' ),
( c:'2'; data:'111312' ),
( c:'3'; data:'111411' ),
( c:'4'; data:'121113' ),
( c:'5'; data:'121212' ),
( c:'6'; data:'121311' ),
( c:'7'; data:'111114' ),
( c:'8'; data:'131211' ),
( c:'9'; data:'141111' ),
( c:'A'; data:'211113' ),
( c:'B'; data:'211212' ),
( c:'C'; data:'211311' ),
( c:'D'; data:'221112' ),
( c:'E'; data:'221211' ),
( c:'F'; data:'231111' ),
( c:'G'; data:'112113' ),
( c:'H'; data:'112212' ),
( c:'I'; data:'112311' ),
( c:'J'; data:'122112' ),
( c:'K'; data:'132111' ),
( c:'L'; data:'111123' ),
( c:'M'; data:'111222' ),
( c:'N'; data:'111321' ),
( c:'O'; data:'121122' ),
( c:'P'; data:'131121' ),
( c:'Q'; data:'212112' ),
( c:'R'; data:'212211' ),
( c:'S'; data:'211122' ),
( c:'T'; data:'211221' ),
( c:'U'; data:'221121' ),
( c:'V'; data:'222111' ),
( c:'W'; data:'112122' ),
( c:'X'; data:'112221' ),
( c:'Y'; data:'122121' ),
( c:'Z'; data:'123111' ),
( c:'-'; data:'121131' ),
( c:'.'; data:'311112' ),
( c:' '; data:'311211' ),
( c:'$'; data:'321111' ),
( c:'/'; data:'112131' ),
( c:'+'; data:'113121' ),
( c:'%'; data:'211131' ),
( c:'['; data:'121221' ), {only used for Extended Code 93}
( c:']'; data:'312111' ), {only used for Extended Code 93}
( c:'{'; data:'311121' ), {only used for Extended Code 93}
( c:'}'; data:'122211' ) {only used for Extended Code 93}
);


{find Code 93}
function Find_Code93(c: Char): Integer;
var
i: Integer;
begin
for i := 0 to High(Table_93) do
begin
if c = Table_93.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'); {Startcode}

for i:=1 to Length(FText) do
begin
idx := Find_Code93(FText);
if idx < 0 then
raise Exception.CreateFmt('%s: Code93 bad Data <%s>', [Self.ClassName, FText]);
Result := Result + Convert(Table_93[idx].data);
end;

checkC := 0;
checkK := 0;

weightC := 1;
weightK := 2;

for i:=Length(FText) downto 1 do
begin
idx := Find_Code93(FText);

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(Table_93[checkC].data) +
Convert(Table_93[checkK].data);

Result := Result + Convert('1111411'); {Stopcode}
end;

function TCBarCode.Code_93Extended: string;
const Code93x: array[0..127] of string[2] = (
(']U'), ('[A'), ('[B'), ('[C'), ('[D'), ('[E'), ('[F'), ('[G'),
('[H'), ('[I'), ('[J'), ('[K'), ('[L'), ('[M'), ('[N'), ('[O'),
('[P'), ('[Q'), ('[R'), ('[S'), ('[T'), ('[U'), ('[V'), ('[W'),
('[X'), ('[Y'), ('[Z'), (']A'), (']B'), (']C'), (']D'), (']E'),
(' '), ('{A'), ('{B'), ('{C'), ('{D'), ('{E'), ('{F'), ('{G'),
('{H'), ('{I'), ('{J'), ('{K'), ('{L'), ('{M'), ('{N'), ('{O'),
( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
('8'), ('9'), ('{Z'), (']F'), (']G'), (']H'), (']I'), (']J'),
(']V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
('X'), ('Y'), ('Z'), (']K'), (']L'), (']M'), (']N'), (']O'),
(']W'), ('}A'), ('}B'), ('}C'), ('}D'), ('}E'), ('}F'), ('}G'),
('}H'), ('}I'), ('}J'), ('}K'), ('}L'), ('}M'), ('}N'), ('}O'),
('}P'), ('}Q'), ('}R'), ('}S'), ('}T'), ('}U'), ('}V'), ('}W'),
('}X'), ('}Y'), ('}Z'), (']P'), (']Q'), (']R'), (']S'), (']T')
);

var
Save: string;
i: integer;
begin
Save := FText;
FText := '';
for i := 0 to Length(save) - 1 do
begin
if Ord(save) <= 127 then
FText := FText + Code93x[Ord(save)];
end;

Result := Code_93;
FText := save;
end;

function TCBarCode.Code_Codabar: string;
type
TCodabar = record
c: char;
data: array[0..6] of char;
end;

const Table_cb: array[0..19] of TCodabar = (
( c: '1'; data: '5050615' ),
( c: '2'; data: '5051506' ),
( c: '3'; data: '6150505' ),
( c: '4'; data: '5060515' ),
( c: '5'; data: '6050515' ),
( c: '6'; data: '5150506' ),
( c: '7'; data: '5150605' ),
( c: '8'; data: '5160505' ),
( c: '9'; data: '6051505' ),
( c: '0'; data: '5050516' ),
( c: '-'; data: '5051605' ),
( c: '$'; data: '5061505' ),
( c: ':'; data: '6050606' ),
( c: '/'; data: '6060506' ),
( c: '.'; data: '6060605' ),
( c: '+'; data: '5060606' ),
( c: 'A'; data: '5061515' ),
( c: 'B'; data: '5151506' ),
( c: 'C'; data: '5051516' ),
( c: 'D'; data: '5051615' )
);

{find Codabar}
function Find_Codabar(c: Char): Integer;
var
i: Integer;
begin
for i := 0 to High(Table_cb) do
begin
if c = Table_cb.c then
begin
Result := i;
Exit;
end;
end;
Result := -1;
end;

var
i, idx: Integer;
begin
Result := Table_cb[Find_Codabar('A')].data + '0';
for i := 1 to Length(FText) do
begin
idx := Find_Codabar(FText);
Result := Result + Table_cb[idx].data + '0';
end;
Result := Result + Table_cb[Find_Codabar('B')].data;
end;

{Pattern for Barcode EAN Charset A}
{L1 S1 L2 S2}
const Table_EAN_A: array['0'..'9'] of string = (
('2605'), { 0 }
('1615'), { 1 }
('1516'), { 2 }
('0805'), { 3 }
('0526'), { 4 }
('0625'), { 5 }
('0508'), { 6 }
('0706'), { 7 }
('0607'), { 8 }
('2506') { 9 }
);

{Pattern for Barcode EAN Zeichensatz B}
{L1 S1 L2 S2}
const Table_EAN_B: array['0'..'9'] of string = (
('0517'), { 0 }
('0616'), { 1 }
('1606'), { 2 }
('0535'), { 3 }
('1705'), { 4 }
('0715'), { 5 }
('3505'), { 6 }
('1525'), { 7 }
('2515'), { 8 }
('1507') { 9 }
);

{Pattern for Barcode EAN Charset C}
{S1 L1 S2 L2}
const Table_EAN_C:array['0'..'9'] of string = (
('7150' ), { 0 }
('6160' ), { 1 }
('6061' ), { 2 }
('5350' ), { 3 }
('5071' ), { 4 }
('5170' ), { 5 }
('5053' ), { 6 }
('5251' ), { 7 }
('5152' ), { 8 }
('7051' ) { 9 }
);

{Zuordung der Paraitaetsfolgen for EAN13}
const Table_ParityEAN13: array[0..9, 1..6] of char = (
('A', 'A', 'A', 'A', 'A', 'A'), { 0 }
('A', 'A', 'B', 'A', 'B', 'B'), { 1 }
('A', 'A', 'B', 'B', 'A', 'B'), { 2 }
('A', 'A', 'B', 'B', 'B', 'A'), { 3 }
('A', 'B', 'A', 'A', 'B', 'B'), { 4 }
('A', 'B', 'B', 'A', 'A', 'B'), { 5 }
('A', 'B', 'B', 'B', 'A', 'A'), { 6 }
('A', 'B', 'A', 'B', 'A', 'B'), { 7 }
('A', 'B', 'A', 'B', 'B', 'A'), { 8 }
('A', 'B', 'B', 'A', 'B', 'A') { 9 }
);

function TCBarCode.Code_EAN13: string;
var
i, LK: integer;
tmp: String;
begin
if FCheckSum then
begin
tmp := SetLen(12);
tmp := DoCheckSumming(tmp);
end
else
tmp := SetLen(13);

Assert(Length(tmp) = 13, 'Invalid Text len (EAN13)');

LK := StrToInt(tmp[1]);
tmp := Copy(tmp, 2, 12);

Result := '505'; {Startcode}

for i := 1 to 6 do
begin
case Table_ParityEAN13[LK, i] of
'A': Result := Result + Table_EAN_A[tmp];
'B': Result := Result + Table_EAN_B[tmp] ;
'C': Result := Result + Table_EAN_C[tmp] ;
end;
end;

Result := Result + '05050'; {Center Guard Pattern}

for i := 7 to 12 do
Result := Result + Table_EAN_C[tmp] ;

Result := Result + '505'; {Stopcode}
end;

function TCBarCode.Code_EAN8: string;
var
i: Integer;
tmp: string;
begin
if FCheckSum then
begin
tmp := SetLen(7);
tmp := DoCheckSumming(Copy(tmp, Length(tmp)-6, 7));
end
else
tmp := SetLen(8);

Assert(Length(tmp) = 8, 'Invalid Text len (EAN8)');

Result := '505'; {Startcode}

for i:=1 to 4 do
Result := Result + Table_EAN_A[tmp] ;

Result := Result + '05050'; {Center Guard Pattern}

for i := 5 to 8 do
Result := Result + Table_EAN_C[tmp] ;

Result := Result + '505'; {Stopcode}
end;

function TCBarCode.Code_MSI: string;
const Table_MSI: array['0'..'9'] of string[8] = (
( '51515151' ), {'0'}
( '51515160' ), {'1'}
( '51516051' ), {'2'}
( '51516060' ), {'3'}
( '51605151' ), {'4'}
( '51605160' ), {'5'}
( '51606051' ), {'6'}
( '51606060' ), {'7'}
( '60515151' ), {'8'}
( '60515160' ) {'9'}
);

var
i: Integer;
check_even, check_odd, checksum: Integer;
begin
Result := '60'; {Startcode}
check_even := 0;
check_odd := 0;

for i := 1 to Length(FText) do
begin
if odd(i - 1) then
check_odd := check_odd * 10 + Ord(FText)
else
check_even := check_even + Ord(FText);

Result := Result + Table_MSI[FText];
end;

Checksum := QuerSumMe(check_odd * 2) + check_even;

checksum := checksum mod 10;
if checksum > 0 then
checksum := 10 - checksum;

Result := Result + Table_MSI[Chr(Ord('0') + checksum)];

Result := Result + '515'; {Stopcode}
end;

function TCBarCode.Code_PostNet: string;
const Table_PostNet: array['0'..'9'] of string[10] = (
( '5151A1A1A1' ), {'0'}
( 'A1A1A15151' ), {'1'}
( 'A1A151A151' ), {'2'}
( 'A1A15151A1' ), {'3'}
( 'A151A1A151' ), {'4'}
( 'A151A151A1' ), {'5'}
( 'A15151A1A1' ), {'6'}
( '51A1A1A151' ), {'7'}
( '51A1A151A1' ), {'8'}
( '51A151A1A1' ) {'9'}
);

var
i: Integer;
begin
Result := '51';

for i := 1 to Length(FText) do
begin
Result := Result + Table_PostNet[FText];
end;
Result := Result + '5';
end;

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) * 9)
else
sum := sum + (StrToInt(tmp) * 3);
dec(fak);
end;
sum := ((sum mod 10) mod 10) mod 10;
Result := tmp + IntToStr(sum);
end;

function TCBarCode.Code_Supp2: string;
var
i, j: integer;
tmp, mS: string;
begin
FText := SetLen(2);
i := StrToInt(Ftext);
case i mod 4 of
3: mS := 'EE';
2: mS := 'Eo';
1: mS := 'oE';
0: mS := 'oo';
end;
tmp := GetSupp(Copy(FText, 1, 5) + '0');
if FCheckSum then FText := tmp else tmp := FText;
Result := '506'; {Startcode}
for i := 1 to 2 do
begin
if mS = 'E' then
begin
for j:= 1 to 4 do Result := Result + Table_EAN_C[tmp, 5-j];
end
else
begin
Result := Result + Table_EAN_A[tmp];
end;
if i < 2 then Result := Result + '05'; // character delineator
end;
end;

const Table_UPC_E0: array['0'..'9', 1..6] of char = (
('E', 'E', 'E', 'o', 'o', 'o' ), { 0 }
('E', 'E', 'o', 'E', 'o', 'o' ), { 1 }
('E', 'E', 'o', 'o', 'E', 'o' ), { 2 }
('E', 'E', 'o', 'o', 'o', 'E' ), { 3 }
('E', 'o', 'E', 'E', 'o', 'o' ), { 4 }
('E', 'o', 'o', 'E', 'E', 'o' ), { 5 }
('E', 'o', 'o', 'o', 'E', 'E' ), { 6 }
('E', 'o', 'E', 'o', 'E', 'o' ), { 7 }
('E', 'o', 'E', 'o', 'o', 'E' ), { 8 }
('E', 'o', 'o', 'E', 'o', 'E' ) { 9 }
);

function TCBarCode.Code_Supp5: string;
var
i, j: integer;
tmp: string;
c: Char;
begin
FText := SetLen(5);
tmp := GetSupp(Copy(FText, 1, 5) + '0');
c := tmp[6];
if FCheckSum then FText := tmp else tmp := FText;
Result := '506'; {Startcode}
for i := 1 to 5 do
begin
if Table_UPC_E0[c, (6 - 5) + i] = 'E' then
begin
for j := 1 to 4 do Result := Result + Table_EAN_C[tmp, 5 - j];
end
else
begin
Result := Result + Table_EAN_A[tmp];
end;
if i < 5 then Result := Result + '05'; // character delineator
end;
end;

function TCBarCode.Code_UPC_A: string;
var
i: Integer;
tmp: string;
begin
FText := SetLen(12);
if FCheckSum then tmp := DoCheckSumming(Copy(FText, 1, 11));
if FCheckSum then FText := tmp else tmp := FText;
Result := '505'; {Startcode}
for i := 1 to 6 do
Result := Result + Table_EAN_A[tmp];
Result := Result + '05050'; {Trennzeichen}
for i := 7 to 12 do
Result := Result + Table_EAN_C[tmp];
Result := Result + '505'; {Stopcode}
end;

function TCBarCode.Code_UPC_E0: string;
var
i, j: Integer;
tmp: string;
c: Char;
begin
FText := SetLen(7);
tmp := DoCheckSumming(Copy(FText, 1, 6));
c := tmp[7];
if FCheckSum then FText := tmp else tmp := FText;
Result := '505'; {Startcode}
for i := 1 to 6 do
begin
if Table_UPC_E0[c, i] = 'E' then
begin
for j := 1 to 4 do Result := Result + Table_EAN_C[tmp, 5 - j];
end
else
begin
Result := Result + Table_EAN_A[tmp];
end;
end;
Result := Result + '05050'; {Stopcode}
end;

function TCBarCode.Code_UPC_E1: string;
var
i, j: Integer;
tmp: string;
c: Char;
begin
FText := SetLen(7);
tmp := DoCheckSumming(Copy(FText, 1, 6));
c := tmp[7];
if FCheckSum then FText := tmp else tmp := FText;
Result := '505'; {Startcode}
for i := 1 to 6 do
begin
if Table_UPC_E0[c, i] = 'E' then
begin
Result := Result + Table_EAN_A[tmp];
end
else
begin
for j := 1 to 4 do Result := Result + Table_EAN_C[tmp, 5 - j];
end;
end;
Result := Result + '05050'; {Stopcode}
end;

constructor TCBarCode.Create(Owner: TComponent);
begin
inherited;
FAngle := 0.0;
FRatio := 2.0;
FModulo := 1;
FBarCodeType := bcCodeEAN13;
FCheckSum := FALSE;
FShowNum := True;
FColor := clWhite;
FLineColor := clBlack;
FNumFont := TFont.Create;
end;

destructor TCBarCode.Destroy;
begin
FNumFont.Free;
inherited;
end;

function TCBarCode.DoCheckSumming(const Data: string): string;
begin
if FCheckSum then
Result := data
else
Result := CheckSumModulo10(data);
end;

procedure TCBarCode.DoLines(Data: string; Canvas: TCanvas);
var
i: Integer;
lt: TBarLineType;
xadd: Integer;
width, height: Integer;
a, b, c, d, e, {Edges of a line we need 4 Point because the line is a recangle}
orgin: TPoint;
alpha: double;
begin
xadd := 0;
orgin.x := FBarLeft;
orgin.y := FBarTop;
alpha := FAngle * PI / 180.0;

with Canvas do
begin
Canvas.Font.Assign(FNumFont);
Pen.Width := 1;

if ShowNum and (FBarCodeType = bcCodeEAN13) and
(Length(FText) >= 1) then
begin
e.X := 0;
e.Y := FBarHeight;
e := Translate2D(Rotate2D(e, alpha), orgin);
TextOut(e.X, e.Y, FText[1]);
xadd := TextWidth('8') + 2;
end;

for i := 1 to Length(data) do {examine the pattern string}
begin
OneBarProps(data, width, lt);

if (lt = black) or (lt = black_half) then
begin
Pen.Color := FLineColor;
end
else
begin
Pen.Color := FColor;
end;
Brush.Color := Pen.Color;

if lt = black_half then
height := FBarHeight * 2 div 5
else
height := FBarHeight;

if ShowNum and (FBarCodeType = bcCodeEAN13) then
begin
if (i in [1, 3, 29, 31, 57, 59]) then
height := height + TextHeight('W') div 2;
if i = 4 then
begin
e.X := xadd + 2;
e.Y := height;
e := Translate2D(Rotate2D(e, alpha), orgin);
TextOut(e.X, e.Y, Copy(FText, 2, 6));
end;
if i = 32 then
begin
e.X := xadd + 2;
e.Y := height;
e := Translate2D(Rotate2D(e, alpha), orgin);
TextOut(e.X, e.Y, Copy(FText, 8, 6));
end;
end;

a.x := xadd;
a.y := 0;

b.x := xadd;
b.y := height;

{c.x := xadd + width;}
c.x := xadd + width - 1; {23.04.1999 Line was 1 Pixel too wide}
c.y := height;

{d.x := xadd + width;}
d.x := xadd + width - 1; {23.04.1999 Line was 1 Pixel too wide}
d.y := 0;

{a,b,c,d builds the rectangle we want to draw}

{rotate the rectangle}
a := Translate2D(Rotate2D(a, alpha), orgin);
b := Translate2D(Rotate2D(b, alpha), orgin);
c := Translate2D(Rotate2D(c, alpha), orgin);
d := Translate2D(Rotate2D(d, alpha), orgin);

{draw the rectangle}
Polygon([a, b, c, d]);

xadd := xadd + width;
end;
end;
end;

procedure TCBarCode.DrawBarCode(Canvas: TCanvas);
var
data: string;
SaveFont: TFont;
SavePen: TPen;
SaveBrush: TBrush;
begin
Savefont := TFont.Create;
SavePen := TPen.Create;
SaveBrush := TBrush.Create;


{get barcode pattern}
data := MakeData;
try
{store Canvas properties}
Savefont.Assign(Canvas.Font);
SavePen.Assign(Canvas.Pen);
SaveBrush.Assign(Canvas.Brush);

DoLines(data, Canvas); {draw the barcode}

{restore old Canvas properties}
Canvas.Font.Assign(savefont);
Canvas.Pen.Assign(SavePen);
Canvas.Brush.Assign(SaveBrush);
finally
Savefont.Free;
SavePen.Free;
SaveBrush.Free;
end;
end;

function TCBarCode.GetHeight(C: TCanvas): Integer;
begin
Result := BarHeight;

if ShowNum and (FBarCodeType = bcCodeEAN13) then
begin
C.Font.Assign(NumFont);
Inc(Result, C.TextHeight('8'));
end;
end;

function TCBarCode.GetWidth(C: TCanvas): Integer;
var
data: string;
i: Integer;
w: Integer;
lt: TBarLineType;
begin
Result := 0;

{get barcode pattern}
data := MakeData;

for i := 1 to Length(data) do {examine the pattern string}
begin
OneBarProps(data, w, lt);
Inc(Result, w);
end;

if ShowNum and (FBarCodeType = bcCodeEAN13) then
begin
C.Font.Assign(NumFont);
Inc(Result, C.TextWidth('8') + 2);
end;
end;

function TCBarCode.MakeData: string;
var
i : integer;
begin
{calculate the with of the different lines (modules)}
MakeModules;

{numeric barcode type ?}
if BCdata[FBarCodeType].num then
begin
FText := Trim(FText); {remove blanks}
for i := 1 to Length(Ftext) do
if (FText > '9') or (FText < '0') then
raise Exception.Create('Barcode must be numeric');
end;

{get the pattern of the barcode}
case FBarCodeType of
bcCode_2_5_Interleaved: Result := Code_2_5_interleaved;
bcCode_2_5_Industrial: Result := Code_2_5_industrial;
bcCode_2_5_Matrix: Result := Code_2_5_matrix;
bcCode39: Result := Code_39;
bcCode39Extended: Result := Code_39Extended;
bcCode128A,
bcCode128B,
bcCode128C,
bcCodeEAN128A,
bcCodeEAN128B,
bcCodeEAN128C: Result := Code_128;
bcCode93: Result := Code_93;
bcCode93Extended: Result := Code_93Extended;
bcCodeMSI: Result := Code_MSI;
bcCodePostNet: Result := Code_PostNet;
bcCodeCodabar: Result := Code_Codabar;
bcCodeEAN8: Result := Code_EAN8;
bcCodeEAN13: Result := Code_EAN13;
bcCodeUPC_A: Result := Code_UPC_A;
bcCodeUPC_E0: Result := Code_UPC_E0;
bcCodeUPC_E1: Result := Code_UPC_E1;
bcCodeUPC_Supp2: Result := Code_Supp2;
bcCodeUPC_Supp5: Result := Code_Supp5;
else
raise Exception.CreateFmt('%s: wrong BarcodeType', [self.ClassName]);
end;
end;

procedure TCBarCode.MakeModules;
begin
case FBarCodeType of
bcCode_2_5_Interleaved,
bcCode_2_5_Industrial,
bcCode39,
bcCodeEAN8,
bcCodeEAN13,
bcCode39Extended,
bcCodeCodabar,
bcCodeUPC_A,
bcCodeUPC_E0,
bcCodeUPC_E1,
bcCodeUPC_Supp2,
bcCodeUPC_Supp5:
begin
if Ratio < 2.0 then Ratio := 2.0;
if Ratio > 3.0 then Ratio := 3.0;
end;

bcCode_2_5_Matrix:
begin
if Ratio < 2.25 then Ratio := 2.25;
if Ratio > 3.0 then Ratio := 3.0;
end;
bcCode128A,
bcCode128B,
bcCode128C,
bcCode93,
bcCode93Extended,
bcCodeMSI,
bcCodePostNet:;
end;

modules[0] := FModulo;
modules[1] := Round(FModulo * FRatio);
modules[2] := modules[1] * 3 div 2;
modules[3] := modules[1] * 2;
end;

procedure TCBarCode.OneBarProps(Code: Char; var Width: Integer;
var LT: TBarLineType);
begin
case code of
'0': begin width := modules[0]; lt := white; end;
'1': begin width := modules[1]; lt := white; end;
'2': begin width := modules[2]; lt := white; end;
'3': begin width := modules[3]; lt := white; end;


'5': begin width := modules[0]; lt := black; end;
'6': begin width := modules[1]; lt := black; end;
'7': begin width := modules[2]; lt := black; end;
'8': begin width := modules[3]; lt := black; end;

'A': begin width := modules[0]; lt := black_half; end;
'B': begin width := modules[1]; lt := black_half; end;
'C': begin width := modules[2]; lt := black_half; end;
'D': begin width := modules[3]; lt := black_half; end;
else
begin
raise Exception.CreateFmt('%s: internal Error', [self.ClassName]);
end;
end;
end;

function TCBarCode.SetLen(L: Byte): string;
begin
Result := FText;
while Length(Result) < L do
Result := '0' + Result;
end;

procedure TCBarCode.SetModulo(V: Integer);
begin
if (v >= 1) and (v < 50) then
FModulo := V;
end;

procedure TCBarCode.SetNumFont(const Value: TFont);
begin
FNumFont.Assign(Value);
end;

end.

这个是打印用的
unit CQRBarCode;

interface

uses Classes, Graphics, Qrctrls, CBarCode;

type
TCQRBarCode = class(TQRImage)
private
FCBarCode: TCBarCode;
function GetAngle: Double;
function GetBarCodeType: TBarCodeType;
function GetBarHeight: Integer;
function GetBarLeft: Integer;
function GetBarTop: Integer;
function GetCheckSum: Boolean;
function GetColor: TColor;
function GetLineColor: TColor;
function GetModulo: Integer;
function GetNumFont: TFont;
function GetRatio: Double;
function GetShowNum: Boolean;
function GetText: string;
procedure SetAngle(const Value: Double);
procedure SetBarCodeType(const Value: TBarCodeType);
procedure SetBarHeight(const Value: Integer);
procedure SetBarLeft(const Value: Integer);
procedure SetBarTop(const Value: Integer);
procedure SetCheckSum(const Value: Boolean);
procedure SetColor(const Value: TColor);
procedure SetLineColor(const Value: TColor);
procedure SetModulo(const Value: Integer);
procedure SetNumFont(const Value: TFont);
procedure SetRatio(const Value: Double);
procedure SetShowNum(const Value: Boolean);
procedure SetText(const Value: string);

procedure InitPicture;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BarHeight: Integer read GetBarHeight write SetBarHeight;
property Text: string read GetText write SetText;
property BarTop: Integer read GetBarTop write SetBarTop;
property BarLeft: Integer read GetBarLeft write SetBarLeft;

property Modulo: Integer read GetModulo write SetModulo;
property Ratio: Double read GetRatio write SetRatio;
property BarCodeType: TBarCodeType read GetBarCodeType write SetBarCodeType
default bcCodeEAN13;

property CheckSum: Boolean read GetCheckSum write SetCheckSum default False;

property Angle: Double read GetAngle write SetAngle;

property ShowNum: Boolean read GetShowNum write SetShowNum default True;
property NumFont: TFont read GetNumFont write SetNumFont;
property Color: TColor read GetColor write SetColor default clWhite;
property LineColor: TColor read GetLineColor write SetLineColor default clBlack;
end;

implementation

{ TCQRBarCode }

constructor TCQRBarCode.Create(AOwner: TComponent);
begin
inherited;
FCBarCode := TCBarCode.Create(Self);
end;

destructor TCQRBarCode.Destroy;
begin
FCBarCode.Free;
inherited;
end;

function TCQRBarCode.GetAngle: Double;
begin
Result := FCBarCode.Angle;
end;

function TCQRBarCode.GetBarCodeType: TBarCodeType;
begin
Result := FCBarCode.BarCodeType;
end;

function TCQRBarCode.GetBarHeight: Integer;
begin
Result := FCBarCode.BarHeight;
end;

function TCQRBarCode.GetBarLeft: Integer;
begin
Result := FCBarCode.BarLeft;
end;

function TCQRBarCode.GetBarTop: Integer;
begin
Result := FCBarCode.BarTop;
end;

function TCQRBarCode.GetCheckSum: Boolean;
begin
Result := FCBarCode.CheckSum;
end;

function TCQRBarCode.GetColor: TColor;
begin
Result := FCBarCode.Color;
end;

function TCQRBarCode.GetLineColor: TColor;
begin
Result := FCBarCode.LineColor;
end;

function TCQRBarCode.GetModulo: Integer;
begin
Result := FCBarCode.Modulo;
end;

function TCQRBarCode.GetNumFont: TFont;
begin
Result := FCBarCode.NumFont;
end;

function TCQRBarCode.GetRatio: Double;
begin
Result := FCBarCode.Ratio;
end;

function TCQRBarCode.GetShowNum: Boolean;
begin
Result := FCBarCode.ShowNum;
end;

function TCQRBarCode.GetText: string;
begin
Result := FCBarCode.Text;
end;

procedure TCQRBarCode.InitPicture;
begin
Canvas.FillRect(Rect(0, 0, Width, Height));
Picture.Graphic.Width := FCBarCode.GetWidth(Canvas);
Picture.Graphic.Height := FCBarCode.GetHeight(Canvas);
FCBarCode.DrawBarCode(Canvas);
end;

procedure TCQRBarCode.SetAngle(const Value: Double);
begin
FCBarCode.Angle := Value;
InitPicture;
end;

procedure TCQRBarCode.SetBarCodeType(const Value: TBarCodeType);
begin
FCBarCode.BarCodeType := Value;
InitPicture;
end;

procedure TCQRBarCode.SetBarHeight(const Value: Integer);
begin
FCBarCode.BarHeight := Value;
InitPicture;
end;

procedure TCQRBarCode.SetBarLeft(const Value: Integer);
begin
FCBarCode.BarLeft := Value;
InitPicture;
end;

procedure TCQRBarCode.SetBarTop(const Value: Integer);
begin
FCBarCode.BarTop := Value;
InitPicture;
end;

procedure TCQRBarCode.SetCheckSum(const Value: Boolean);
begin
FCBarCode.CheckSum := Value;
InitPicture;
end;

procedure TCQRBarCode.SetColor(const Value: TColor);
begin
FCBarCode.Color := Value;
InitPicture;
end;

procedure TCQRBarCode.SetLineColor(const Value: TColor);
begin
FCBarCode.LineColor := Value;
InitPicture;
end;

procedure TCQRBarCode.SetModulo(const Value: Integer);
begin
FCBarCode.Modulo := Value;
InitPicture;
end;

procedure TCQRBarCode.SetNumFont(const Value: TFont);
begin
FCBarCode.NumFont := Value;
InitPicture;
end;

procedure TCQRBarCode.SetRatio(const Value: Double);
begin
FCBarCode.Ratio := Value;
InitPicture;
end;

procedure TCQRBarCode.SetShowNum(const Value: Boolean);
begin
FCBarCode.ShowNum := Value;
InitPicture;
end;

procedure TCQRBarCode.SetText(const Value: string);
begin
FCBarCode.Text := Value;
InitPicture;
end;

end.

fastreport

http://www.playicq.com/downfile.asp?ID=211&location=HSBarCodeImage.zip

http://www.pdriver.com/display.asp?key_id=1056

honestman:
我下载不了，那个站点要什么点数！我又不能用大富翁的点数，55

tbarcode322是一个错的条形码控件。

http://www.han-soft.biz/down/barcode.php

请问是否可以利用barcode control 9控件的PaintTo方法直接进行打印，我用该方法做了试验，但打印机只会空走纸，而没有打印出条码图形，（使用PaintTo(Printer.Canvas,10,10)和PaintTo(Printer.Handle,10,10)均为此结果）请问这是怎么回事。

请问是否可以利用Office提供的控件barcode control9的PaintTo方法直接进行打印，我用该方法做了试验，但打印机只会空走纸，而没有打印出条码图形，（使用PaintTo(Printer.Canvas,10,10)和PaintTo(Printer.Handle,10,10)均为此结果）请问这是怎么回事。
若须先将其转化成位图再打印，具体做法如何？
请不吝赐教，谢谢！

fastreport上有

to mycuzhoujun,
能否给一份tbarcode322条形码控件(能独立运行),谢谢,有分.

谢谢！