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?

Automaty komórkowe - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 4
SłabyŚwietny
Nadesłany przez Tomasz Nędza, 28 lipca 2005 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.

kod/autkom.pas:
//www.algorytm.org
//Tomasz Nędza
//automaty komórkowe

unit autkom;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Spin, Buttons;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    SpinEdit2: TSpinEdit;
    Label3: TLabel;
    procedure zmiana_algorytmu(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  tablica1, tablica2 : array[0..99, 0..99] of Byte;
  x, y, azymut, licznik : Integer;

implementation

{$R *.DFM}

procedure TForm1.zmiana_algorytmu(Sender: TObject);
var xx, yy : Integer;

begin
 x:=50; y:=50; azymut:=0; licznik:=0;

if(RadioGroup1.ItemIndex<3) then
   begin
      for yy:=0 to 19 do
        for xx:=0 to 19 do
          begin
           tablica1[xx,yy]:=Random(2);
           if(tablica1[xx,yy]=0)then Image1.Canvas.Brush.Color := clBlack;
           if(tablica1[xx,yy]=1)then Image1.Canvas.Brush.Color := clWhite;
           Image1.Canvas.FillRect(Bounds(5*xx, 5*yy, 5, 5));
          end;
   end
   else
   begin
      Image1.Canvas.Brush.Color := clBlack;
      Image1.Canvas.FillRect(Bounds(0, 0, 100, 100));
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var liczba, l, xx, yy : Integer;
    kolor, kolorR, kolorG, kolorB : Integer;

    procedure ruch(dx, dy : Integer);
    begin
      x:=x+dx;
      while x<0 do x:=x+100;
      while x>99 do x:=x-100;

      y:=y+dy;
      while y<0 do y:=y+100;
      while y>99 do y:=y-100;
    end;

    procedure zmien_azymut(da : Integer);
    begin
      azymut:=azymut+da;
      while azymut<0 do azymut:=azymut+8;
      while azymut>7 do azymut:=azymut-8;
    end;

    procedure zmien_kolor(var kolor : Integer; dk : Integer);
    begin
       kolor:=kolor+dk;
       if kolor<0 then kolor:=-kolor;
       if kolor>255 then kolor:= kolor mod 256;
    end;

begin
  if RadioGroup1.ItemIndex=0 then
     for l:=0 to SpinEdit1.Value do begin
         for yy:=0 to 19 do
          for xx:=0 to 19 do
            begin
              liczba:=0;
             if yy>0 then begin
               if(xx>0) then if(tablica1[xx-1,yy-1]=1) then Inc(liczba);
               if(tablica1[xx,yy-1]=1) then Inc(liczba);
               if(xx<19) then if(tablica1[xx+1,yy-1]=1) then Inc(liczba);
             end;
             if(xx>0) then if(tablica1[xx-1,yy]=1) then Inc(liczba);
             if(xx<19) then if(tablica1[xx+1,yy]=1) then Inc(liczba);
             if yy<19 then begin
               if(xx>0) then if(tablica1[xx-1,yy+1]=1) then Inc(liczba);
               if(tablica1[xx,yy+1]=1) then Inc(liczba);
               if(xx<19) then if(tablica1[xx+1,yy+1]=1) then Inc(liczba);
             end;
             if(tablica1[xx,yy]=1)then
              begin
                if(liczba<2) then tablica2[xx,yy]:=0
                else if(liczba<4) then tablica2[xx,yy]:=1
                else if(liczba>3) then tablica2[xx,yy]:=0;
              end
             else if(liczba=3) then tablica2[xx,yy]:=1;
            end;
       for yy:=0 to 19 do
         for xx:=0 to 19 do
           begin
             tablica1[xx,yy]:=tablica2[xx,yy];
             if(tablica1[xx,yy]=0)then Image1.Canvas.Brush.Color := clBlack;
             if(tablica1[xx,yy]=1)then Image1.Canvas.Brush.Color := clWhite;
             Image1.Canvas.FillRect(Bounds(5*xx, 5*yy, 5, 5));
           end;
       end;

  if RadioGroup1.ItemIndex=1 then
    for l:=0 to SpinEdit1.Value do begin
       for yy:=0 to 19 do
         for xx:=0 to 19 do
           begin
             liczba:=0;
             if yy>0 then if(tablica1[xx,yy-1]=1) then Inc(liczba);
             if xx>0 then if(tablica1[xx-1,yy]=1) then Inc(liczba);
             if xx<19 then if(tablica1[xx+1,yy]=1) then Inc(liczba);
             if yy<19 then if(tablica1[xx,yy+1]=1) then Inc(liczba);

             if(liczba=1)then tablica2[xx,yy]:=0;
             if(liczba=2)then tablica2[xx,yy]:=1;
             if(liczba=3)then tablica2[xx,yy]:=0;
             if(liczba=4)then tablica2[xx,yy]:=tablica1[xx,yy];
          end;
       for yy:=0 to 19 do
         for xx:=0 to 19 do
           begin
             tablica1[xx,yy]:=tablica2[xx,yy];
             if(tablica1[xx,yy]=0)then Image1.Canvas.Brush.Color := clBlack;
             if(tablica1[xx,yy]=1)then Image1.Canvas.Brush.Color := clWhite;
             Image1.Canvas.FillRect(Bounds(5*xx, 5*yy, 5, 5));
           end;
        end;

  if RadioGroup1.ItemIndex=2 then           {1.3}
     for l:=0 to SpinEdit1.Value do begin
         for yy:=0 to 19 do
          for xx:=0 to 19 do
            begin
              liczba:=0;
             if yy>0 then begin
               if(xx>0) then if(tablica1[xx-1,yy-1]=1) then Inc(liczba);
               if(tablica1[xx,yy-1]=1) then Inc(liczba);
               if(xx<19) then if(tablica1[xx+1,yy-1]=1) then Inc(liczba);
             end;
             if(xx>0) then if(tablica1[xx-1,yy]=1) then Inc(liczba);
             if(xx<19) then if(tablica1[xx+1,yy]=1) then Inc(liczba);
             if yy<19 then begin
               if(xx>0) then if(tablica1[xx-1,yy+1]=1) then Inc(liczba);
               if(tablica1[xx,yy+1]=1) then Inc(liczba);
               if(xx<19) then if(tablica1[xx+1,yy+1]=1) then Inc(liczba);
             end;
             if(liczba<4) then tablica2[xx,yy]:=0
             else if(liczba>4) then tablica2[xx,yy]:=1
             else if(liczba=3) then tablica2[xx,yy]:=tablica1[xx,yy];

            end;
       for yy:=0 to 19 do
         for xx:=0 to 19 do
           begin
             tablica1[xx,yy]:=tablica2[xx,yy];
             if(tablica1[xx,yy]=0)then Image1.Canvas.Brush.Color := clBlack;
             if(tablica1[xx,yy]=1)then Image1.Canvas.Brush.Color := clWhite;
             Image1.Canvas.FillRect(Bounds(5*xx, 5*yy, 5, 5));
           end;
       end;


  if RadioGroup1.ItemIndex>2 then
     for l:=0 to SpinEdit1.Value do begin
         kolor:=Image1.Canvas.Pixels[x,y];
         kolorR:=GetRValue(kolor);
         kolorG:=GetGValue(kolor);
         kolorB:=GetBValue(kolor);

         case RadioGroup1.ItemIndex of
    {2.1+} 3: zmien_azymut(kolor+(licznik*kolor mod SpinEdit2.Value) mod 3 - 1);
    {2.2+} 4: zmien_azymut((licznik div SpinEdit2.Value) mod 3 -1);
    {2.3+} 5: zmien_azymut((Round(Sqrt(256*kolor)+SpinEdit2.Value)) mod 7 - 1);
    {2.4+} 6: zmien_azymut((kolor*SpinEdit2.Value) mod 7 + 1);
    {2.5+} 7: zmien_azymut((Round(Sqr(licznik))+(kolor div SpinEdit2.Value)) mod 7 + 1);
    {2.6+} 8: zmien_azymut(Round(Cos(kolor)) mod 3);
    {2.7+} 9: zmien_azymut(Round(Sin(licznik)*Cos(kolor div SpinEdit2.Value)) mod 4);
         end;


         case azymut of
          0: ruch(0,-1);
          1: ruch(1, -1);
          2: ruch(1,0);
          3: ruch(1,1);
          4: ruch(0,1);
          5: ruch(-1,1);
          6: ruch(-1,0);
          7: ruch(-1,-1);
         end;

         zmien_kolor(kolorR,25);
//         zmien_kolor(kolorG,25);
//         zmien_kolor(kolorB,25);
         Image1.Canvas.Pixels[x,y]:=RGB(kolorR, kolorG, kolorB);
         Inc(licznik);
       end;

end;

end.
Dodaj komentarz