game tetris

Membuat game tetris
Buat frm sbb:

coding sebagian sbb: 

var

  Form1: TForm1;

  a_waktu:longword;

  a_Garis:integer;

  i,j:integer;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.Initialize;

begin

 foffx:=PaintBox1.left;

 foffy:=PaintBox1.top;

 fposbaris:=-4;

 fposkolom:=5;

 fNilai:=0;

 fGaris:=0;

 flevel:=0;

 fWaktu:=400;

 fberakhir:=false;

 fTempat_Model:=false;

 Label7.visible:=false;

end;

procedure TForm1.WndProc(var msg:TMessage);

begin

 inherited;

 if msg.msg=WM_STARTGAME then

  Begin

  Randomize;

 fPilihan.key1:=Random(7);

 fPilihan.key2:=Random(4);

 fPilihan.key3:=Random(Warna)+1;

 fSelanjutnya.key1:=Random(7);

 fSelanjutnya.key2:=Random(4);

 fSelanjutnya.key3:=Random(Warna)+1;

 a_Waktu:=GettickCount;

   mulai.Enabled:=true;

  end;

End;

procedure TForm1.Memindah_Model(aOrientation:Torientasi);

var

 Sebuah_Model:PModel;

begin

 Sebuah_Model:= @Model[fPilihan.key1,fPilihan.key2];

 Membersihkan_Model(Sebuah_Model,fposbaris,fposkolom);

 case aOrientation of

  kiri:

   if Dapat_Meletakkan_Model(Sebuah_Model,fposbaris,fposkolom-1) then

    fposkolom:=fposkolom-1;

  kanan:

   if Dapat_Meletakkan_Model(Sebuah_Model,fposbaris,fposkolom+1) then

    fposkolom:=fposkolom+1;

  bawah:

   if Dapat_Meletakkan_Model(Sebuah_Model,fposbaris+1,fposkolom) then

    fposbaris:=fposbaris+1

   else

    fTempat_Model:=true;

  putar:

   if Dapat_Meletakkan_Model(@Model[fPilihan.key1,(fPilihan.key2+1) mod 4],fposbaris,fposkolom) then

    begin

     fPilihan.key2:=(fPilihan.key2+1) mod 4;

     Sebuah_Model:= @Model[fPilihan.key1,fPilihan.key2];

    end;

 end;

 Meletakkan_Model(Sebuah_Model,fposbaris,fposkolom);

end;

function TForm1.Mendapatkansell(arow,acol:integer):TRect;

begin

 SetRect(result,-1,-1,-1,-1);

 if (arow<0) or (arow>Baris) or (acol<0) or (acol>Kolom) then exit;

 result.left:=(PaintBox1.width div Kolom)*acol+1;

 result.top:=(PaintBox1.Height div Baris)*arow+1;

 result.right:=result.left+Ukuran_sel;

 result.bottom:=result.top+Ukuran_Sel;

end;

function TForm1.Mendapatkan_tampilan_sell(arow,acol:integer):TRect;

begin

 SetRect(result,-1,-1,-1,-1);

 if (arow<0) or (arow>Ukuran_Model) or (acol<0) or (acol>Ukuran_Model) then exit;

 result.left:=(PaintBox2.width div Ukuran_Model)*acol+1;

 result.top:=(PaintBox2.Height div Ukuran_Model)*arow+1;

 result.right:=result.left+PREVIEW_Ukuran_Sel;

 result.bottom:=result.top+PREVIEW_Ukuran_Sel;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

 if fberakhir then exit;

 if key=VK_DOWN then

  Memindah_Model(bawah)

 else if key=VK_LEFT then

  Memindah_Model(kiri)

 else if key=VK_RIGHT then

  Memindah_Model(kanan)

 else if key=VK_UP then

  Memindah_Model(putar);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 fberakhir:=true;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

var

 tmprect:TRect;

 i,j,hdc:integer;

