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?

Pharmacode one-track - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 25 lipca 2007 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 Pharmacode one-track
// www.algorytm.org
// (c)2007 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 DrawSignBar(bar: Char);
    function Check(txt: String): Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


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;
begin
        i:= StrToInt(txt);
        if (i<3) or (i>131070) then
           Result := False
        else
           Result := True;
end;

procedure TForm1.DrawBars(txt: String);
var
        i : Integer;
begin
        curentPos := 300;
        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Rectangle(0, 0, 337, 89);

        i := StrToInt(txt);
        while (i <> 0) do
           begin
                if ((i mod 2) = 0) then
                   begin
                        drawSignBar('W');
                        i := (i-2) div 2;
                   end
                else
                   begin
                        drawSignBar('N');
                        i := (i-1) div 2;
                   end;
           end;
end;

procedure TForm1.DrawSignBar(bar: Char);
var
        nextPos : Integer;
begin
        Image1.Canvas.Brush.Color := clBlack;

        if (bar = 'W') then
                nextPos := curentPos - 2*3
        else
                nextPos := curentPos - 2;

        Image1.Canvas.Rectangle(curentPos + 20, 10, nextPos + 20, 70);
        curentPos := nextPos;

        curentPos :=  curentPos - 2*2;
end;

end.
Dodaj komentarz