algorytm.org

Implementacja w Delphi/Pascal

Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Extended Code 39 - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
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.
Dodaj komentarz