Nadesłany przez Tomasz Lubiński, 14 września 2006 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Kody Kreskowe - Delphi/Unit1.pas:
//---------------------------------------------------------------------------
// Generowanie kodow kreskowych Code 39 mod 43
// www.algorytm.org
// (c)2006 Tomasz Lubinski
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Kod: TEdit;
procedure Button1Click(Sender: TObject);
private
curentPos: Integer;
procedure DrawBars(txt: String);
procedure DrawSignBars(bars: array of Char);
function Check(txt: String): Boolean;
function CheckLetter(ch: Char): Boolean;
function GetLetterValue(ch: Char) : Integer;
function CheckDigit(txt: String): Integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
code39sign : array [0..42] of Char = (
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'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', '-', '.', ' ', '$',
'/', '+', '%');
code39bars : array [0..42] of array [0..8] of Char = (
('N', 'N', 'N', 'W', 'W', 'N', 'W', 'N', 'N'),
('W', 'N', 'N', 'W', 'N', 'N', 'N', 'N', 'W'),
('N', 'N', 'W', 'W', 'N', 'N', 'N', 'N', 'W'),
('W', 'N', 'W', 'W', 'N', 'N', 'N', 'N', 'N'),
('N', 'N', 'N', 'W', 'W', 'N', 'N', 'N', 'W'),
('W', 'N', 'N', 'W', 'W', 'N', 'N', 'N', 'N'),
('N', 'N', 'W', 'W', 'W', 'N', 'N', 'N', 'N'),
('N', 'N', 'N', 'W', 'N', 'N', 'W', 'N', 'W'),
('W', 'N', 'N', 'W', 'N', 'N', 'W', 'N', 'N'),
('N', 'N', 'W', 'W', 'N', 'N', 'W', 'N', 'N'),
('W', 'N', 'N', 'N', 'N', 'W', 'N', 'N', 'W'),
('N', 'N', 'W', 'N', 'N', 'W', 'N', 'N', 'W'),
('W', 'N', 'W', 'N', 'N', 'W', 'N', 'N', 'N'),
('N', 'N', 'N', 'N', 'W', 'W', 'N', 'N', 'W'),
('W', 'N', 'N', 'N', 'W', 'W', 'N', 'N', 'N'),
('N', 'N', 'W', 'N', 'W', 'W', 'N', 'N', 'N'),
('N', 'N', 'N', 'N', 'N', 'W', 'W', 'N', 'W'),
('W', 'N', 'N', 'N', 'N', 'W', 'W', 'N', 'N'),
('N', 'N', 'W', 'N', 'N', 'W', 'W', 'N', 'N'),
('N', 'N', 'N', 'N', 'W', 'W', 'W', 'N', 'N'),
('W', 'N', 'N', 'N', 'N', 'N', 'N', 'W', 'W'),
('N', 'N', 'W', 'N', 'N', 'N', 'N', 'W', 'W'),
('W', 'N', 'W', 'N', 'N', 'N', 'N', 'W', 'N'),
('N', 'N', 'N', 'N', 'W', 'N', 'N', 'W', 'W'),
('W', 'N', 'N', 'N', 'W', 'N', 'N', 'W', 'N'),
('N', 'N', 'W', 'N', 'W', 'N', 'N', 'W', 'N'),
('N', 'N', 'N', 'N', 'N', 'N', 'W', 'W', 'W'),
('W', 'N', 'N', 'N', 'N', 'N', 'W', 'W', 'N'),
('N', 'N', 'W', 'N', 'N', 'N', 'W', 'W', 'N'),
('N', 'N', 'N', 'N', 'W', 'N', 'W', 'W', 'N'),
('W', 'W', 'N', 'N', 'N', 'N', 'N', 'N', 'W'),
('N', 'W', 'W', 'N', 'N', 'N', 'N', 'N', 'W'),
('W', 'W', 'W', 'N', 'N', 'N', 'N', 'N', 'N'),
('N', 'W', 'N', 'N', 'W', 'N', 'N', 'N', 'W'),
('W', 'W', 'N', 'N', 'W', 'N', 'N', 'N', 'N'),
('N', 'W', 'W', 'N', 'W', 'N', 'N', 'N', 'N'),
('N', 'W', 'N', 'N', 'N', 'N', 'W', 'N', 'W'),
('W', 'W', 'N', 'N', 'N', 'N', 'W', 'N', 'N'),
('N', 'W', 'W', 'N', 'N', 'N', 'W', 'N', 'N'),
('N', 'W', 'N', 'W', 'N', 'W', 'N', 'N', 'N'),
('N', 'W', 'N', 'W', 'N', 'N', 'N', 'W', 'N'),
('N', 'W', 'N', 'N', 'N', 'W', 'N', 'W', 'N'),
('N', 'N', 'N', 'W', 'N', 'W', 'N', 'W', 'N')
);
start_stop : array [0..8] of Char = (
'N', 'W', 'N', 'N', 'W', 'N', 'W', 'N', 'N'
);
wide_multiply : Integer = 2;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
if Check(Kod.Text) = False then
begin
ShowMessage('Incorrect text');
exit;
end;
DrawBars(Kod.Text);
end;
function TForm1.Check(txt: String): Boolean;
var
i: Integer;
res: Boolean;
begin
res := True;
for i:=1 to Length(txt) do
if (CheckLetter(txt[i])) = False then
begin
res := False;
break;
end;
Result := res;
end;
function TForm1.CheckLetter(ch: Char): Boolean;
var
i: Integer;
res: Boolean;
begin
res := False;
for i:=0 to 42 do
if code39sign[i] = ch then
begin
res := True;
break;
end;
Result := res;
end;
// returns letter value for check digit
function TForm1.GetLetterValue(ch: Char) : Integer;
var
i: Integer;
begin
Result := 0;
for i:=0 to 42 do
if (code39sign[i] = ch) then
begin
Result := i;
break;
end;
end;
// return check digit
function TForm1.CheckDigit(txt: String): Integer;
var
i, sum : Integer;
begin
sum := 0;
for i:=1 to length(txt) do
sum := sum + GetLetterValue(txt[i]);
Result := (sum mod 43);
end;
procedure TForm1.DrawBars(txt: String);
var
i, j : Integer;
begin
curentPos := 0;
Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.Rectangle(0, 0, 441, 121);
//print start character
DrawSignBars(start_stop);
//print characters
for i:=1 to Length(txt) do
for j:=0 to 42 do
if code39sign[j] = txt[i] then
begin
DrawSignBars(code39bars[j]);
break;
end;
//Draw text
Image1.Canvas.Font.Size := 10;
Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.Font.Color := clBlack;
Image1.Canvas.TextOut(curentPos div 2 + 20 - Length(txt)*3, 100, txt);
//print check digit
drawSignBars(code39bars[checkDigit(txt)]);
//print stop character
DrawSignBars(start_stop);
end;
procedure TForm1.DrawSignBars(bars: array of Char);
var
i, nextPos : Integer;
begin
Image1.Canvas.Brush.Color := clBlack;
//print bars
for i:=0 to 8 do
begin
if (bars[i] = 'W') then
nextPos := curentPos + 2*wide_multiply
else
nextPos := curentPos + 2;
if (i mod 2) = 0 then
Image1.Canvas.Rectangle(curentPos + 20, 10, nextPos + 20, 100);
curentPos := nextPos;
end;
curentPos := curentPos + 2;
end;
end.