begin

 PaintBox1.Canvas.Pen.Color:=clred;

 PaintBox1.Canvas.Rectangle(0,0,PaintBox1.width,PaintBox1.Height);

 hdc:=PaintBox1.canvas.handle;

 for i:=0 to 19 do

  for j:=0 to 9 do

   begin

    if fPapan[i,j]>0 then

     begin

      PaintBox1.canvas.Brush.Color:=COLORS[fPapan[i,j]];

      tmprect:=Mendapatkansell(i,j);

      PaintBox1.Canvas.Rectangle(tmprect);

      DrawEdge(hdc,tmprect,EDGE_BUMP,BF_RECT or BF_SOFT);

     end

   end;

end;

procedure TForm1.PaintBox2Paint(Sender: TObject);

var

 tmprect:TRect;

 i,j,hdc:integer;

 a_Model:PModel;

begin

 Paintbox2.Canvas.Pen.Color:=clred;

 Paintbox2.Canvas.Rectangle(0,0,Paintbox2.width,Paintbox2.Height);

 hdc:=Paintbox2.canvas.handle;

 a_Model:=@Model[fSelanjutnya.key1,fSelanjutnya.key2];

Paintbox2.canvas.Brush.Color:=COLORS[fSelanjutnya.key3];

 for i:=0 to Ukuran_Model-1 do

  for j:=0 to Ukuran_Model-1 do

   begin

    if a_Model.matrix[i,j]>0 then

     begin

      tmprect:=Mendapatkan_tampilan_sell(i,j);

      Paintbox2.Canvas.Rectangle(tmprect);

      DrawEdge(hdc,tmprect,EDGE_BUMP,BF_RECT or BF_SOFT);

     end

   end;

end;

procedure TForm1.Sell_Tidak_Berlaku(arow,acol:integer);

var

 tmprect:TRect;

begin

 if (arow<0) or (arow>Baris) or (acol<0) or (acol>Kolom) then exit;

 tmprect:=Mendapatkansell(arow,acol);

 offsetrect(tmprect,foffx,foffy);

 InvalidateRect(handle,@tmprect,false);

end;

procedure TForm1.Preview_Tidak_Berlaku;

var

 tmprect:TRect;

begin

 tmprect.left:=PaintBox2.left;

 tmprect.top:=PaintBox2.top;

 tmprect.right:=tmprect.left+PaintBox2.width;

 tmprect.bottom:=tmprect.top+PaintBox2.height;

 InvalidateRect(handle,@tmprect,false);

 end;

procedure TForm1.Model_Tidak_Berlaku(arow,acol:integer);

var

 i,j:integer;

 tmprect:TRect;

begin

 SetRectEmpty(tmprect);

 for i:=-1 to 3 do

  for j:=-1 to 4 do

   UnionRect(tmprect,tmprect,Mendapatkansell(arow+i,acol+j));

 offsetrect(tmprect,foffx,foffy);

 invalidaterect(handle,@tmprect,false);

end;

function TForm1.Membersihkan_Garis:integer;

var

 i,j,k,l:integer;

 tmprect:TRect;

begin

 result:=0;

 l:=Baris-1;

 for i:=Baris-1 downto 0 do

  begin

   k:=0;

   for j:=Kolom-1 downto 0 do

    if(fpapan[i,j]>0) then k:=k+1;

   if k=Kolom then

    result:=result+1

   else

    begin

     for k:=0 to Kolom-1 do

      fPapan[l,k]:=fpapan[i,k];

     l:=l-1;

    end;

  end;

 tmprect.left:=foffx;

 tmprect.top:=foffy;

 tmprect.right:=tmprect.left+PaintBox1.Width;

 tmprect.bottom:=tmprect.top+PaintBox1.height;

 if result>0 then

  InvalidateRect(handle,@tmprect,false);

end;

function TForm1.Dapat_Meletakkan_Model(apiece:PModel;arow,acol:integer):boolean;

var

 i,j,k:integer;

 Patah:boolean;

begin

 result:=false;k:=0;

 if (arow<-4) or (acol<0) then exit;

 for i:=0 to 3 do

  begin

   Patah:=false;

   for j:=0 to 3 do

    begin

     if ((arow+i<Baris) and

         (acol+j<Kolom) and

         (fPapan[arow+i,acol+j]=0)) or (apiece.matrix[i,j]=0) then

        k:=k+1

      else

       begin

        Patah:=false;

        break;

       end;

    end;

   if Patah then break;

  end;

 if k=16 then result:=true;

