請問 QReport 有 Barcode 的元件嗎？ |
|
尚未結案
|
|
jerry_go_top
一般會員   發表：13 回覆：15 積分：5 註冊：2004-03-26 發送簡訊給我 |
|
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
unit DHJSW_DSBarCode; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type
DSBarCodeType = (bcCode25interleaved,
bcCode25industrial,
bcCode25matrix,
bcCode39,
bcCode39Extended,
bcCode128A,
bcCode128B,
bcCode128C,
bcCode93,
bcCode93Extended,
bcCodeMSI,
bcCodePostNet,
bcCodeCodabar
); DSBarCode = class(TComponent)
private
{ Private-Deklarationen }
FHeight : integer;
FWidth : integer;
FText : string;
FTop : integer;
FLeft : integer;
FModul : integer;
FRatio : double;
FTyp : DSBarCodeType;
FCheckSum:boolean;
FShowText:boolean;
FAngle : double; modules:array[0..3] of shortint; procedure DoLines(data:string; Canvas:TCanvas); function Code25interleaved:string;
function Code25industrial:string;
function Code25matrix:string;
function Code39:string;
function Code39Extended:string;
function Code128:string;
function Code93:string;
function Code93Extended:string;
function CodeMSI:string;
function CodePostNet:string;
function CodeCodabar:string; function GetTypText:string;
procedure MakeModules; procedure SetModul(v:integer); protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
constructor Create(Owner:TComponent); override;
procedure DrawBarcode(Canvas:TCanvas);
procedure DrawText(Canvas:TCanvas);
published
{ Published-Deklarationen }
property Height : integer read FHeight write FHeight;
property Width : integer read FWidth write FWidth;
property Text : string read FText write FText;
property Top : integer read FTop write FTop;
property Left : integer read FLeft write FLeft;
property Modul : integer read FModul write SetModul;
property Ratio : double read FRatio write FRatio;
property BarType: DSBarCodeType read FTyp write FTyp default bcCode25interleaved;
property Checksum:boolean read FCheckSum write FCheckSum default FALSE;
property Angle :double read FAngle write FAngle;
property ShowText:boolean read FShowText write FShowText default FALSE;
end; procedure Register; implementation {
converts a string from '321' to the internal representation '715'
}
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; (*
* 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; function Translate2D(a, b:TPoint): TPoint;
begin
result.x := a.x b.x;
result.y := a.y b.y;
end; const tabelle25: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
); constructor DSBarCode.Create(Owner:TComponent);
begin
inherited Create(owner);
FAngle := 0.0;
FRatio := 2.0;
FModul := 6;
FTyp := bcCode25interleaved;
FCheckSum := FALSE;
FShowText := FALSE;
end; function DSBarCode.GetTypText:string; const bcNames:array[bcCode25interleaved..bcCodeCodabar] of string =
(
('25interleaved'),
('25industrial'),
('25matrix'),
('Code39'),
('Code39 Extended'),
('Code128A'),
('Code128B'),
('Code128C'),
('Code93'),
('Code93 Extended'),
('MSI'),
('PostNet'),
('Codabar')
); begin
result := bcNames[FTyp];
end; procedure DSBarCode.SetModul(v:integer);
begin
if (v >= 1) and (v < 50) then
FModul := v;
end; function DSBarCode.Code25interleaved:string;
var
i, j: integer;
c : char; begin
result := result '5050'; // Startcode for i:=1 to Length(FText) div 2 do
begin
for j:= 1 to 5 do
begin
if tabelle25[FText[i*2-1], j] = '1' then
c := '6'
else
c := '5';
result := result c;
if tabelle25[FText[i*2], j] = '1' then
c := '1'
else
c := '0';
result := result c;
end;
end; result := result '605'; // Stopcode
end; function DSBarCode.Code25industrial:string;
var
i, j: integer;
begin
result := result '606050'; // Startcode for i:=1 to Length(FText) do
begin
for j:= 1 to 5 do
begin
if tabelle25[FText[i], j] = '1' then
result := result '60'
else
result := result '50';
end;
end; result := result '605060'; // Stopcode
end; function DSBarCode.Code25matrix:string;
var
i, j: integer;
c :char;
begin
result := result '705050'; // Startcode for i:=1 to Length(FText) do
begin
for j:= 1 to 5 do
begin
if tabelle25[FText[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';
end; result := result '70505';
end; function DSBarCode.Code39:string; type TCode39 =
record
c : char;
data : array[0..9] of char;
chk: shortint;
end; const tabelle39: 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:'506051600'; 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(tabelle39) do
begin
if z = tabelle39[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end; var
i, idx : integer;
checksum:integer; begin
checksum := 0;
// Startcode
result := result tabelle39[FindIdx('*')].data '0'; for i:=1 to Length(FText) do
begin
idx := FindIdx(FText[i]);
if idx < 0 then
continue;
result := result tabelle39[idx].data '0';
Inc(checksum, tabelle39[idx].chk);
end; // Calculate Checksum Data
if FCheckSum then
begin
checksum := checksum mod 43;
for i:=0 to High(tabelle39) do
if checksum = tabelle39[i].chk then
begin
result := result tabelle39[i].data '0';
exit;
end;
end; // Stopcode
result := result tabelle39[FindIdx('*')].data;
end; function DSBarCode.Code39Extended: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[i]) <= 127 then
FText := FText code39x[ord(save[i])];
end;
result := Code39;
FText := save;
end; {Code 128}
function DSBarCode.Code128:string;
type TCode128 =
record
a, b : char;
c : string[2];
data : string[6];
end; const tabelle128: 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'; )
); StartA = '211412';
StartB = '211214';
StartC = '211232';
Stop = '2331112'; // find Code 128 Codeset A or B
function FindCode128AB(c:char):integer;
var
i:integer;
v:char;
begin
for i:=0 to High(tabelle128) do
begin
if FTyp = bcCode128A then
v := tabelle128[i].a
else
v := tabelle128[i].b; if c = v then
begin
result := i;
exit;
end;
end;
result := -1;
end; var i, idx: integer;
startcode:string;
checksum : integer; begin
case FTyp of
bcCode128A: begin checksum := 103; startcode:= StartA; end;
bcCode128B: begin checksum := 104; startcode:= StartB; end;
bcCode128C: begin checksum := 105; startcode:= StartC; end;
end; result := result Convert(startcode); // Startcode if FTyp = bcCode128C then
for i:=1 to Length(FText) div 2 do
begin
// noch nicht fertig !
end
else
for i:=1 to Length(FText) do
begin
idx := FindCode128AB(FText[i]);
if idx < 0 then
idx := FindCode128AB(' ');
result := result Convert(tabelle128[idx].data);
Inc(checksum, idx*i);
end; checksum := checksum mod 103;
result := result Convert(tabelle128[checksum].data); result := result Convert(Stop); // Stopcode
end; function DSBarCode.Code93:string;
type TCode93 =
record
c : char;
data : array[0..5] of char;
end; const tabelle93: 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 FindCode93(c:char):integer;
var
i:integer;
begin
for i:=0 to High(tabelle93) do
begin
if c = tabelle93[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end; var
i, idx : integer;
checkC, checkK, // Checksums
weightC, weightK : integer;
begin result := result Convert('111141'); for i:=1 to Length(FText) do
begin
idx := FindCode93(FText[i]);
if idx < 0 then
raise Exception.CreateFmt('%s:Code93 bad Data <%s>', [self.ClassName,FText]);
result := result Convert(tabelle93[idx].data);
end; checkC := 0;
checkK := 0; weightC := 1;
weightK := 2; for i:=Length(FText) downto 1 do
begin
idx := FindCode93(FText[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(tabelle93[checkC].data)
Convert(tabelle93[checkK].data); result := result Convert('1111411'); // Stopcode
end; function DSBarCode.Code93Extended: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:array[0..254] of char;
old:string;
i : integer;
begin
CharToOem(PChar(FText), save);
old := FText;
FText := ''; for i:=0 to Length(save)-1 do
begin
if ord(save[i]) <= 127 then
FText := FText code93x[ord(save[i])];
end; //Showmessage(Format('Text: <%s>', [FText])); result := Code93;
FText := old;
end; function DSBarCode.CodeMSI:string;
const tabelleMSI: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;
checkeven, checkodd, checksum:integer;
begin
result := '60'; // Startcode
checkeven := 0;
checkodd := 0; for i:=1 to Length(FText) do
begin
if odd(i-1) then
checkodd := checkodd*10 ord(FText[i])
else
checkeven := checkeven ord(FText[i]); result := result tabelleMSI[FText[i]];
end; checksum := quersumme(checkodd*2) checkeven; checksum := checksum mod 10;
if checksum > 0 then
checksum := 10-checksum; result := result tabelleMSI[chr(ord('0') checksum)]; result := result '515'; // Stopcode
end; function DSBarCode.CodePostNet:string;
const tabellePostNet: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 tabellePostNet[FText[i]];
end;
result := result '5';
end; function DSBarCode.CodeCodabar:string;
type TCodabar =
record
c : char;
data : array[0..6] of char;
end; const tabellecb: 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 FindCodabar(c:char):integer;
var
i:integer;
begin
for i:=0 to High(tabellecb) do
begin
if c = tabellecb[i].c then
begin
result := i;
exit;
end;
end;
result := -1;
end; var
i, idx : integer;
begin
result := tabellecb[FindCodabar('A')].data '0';
for i:=1 to Length(FText) do
begin
idx := FindCodabar(FText[i]);
result := result tabellecb[idx].data '0';
end;
result := result tabellecb[FindCodabar('B')].data;
end; procedure DSBarCode.MakeModules;
begin
case BarType of
bcCode25interleaved,
bcCode25industrial,
bcCode39,
bcCode39Extended,
bcCodeCodabar:
begin
if Ratio < 2.0 then Ratio := 2.0;
if Ratio > 3.0 then Ratio := 3.0;
end; bcCode25matrix:
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] := FModul;
modules[1] := Round(FModul*FRatio);
modules[2] := modules[1] * 3 div 2;
modules[3] := modules[1] * 2;
end; {
Print the Barcode data :
0-3 white Line
5-8 black Line
A-D black Line (2/5 in Height)
}
procedure DSBarCode.DoLines(data:string; Canvas:TCanvas); type
TLineType = (white, black, blackhalf); var i:integer;
lt : TLineType;
xadd:integer;
width, height:integer;
a,b,c,d, orgin : TPoint;
alpha:double; begin
xadd := 0;
orgin.x := FLeft;
orgin.y := FTop;
alpha := FAngle*pi / 180.0; with Canvas do begin
Pen.Width := 1; for i:=1 to Length(data) do
begin
case data[i] 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 := blackhalf; end;
'B': begin width := modules[1]; lt := blackhalf; end;
'C': begin width := modules[2]; lt := blackhalf; end;
'D': begin width := modules[3]; lt := blackhalf; end; else begin raise Exception.CreateFmt('%s: interner Fehler', [self.ClassName]); end;
end; if (lt = black) or (lt = blackhalf) then
begin
Pen.Color := clBlack;
end
else
begin
Pen.Color := clWhite;
end;
Brush.Color := Pen.Color; if lt = blackhalf then
height := FHeight * 2 div 5
else
height := FHeight; a.x := xadd;
a.y := 0; b.x := xadd;
b.y := height; c.x := xadd width;
c.y := height; d.x := xadd width;
d.y := 0; a := Translate2D(Rotate2D(a, alpha), orgin);
b := Translate2D(Rotate2D(b, alpha), orgin);
c := Translate2D(Rotate2D(c, alpha), orgin);
d := Translate2D(Rotate2D(d, alpha), orgin); Polygon([a,b,c,d]); xadd := xadd width;
FWidth := xadd
end;
end;
end; procedure DSBarCode.DrawBarcode(Canvas:TCanvas);
var
data : string;
begin MakeModules; case BarType of
bcCode25interleaved: data := Code25interleaved;
bcCode25industrial: data := Code25industrial;
bcCode25matrix: data := Code25matrix;
bcCode39: data := Code39;
bcCode39Extended: data := Code39Extended;
bcCode128A,
bcCode128B,
bcCode128C: data := Code128;
bcCode93: data := Code93;
bcCode93Extended: data := Code93Extended;
bcCodeMSI: data := CodeMSI;
bcCodePostNet: data := CodePostNet;
bcCodeCodabar: data := CodeCodabar;
else
raise Exception.CreateFmt('%s: wrong BarcodeType', [self.ClassName]);
end; //Showmessage(Format('Data <%s>', [data])); DoLines(data, Canvas);
if FShowText then DrawText(Canvas);
end; procedure DSBarCode.DrawText(Canvas:TCanvas);
var
savefont : TFont;
begin
savefont := TFont.Create;
try
with Canvas do
begin
savefont.Assign(Font);
Font.Size := 5;
Pen.Color := clBlack;
Brush.Color := clWhite;
TextOut((FLeft FWidth Div 2) - Length(FText) * 6 div 2, FTop FHeight - 7, FText);
//TextOut(FLeft, FTop 14, GetTypText);
Font.Assign(SaveFont);
end;
finally
savefont.Free;
end;
end; procedure Register;
begin
RegisterComponents('DHJSW', [DSBarCode]);
end; end.
|
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
|
|
jerry_go_top
一般會員 發表：13 回覆：15 積分：5 註冊：2004-03-26 發送簡訊給我 |
|
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
|
|
jerry_go_top
一般會員 發表：13 回覆：15 積分：5 註冊：2004-03-26 發送簡訊給我 |
引言:GoldBoy 大大： 請問您有範例嗎？ 剛剛有試了，小弟功力不夠，是否可以 麻煩您寄給我或Delphi k Top 上呢？ 因為用過rave report印過，但是到另一台電腦就不能執行 直接用MScomm 控製也有中文不能列印的情形 手足無措，麻煩您 謝謝您引言: GoldBoy 大大： 小弟不懂這種方法不知道怎麼做，這該怎麼做呢？ 這劃圖的方法嗎？ 請問您有使用過QReport 裡的 Barcode 元件嗎？ 謝謝您 發表人 - jerry_go_top 於 2004/07/01 20:08:48好象QReport 裏沒有 Barcode 元件，我不太清楚，你可以用上面的代碼生成一個 Barcode 繪製元件阿~ 很靈活的，如果這樣也不行我想我幫不了你了~ |
|
jeffreck
高階會員  發表：247 回覆：340 積分：197 註冊：2003-01-23 發送簡訊給我 |
我裝起來後用
self.DSBarCode1.Text := '123456';
self.DSBarCode1.Width :=150;
self.DSBarCode1.Height :=100;
self.DSBarCode1.DrawBarcode(self.Image1.Canvas); 但圖示怪怪的
|
|
jeffreck
高階會員 發表：247 回覆：340 積分：197 註冊：2003-01-23 發送簡訊給我 |
|
|
jeffreck
高階會員 發表：247 回覆：340 積分：197 註冊：2003-01-23 發送簡訊給我 |
|
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
( a:' '; b:' '; c:'11'; data:'231212'; ),
( a:','; b:','; c:'12'; data:'112232'; ), <<< 是不是少了[']'?'
( a:'-'; b:'-'; c:'13'; data:'122132'; ), // VALUE WHICH REPRESENTS IN VALUE WHICH REPRESENTS IN
// CHARACTER SET ENCODING CHARACTER SET ENCODING
//
// A B C A B C
// 00 SP SP 00 11011001100 53 U U 53 11011101110
// 01 ! ! 01 11001101100 54 V V 54 11101011000
// 02 " " 02 11001100110 55 W W 55 11101000110
// 03 # # 03 10010011000 56 X X 56 11100010110
// 04 $ $ 04 10010001100 57 Y Y 57 11101101000
// 05 % % 05 10001001100 58 Z Z 58 11101100010
// 06 & & 06 10011001000 59 [ [ 59 11100011010
// 07 ' ' 07 10011000100 60 \ \ 60 11101111010
// 08 ( ( 08 10001100100 61 ] ] 61 11001000010
// 09 ) ) 09 11001001000 62 ^ ^ 62 11110001010
// 10 * * 10 11001000100 63 _ _ 63 10100110000
// 11 11 11000100100 64 NUL ` 64 10100001100
// 12 , , 12 10110011100 65 SOH a 65 10010110000
// 13 - - 13 10011011100 66 STX b 66 10010000110
// 14 . . 14 10011001110 67 ETX c 67 10000101100
// 15 / / 15 10111001100 68 EOT d 68 10000100110
// 16 0 0 16 10011101100 69 ENQ e 69 10110010000
// 17 1 1 17 10011100110 70 ACK f 70 10110000100
// 18 2 2 18 11001110010 71 BEL g 71 10011010000
// 19 3 3 19 11001011100 72 BS h 72 10011000010
// 20 4 4 20 11001001110 73 HT I 73 10000110100
// 21 5 5 21 11011100100 74 LF j 74 10000110010
// 22 6 6 22 11001110100 75 VT k 75 11000010010
// 23 7 7 23 11101101110 76 FF l 76 11001010000
// 24 8 8 24 11101001100 77 CR m 77 11110111010
// 25 9 9 25 11100101100 78 SO n 78 11000010100
// 26 : : 26 11100100110 79 SI o 79 10001111010
// 27 ; ; 27 11101100100 80 DLE p 80 10100111100
// 28 < < 28 11100110100 81 DC1 q 81 10010111100
// 29 = = 29 11100110010 82 DC2 r 82 10010011110
// 30 > > 30 11011011000 83 DC3 s 83 10111100100
// 31 ? ? 31 11011000110 84 DC4 t 84 10011110100
// 32 @ @ 32 11000110110 85 NAK u 85 10011110010
// 33 A A 33 10100011000 86 SYN v 86 11110100100
// 34 B B 34 10001011000 87 ETB w 87 11110010100
// 35 C C 35 10001000110 88 CAN x 88 11110010010
// 36 D D 36 10110001000 89 EM y 89 11011011110
// 37 E E 37 10001101000 90 SUB z 90 11011110110
// 38 F F 38 10001100010 91 ESC { 91 11110110110
// 39 G G 39 11010001000 92 FS | 92 10101111000
// 40 H H 40 11000101000 93 GS } 93 10100011110
// 41 I I 41 11000100010 94 RS ~ 94 10001011110
// 42 J J 42 10110111000 95 US DEL 95 10111101000
// 43 K K 43 10110001110 96 FNC3 FNC3 96 10111100010
// 44 L L 44 10001101110 97 FNC2 FNC2 97 11110101000
// 45 M M 45 10111011000 98 SHIFT SHIFT 98 11110100010
// 46 N N 46 10111000110 99 Code C Code C 99 10111011110
// 47 O O 47 10001110110 100 Code B FNC4 Code B 10111101110
// 48 P P 48 11101110110 101 FNC4 Code A Code A 11101011110
// 49 Q Q 49 11010001110 102 FNC1 FNC1 FNC1 11110101110
// 50 R R 50 11000101110 103 START A START A START A 11010000100
// 51 S S 51 11011101000 104 START B START B START B 11010010000
// 52 T T 52 11011100010 105 START C START C START C 11010011100
// STOP STOP STOP 11000111010
|
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
引言: 我裝起來後用 self.DSBarCode1.Text := '123456'; self.DSBarCode1.Width :=150; self.DSBarCode1.Height :=100; self.DSBarCode1.DrawBarcode(self.Image1.Canvas); 但圖示怪怪的Image1.AutoSize := True; |
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
|
|
GoldBoy
一般會員 發表：7 回覆：13 積分：4 註冊：2004-06-08 發送簡訊給我 |
//******************************************************************************
// (R)CopyRight Dong Haojie Software International , inc 2000
// Program Name : Bar Code
// Unit Name : Code EAN Unit
// Author : Dong Haojie
// Create Date : 2004.04.30
// Modify Date : 2004.05.09
//****************************************************************************** unit CodeEANUnit; interface uses
SysUtils, Classes, Windows, Graphics, BarCodeShareUnit, Dialogs, BarCodeCheckSumUnit; type
TCodeEAN = record
AData : array[0..4] of Char;
BData : array[0..4] of Char;
CData : array[0..4] of Char;
end;
const
{
EAN 碼字碼、值、資料碼對照表 字碼 值 A類編碼(左) B類編碼(左) C類編碼(右)
0 0 0001101 0100111 1110010
1 1 0011001 0110011 1100110
2 2 0010011 0011011 1101100
3 3 0111101 0100001 1000010
4 4 0100011 0011101 1011100
5 5 0110001 0111001 1001110
6 6 0101111 0000101 1010000
7 7 0111011 0010001 1000100
8 8 0110111 0001001 1001000
9 9 0001011 0010111 1110100 -- EAN 8 -----------------------------------------------
Start：101 Center：01010 Stop：101
-- EAN 13 ----------------------------------------------
Start：101 Center：01010 Stop：101
注： 0為空白，1為線條
}
TabelleEAN:array['0'..'9'] of TCodeEAN =
(
(AData:'2605';BData:'0517';CData:'7150'), { 0 }
(AData:'1615';BData:'0616';CData:'6160'), { 1 }
(AData:'1516';BData:'1606';CData:'6061'), { 2 }
(AData:'0805';BData:'0535';CData:'5350'), { 3 }
(AData:'0526';BData:'1705';CData:'5071'), { 4 }
(AData:'0625';BData:'0715';CData:'5170'), { 5 }
(AData:'0508';BData:'3505';CData:'5053'), { 6 }
(AData:'0706';BData:'1525';CData:'5251'), { 7 }
(AData:'0607';BData:'2515';CData:'5152'), { 8 }
(AData:'2506';BData:'1507';CData:'7051') { 9 }
); //** EAN-13 碼左資料碼編碼規則
TabelleParityEAN13: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 CodeEAN8:String;
function CodeEAN13:String;
function CorrectCodeEAN(BC:String):String; implementation //** Correct Code EAN **********************************************************
function CorrectCodeEAN(BC:String):String;
var
I : Integer;
begin
Result := '';
for I := 1 to Length(BC) do
if (Ord(BC[I])>=48) and (Ord(BC[I])<=57) then Result := Result BC[I];
end; //** Code Code EAN 8 ***********************************************************
function CodeEAN8:String;
var
I : integer;
begin
// Correct Code --------------------------------------------------------------
BarCodeOption.CodeText := CorrectCodeEAN(BarCodeOption.CodeText); // Get Checkout Code ---------------------------------------------------------
BarCodeOption.CheckSumMethod := csmModulo10_1T113;
BarCodeOption.CodeText := SetLen(7,BarCodeOption.CodeText);
BarCodeOption.CodeText := DoCheckSumming(BarCodeOption.CodeText); // Start Code ----------------------------------------------------------------
Result := '505'; // Left Code -----------------------------------------------------------------
for i:=1 to 4 do
Result := Result TabelleEAN[BarCodeOption.CodeText[I]].AData; // Center Code ---------------------------------------------------------------
Result := Result '05050'; // Right Code ----------------------------------------------------------------
for i:=5 to 8 do
Result := Result TabelleEAN[BarCodeOption.CodeText[I]].CData; // Stop Code -----------------------------------------------------------------
Result := Result '505';
end; //** Code Code EAN 13 **********************************************************
function CodeEAN13:String;
var
I, LK: Integer;
Tmp : String;
begin
// Correct Code --------------------------------------------------------------
BarCodeOption.CodeText := CorrectCodeEAN(BarCodeOption.CodeText); // Get Checkout Code ---------------------------------------------------------
BarCodeOption.CheckSumMethod := csmModulo10_1T113;
BarCodeOption.CodeText := SetLen(12,BarCodeOption.CodeText);
BarCodeOption.CodeText := DoCheckSumming(BarCodeOption.CodeText); // Start Code ----------------------------------------------------------------
Result := '505'; // Left Code -----------------------------------------------------------------
LK := StrToInt(BarCodeOption.CodeText[1]);
Tmp := Copy(BarCodeOption.CodeText,2,12);
for I := 1 to 6 do
begin
case TabelleParityEAN13[LK,I] of
'A' : Result := Result TabelleEAN[Tmp[I]].AData;
'B' : Result := Result TabelleEAN[Tmp[I]].BData;
'C' : Result := Result TabelleEAN[Tmp[I]].CData;
end;
end; // Center Code ---------------------------------------------------------------
Result := Result '05050'; // Right Code ----------------------------------------------------------------
for I := 7 to 12 do
Result := Result TabelleEAN[Tmp[I]].CData; // Stop Code -----------------------------------------------------------------
Result := Result '505'; {Stopcode}
end; end. ISBN is 978 EAN13 Checkout
|
發表時間：2004-07-01 19:48:55
IP:220.130.xxx.xxx 未訂閱
系統時間：2024-05-17 13:27:23
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |