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 // www.algorytm.org // (c)2005 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; { 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; 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 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.