end;

procedure TForm1.Meletakkan_Model(apiece:PModel;arow,acol:integer;ainv:boolean=true);

var

 i,j:integer;

begin

 for i:=0 to 3 do

  for j:=0 to 3 do

   if (arow+i<Baris) and (acol+j<Kolom) and (apiece.matrix[i,j]=1) then

    fPapan[arow+i,acol+j]:=apiece.matrix[i,j]*fPilihan.key3;

 if ainv then Model_Tidak_Berlaku(arow,acol);

end;

procedure TForm1.Membersihkan_Model(apiece:PModel;arow,acol:integer;ainv:boolean=true);

var

 i,j:integer;

begin

 for i:=0 to 3 do

  for j:=0 to 3 do

   if (arow+i<Baris) and (acol+j<Kolom) and (apiece.matrix[i,j]=1) then

    fPapan[arow+i,acol+j]:=0;

end;

procedure TForm1.Quit1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.NewGame1Click(Sender: TObject);

  begin

  PaintBox1.Canvas.Brush.Color:=clNone;

  PaintBox1.Canvas.Brush.Style:=bsClear;

  PaintBox1.Canvas.Rectangle(0,0,0,0);

  Initialize;

  doublebuffered:=true;

  postMessage(handle,WM_STARTGAME,0,0);

end;

procedure TForm1.AboutProgram1Click(Sender: TObject);

begin

form2.show;

end;

procedure TForm1.Pause1Click(Sender: TObject);

begin

//if fberakhir then exit;

if Pause1.Checked then

  mulai.Enabled:=True

else

  mulai.Enabled:=False;

Pause1.Checked     := Not(Pause1.Checked);

Timer1.Enabled     := Not(Pause1.Checked);

end;

procedure TForm1.mulaiTimer(Sender: TObject);

begin

  Application.ProcessMessages;

  if (Gettickcount-a_Waktu)>fWaktu then

    begin

      Memindah_Model(bawah);

      a_Waktu:=GetTickCount;

    end;

  if fTempat_Model then

    begin

      if fposbaris<0 then

        begin

          Label7.visible:=true;

            lbl8.Visible:=True;

          fberakhir:=true;

          mulai.Enabled:=False;

        end;

      a_Garis:=Membersihkan_Garis;

      if a_Garis>0 then

        begin

          fNilai:=fNilai+a_Garis*Nilai_Garis;

          fNilai:=fNilai+(a_Garis-1)*Nilai_Bonus;

          fGaris:=fGaris+a_Garis;

          if fNilai>=(flevel+1)*100 then

            begin

              flevel:=flevel+1;

              //fWaktu:=fwaktu-25;

              mulai.Interval:=mulai.Interval div 2;

            end;

          if flevel>10 then

            begin

              Label7.Visible:=True;

              Label7.Caption:='You are the winner';

              mulai.Enabled:=False;

            end

          else

            begin

              Label10.caption:=inttostr(fNilai);

              Label9.caption:=inttostr(fGaris);

              Label8.Caption:=inttostr(flevel);

            end;

        end;

      fposbaris:=-4;fposkolom:=5;

      fTempat_Model:=false;

      fPilihan:=fSelanjutnya;

      fSelanjutnya.key1:=Random(7);

      fSelanjutnya.key2:=Random(4);

      fSelanjutnya.key3:=Random(Warna)+1;

      Preview_Tidak_Berlaku;

    end;

end;

procedure TForm1.Help2Click(Sender: TObject);

begin

application.HelpCommand(help_forcefile,2);

end;

procedure TForm1.FormCreate(Sender: TObject);

var s:string;

begin

s:=extractfilepath(application.ExeName);

application.HelpFile:=s+'help.hlp';

application.Title:='help';

end;
end.
Hasil: 

sumber: http://jauharoh.wordpress.com/tag/membuat-tetris-dengan-delphi/
semoga bermanfaat,,,hehehe