Nadesłany przez Tomasz Lubiński, 17 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 Extended Code 39
// 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; converted: String);
procedure DrawSignBars(bars: array of Char);
function Check(txt: String): Boolean;
function CheckLetter(ch: Char): Boolean;
function Convert(txt: String): String;
{ 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')
);
extendedCode39Replace : array [0..127] of String = (
'%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',
'-', '.', '/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'
);
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);
var
converted : String;
begin
converted := Convert(Kod.Text);
if Check(converted) = False then
begin
ShowMessage('Incorrect text');
exit;
end;
DrawBars(Kod.Text, converted);
end;
function TForm1.Convert(txt: String): String;
var
i, code: Integer;
res: String;
begin
res := '';
for i:=1 to Length(txt) do
begin
code := Ord(txt[i]);
if ((code >= 0) and (code <= 127)) then
res := res + extendedCode39Replace[code]
else
res := txt[i];
end;
Result := res;
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;
procedure TForm1.DrawBars(txt: String; converted: 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(converted) do
for j:=0 to 42 do
if code39sign[j] = converted[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(converted)*3, 100, 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.