www.pudn.com > 200589952618.rar > MAIN.PAS

unit main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, StdCtrls, Menus, CustObj, IdBaseComponent, IdComponent, 
  IdUDPBase, IdUDPServer, mytype, IdTCPServer, IdTCPConnection, 
  IdTCPClient, IdAntiFreezeBase, IdAntiFreeze; 
 
type 
 
  TfrmMain = class(TForm) 
    Timer1: TTimer; 
    Panel1: TPanel; 
    PaintBox1: TPaintBox; 
    MainMenu1: TMainMenu; 
    File1: TMenuItem; 
    mnuStart: TMenuItem; 
    mnuPause: TMenuItem; 
    mnuCancel: TMenuItem; 
    Panel2: TPanel; 
    ScrNext: TPaintBox; 
    stScore: TStaticText; 
    stLines: TStaticText; 
    stSpeed: TStaticText; 
    stDuring: TStaticText; 
    lblStatus: TLabel; 
    IdTCPClient1: TIdTCPClient; 
    IdAntiFreeze1: TIdAntiFreeze; 
    GBEnemy: TGroupBox; 
    Panel3: TPanel; 
    PaintBox2: TPaintBox; 
    N2: TMenuItem; 
    Timer2: TTimer; 
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 
    procedure FormCreate(Sender: TObject); 
    procedure ScrDraw; 
    procedure NextDraw; 
    procedure Timer1Timer(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
    procedure mnuStartClick(Sender: TObject); 
    procedure mnuPauseClick(Sender: TObject); 
    procedure mnuExitClick; 
    procedure mnuCancelClick(Sender: TObject); 
    procedure Init; 
    procedure Timer2Timer(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    playerme: Ruserdata; 
    playerenemy: Ruserdata; 
    EBG: Drawbox; 
    EFG: Drawbox; 
    function PlayerConnect(var userdata: Ruserdata): boolean; 
    procedure enemystart(var userdata: Ruserdata); 
    procedure enemyplay; 
    procedure win; 
    procedure EnemyInit; 
    procedure EnemyDraw; 
    procedure SendDraw; 
    { Public declarations } 
  end; 
 
var 
  frmMain: TfrmMain; 
  BG: Drawbox; 
  FG: Drawbox; 
  mCanvas: Tbitmap; 
  mECanvas: Tbitmap; 
  BOX: array[0..7] of Tbitmap; 
  EBOX: array[0..7] of Tbitmap; 
  Obj: TCustObj; 
  sNext: Byte; 
  sObj: Byte; 
  STime: Tdatetime; 
  Score, lines, Speed: integer; 
implementation 
 
uses myconst, mainformpas; 
{$R *.DFM} 
{$R BOX.res} 
procedure TfrmMain.EnemyInit; 
begin 
  FillChar(EBG, 200, #0); 
  FillChar(EFG, 200, #0); 
  EnemyDraw; 
end; 
 
procedure TfrmMain.EnemyDraw; 
var 
  i, j: integer; 
begin 
  mECanvas := Tbitmap.Create; 
  mECanvas.Width := 200; 
  mECanvas.Height := 400; 
 
  with mECanvas.Canvas do 
  begin 
    mECanvas.Canvas.Brush.Bitmap := EBOX[0]; 
    mECanvas.Canvas.FillRect(Rect(0, 0, 170, 340)); 
    for i := 0 to 9 do 
    begin 
      for j := 0 to 19 do 
      begin 
        if (EFG[i, j] <> 0) then 
          mECanvas.Canvas.CopyRect(Rect(i * 17, j * 17, (i + 1) * 17, (j + 1) * 17), EBOX[EFG[i, j]].Canvas, Rect(0, 0, 16, 16)); 
        if (EBG[i, j] <> 0) then 
          mECanvas.Canvas.CopyRect(Rect(i * 17, j * 17, (i + 1) * 17, (j + 1) * 17), EBOX[EBG[i, j]].Canvas, Rect(0, 0, 16, 16)); 
      end; 
    end; 
  end; 
  PaintBox2.Canvas.CopyRect(Rect(0, 0, 170, 340), mECanvas.Canvas, Rect(0, 0, 170, 340)); 
  mECanvas.Free; 
end; 
 
 
procedure TfrmMain.win; 
begin 
  Timer1.Enabled := False; 
  Timer2.Enabled := False; 
  showmessage('You Win Congratulations!'); 
  EnemyInit; 
  Init; 
  mnuStart.Enabled := True; 
  mnuPause.Enabled := False; 
  mnuCancel.Enabled := False; 
end; 
procedure TfrmMain.enemyplay; 
begin 
  EnemyDraw; 
end; 
 
procedure TfrmMain.enemystart(var userdata: Ruserdata); 
begin 
  GBEnemy.Caption := userdata.username; 
  self.Width := 487; 
  EnemyInit; 
end; 
 
function TfrmMain.PlayerConnect(var userdata: Ruserdata): boolean; 
var 
  mess: string; 
begin 
  mess := 'Do you want to play with "' + userdata.username + '"'; 
  if Application.MessageBox(pchar(mess), 'Question', MB_ICONQUESTION + MB_YESNO) = IDYES then 
  begin 
    enemystart(userdata); 
    result := True; 
  end 
  else 
    result := False; 
end; 
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  try 
    if Timer1.Enabled then 
    begin 
      case Key of 
        37: begin 
            Obj.Move(-1); 
          end; 
        39: begin 
            Obj.Move(1); 
          end; 
        38: begin 
            Obj.Rotate; 
          end; 
        40: begin 
            Obj.Drop; 
          end; 
        32: begin 
            while Obj.Drop do 
            begin 
              ScrDraw; 
              if self.Width = 487 then 
                SendDraw; 
            end; 
          end; 
        27: if mnuCancel.Enabled then mnuCancelClick(self); 
      end; 
      ScrDraw; 
      if self.Width = 487 then 
        SendDraw; 
    end; 
  except 
    on e: exception do 
    begin 
      showmessage('无法连接' + playerenemy.username + '，请稍后重试！'); 
      self.Width := 280; 
      Init; 
      EnemyInit; 
      Timer1.Enabled := False; 
      Timer2.Enabled := False; 
      mnuStart.Enabled := True; 
      mnuPause.Enabled := False; 
      mnuCancel.Enabled := False; 
      exit; 
    end; 
  end; 
end; 
 
procedure TfrmMain.FormCreate(Sender: TObject); 
var 
  i: integer; 
begin 
  self.Width := 280; 
  Randomize; 
  for i := 0 to 7 do 
  begin 
    BOX[i] := Tbitmap.Create; 
    EBOX[i] := Tbitmap.Create; 
  end; 
  BOX[0].LoadFromResourceName(HInstance, 'BLACK'); 
  BOX[1].LoadFromResourceName(HInstance, 'GREEN'); 
  BOX[2].LoadFromResourceName(HInstance, 'PURPLE'); 
  BOX[3].LoadFromResourceName(HInstance, 'RED'); 
  BOX[4].LoadFromResourceName(HInstance, 'AQUA'); 
  BOX[5].LoadFromResourceName(HInstance, 'BLUE'); 
  BOX[6].LoadFromResourceName(HInstance, 'ORANGE'); 
  BOX[7].LoadFromResourceName(HInstance, 'YELLOW'); 
  EBOX[0].LoadFromResourceName(HInstance, 'BLACK'); 
  EBOX[1].LoadFromResourceName(HInstance, 'GREEN'); 
  EBOX[2].LoadFromResourceName(HInstance, 'PURPLE'); 
  EBOX[3].LoadFromResourceName(HInstance, 'RED'); 
  EBOX[4].LoadFromResourceName(HInstance, 'AQUA'); 
  EBOX[5].LoadFromResourceName(HInstance, 'BLUE'); 
  EBOX[6].LoadFromResourceName(HInstance, 'ORANGE'); 
  EBOX[7].LoadFromResourceName(HInstance, 'YELLOW'); 
  FillChar(BG, 200, #0); 
  FillChar(FG, 200, #0); 
  FillChar(EBG, 200, #0); 
  FillChar(EFG, 200, #0); 
  sNext := Random(7); 
  sObj := Random(7); 
  Obj := TCustObj.Create(sObj); 
  frmMain.Caption := 'TETRIS ' + playerme.username; 
  Timer1.Enabled := False; 
  Timer2.Enabled := False; 
  self.DoubleBuffered := True; 
  Init; 
  EnemyInit; 
end; 
 
procedure TfrmMain.NextDraw; 
  procedure Drawbox(x, y: integer); overload; 
  begin 
    ScrNext.Canvas.CopyRect(Rect((x - 1) * 17 + 10, (y - 1) * 17 + 10, x * 17 + 10, y * 17 + 10), BOX[sNext + 1].Canvas, Rect(0, 0, 16, 16)); 
  end; 
  procedure Drawbox(sx, sy, x, y: integer); overload; 
  begin 
    ScrNext.Canvas.CopyRect(Rect((x - 1) * 17 + sx, (y - 1) * 17 + sy, x * 17 + sx, y * 17 + sy), BOX[sNext + 1].Canvas, Rect(0, 0, 16, 16)); 
  end; 
begin 
  ScrNext.Canvas.Brush.Bitmap := BOX[0]; 
  ScrNext.Canvas.FillRect(Rect(0, 0, 170, 340)); 
  if not Timer1.Enabled then exit; 
  case sNext of 
    0: begin 
        Drawbox(1, 18, 1, 1); 
        Drawbox(1, 18, 2, 1); 
        Drawbox(1, 18, 3, 1); 
        Drawbox(1, 18, 4, 1); 
      end; 
    1: begin 
        Drawbox(18, 10, 1, 1); 
        Drawbox(18, 10, 2, 1); 
        Drawbox(18, 10, 1, 2); 
        Drawbox(18, 10, 2, 2); 
      end; 
    2: begin 
        Drawbox(2, 1); 
        Drawbox(1, 2); 
        Drawbox(2, 2); 
        Drawbox(3, 2); 
      end; 
    3: begin 
        Drawbox(1, 1); 
        Drawbox(1, 2); 
        Drawbox(2, 1); 
        Drawbox(3, 1); 
      end; 
    4: begin 
        Drawbox(1, 1); 
        Drawbox(2, 1); 
        Drawbox(3, 1); 
        Drawbox(3, 2); 
      end; 
    5: begin 
        Drawbox(1, 1); 
        Drawbox(2, 1); 
        Drawbox(2, 2); 
        Drawbox(3, 2); 
      end; 
    6: begin 
        Drawbox(1, 2); 
        Drawbox(2, 2); 
        Drawbox(2, 1); 
        Drawbox(3, 1); 
      end; 
  end; 
end; 
 
procedure TfrmMain.ScrDraw; 
var 
  i, j: integer; 
begin 
  mCanvas := Tbitmap.Create; 
  mCanvas.Width := 200; 
  mCanvas.Height := 400; 
  with mCanvas.Canvas do 
  begin 
    mCanvas.Canvas.Brush.Bitmap := BOX[0]; 
    mCanvas.Canvas.FillRect(Rect(0, 0, 170, 340)); 
    for i := 0 to 9 do 
    begin 
      for j := 0 to 19 do 
      begin 
        if (FG[i, j] <> 0) then 
          mCanvas.Canvas.CopyRect(Rect(i * 17, j * 17, (i + 1) * 17, (j + 1) * 17), BOX[FG[i, j]].Canvas, Rect(0, 0, 16, 16)); 
        if (BG[i, j] <> 0) then 
          mCanvas.Canvas.CopyRect(Rect(i * 17, j * 17, (i + 1) * 17, (j + 1) * 17), BOX[BG[i, j]].Canvas, Rect(0, 0, 16, 16)); 
      end; 
    end; 
  end; 
  PaintBox1.Canvas.CopyRect(Rect(0, 0, 170, 340), mCanvas.Canvas, Rect(0, 0, 170, 340)); 
  mCanvas.Free; 
end; 
 
procedure TfrmMain.SendDraw; 
var 
  ctext: Rcommandtext; 
begin 
  try 
  playerenemy.Rbg := BG; 
  playerenemy.Rfg := FG; 
  ctext.command := Cdraw; 
  IdTCPClient1.WriteBuffer(ctext, sizeof(ctext)); 
  IdTCPClient1.WriteBuffer(self.playerenemy, sizeof(self.playerenemy)); 
  except 
    on e: exception do 
    begin 
      showmessage('无法连接' + playerenemy.username + '，请稍后重试！'); 
      self.Width := 280; 
      Init; 
      EnemyInit; 
      Timer1.Enabled := False; 
      Timer2.Enabled := False; 
      mnuStart.Enabled := True; 
      mnuPause.Enabled := False; 
      mnuCancel.Enabled := False; 
      exit; 
    end; 
  end; 
end; 
 
procedure TfrmMain.Timer1Timer(Sender: TObject); 
var 
  i: integer; 
  ctext: Rcommandtext; 
begin 
  try 
    if not Obj.Drop then 
    begin 
      Score := Score + 4; 
      i := Obj.ClearLine; 
      if i > 0 then 
        Score := Score + (i - 1) * 20 + i * 40; 
      lines := lines + i; 
      Speed := lines div 30; 
      Timer1.Interval := 1000 div (Speed + 1); 
      stScore.Caption := IntToStr(Score); 
      stLines.Caption := IntToStr(lines); 
      stSpeed.Caption := IntToStr(Speed); 
      Obj.free; 
      FillChar(FG, 200, #0); 
      Obj := TCustObj.Create(sNext); 
      sObj := sNext; 
      sNext := Random(7); 
      NextDraw; 
      if Obj.IsOver then 
      begin 
        Timer1.Enabled := False; 
        Timer2.Enabled := False; 
        if self.Width = 487 then 
        begin 
          ctext.command := Cover; 
          IdTCPClient1.WriteBuffer(ctext, sizeof(ctext)); 
          IdTCPClient1.WriteBuffer(self.playerenemy, sizeof(self.playerenemy)); 
        end; 
        showmessage('Game Over You Lose!'); 
        EnemyInit; 
        Init;      
        mnuStart.Enabled := True; 
        mnuPause.Enabled := False; 
        mnuCancel.Enabled := False; 
        exit; 
      end; 
    end; 
 
    ScrDraw; 
    if self.Width = 487 then 
      SendDraw; 
    NextDraw; 
 
    stDuring.Caption := TimeToStr(Now - STime); 
  except 
    on e: exception do 
    begin 
      showmessage('无法连接' + playerenemy.username + '，请稍后重试！'); 
      self.Width := 280; 
      Init; 
      EnemyInit; 
      Timer1.Enabled := False; 
      Timer2.Enabled := False; 
      mnuStart.Enabled := True; 
      mnuPause.Enabled := False; 
      mnuCancel.Enabled := False; 
      exit; 
    end; 
  end; 
 
end; 
 
procedure TfrmMain.FormPaint(Sender: TObject); 
begin 
  ScrDraw; 
  NextDraw; 
end; 
 
procedure TfrmMain.mnuStartClick(Sender: TObject); 
var 
  ctext: Rcommandtext; 
begin 
  mnuPause.Enabled := True; 
  mnuCancel.Enabled := True; 
  STime := Now; 
  mnuStart.Enabled := False; 
  Init; 
  if self.Width = 487 then 
  begin 
    try 
      ctext.command := Cenemystart; 
      playerenemy.Rbg := BG; 
      playerenemy.Rfg := FG; 
      IdTCPClient1.WriteBuffer(ctext, sizeof(ctext)); 
      IdTCPClient1.WriteBuffer(self.playerenemy, sizeof(self.playerenemy)); 
    except 
      on e: exception do 
      begin 
        showmessage('无法连接' + playerenemy.username + '，请稍后重试！'); 
        self.Width := 280; 
        Init; 
        EnemyInit; 
        Timer1.Enabled := False; 
        Timer2.Enabled := False; 
        mnuStart.Enabled := True; 
        mnuPause.Enabled := False; 
        mnuCancel.Enabled := False; 
        exit; 
      end; 
    end; 
  end; 
  Timer1.Enabled := True; 
  Timer2.Enabled := True; 
end; 
 
procedure TfrmMain.mnuPauseClick(Sender: TObject); 
begin 
  Timer1.Enabled := not Timer1.Enabled; 
  if not Timer1.Enabled then 
    lblStatus.Caption := 'Paused' 
  else 
    lblStatus.Caption := ''; 
end; 
 
procedure TfrmMain.mnuExitClick; 
var 
  ctext: Rcommandtext; 
begin 
  try 
    if self.Width = 487 then 
    begin 
      ctext.command := Clogout; 
      IdTCPClient1.WriteBuffer(ctext, sizeof(ctext)); 
      IdTCPClient1.WriteBuffer(self.playerenemy, sizeof(self.playerenemy)); 
      self.Width := 280; 
      EnemyInit; 
    end; 
    self.Visible := False; 
    Timer1.Enabled := False; 
    Timer2.Enabled := False; 
    Init; 
    mnuStart.Enabled := True; 
    mnuPause.Enabled := False; 
    mnuCancel.Enabled := False; 
  except 
    on e: exception do 
    begin 
      showmessage('无法连接' + playerenemy.username + '，请稍后重试！'); 
      self.Width := 280; 
      Init; 
      EnemyInit; 
      Timer1.Enabled := False; 
      Timer2.Enabled := False; 
      mnuStart.Enabled := True; 
      mnuPause.Enabled := False; 
      mnuCancel.Enabled := False; 
      exit; 
    end; 
  end; 
end; 
 
procedure TfrmMain.mnuCancelClick(Sender: TObject); 
var 
  ctext: Rcommandtext; 
begin 
  Timer1.Enabled := False; 
  Timer2.Enabled := False; 
  if Application.MessageBox('Do you sure to cancel the current game?', 'Question', MB_ICONQUESTION + MB_YESNO) = IDYES then 
  begin 
    Init; 
    mnuStart.Enabled := True; 
    mnuPause.Enabled := False; 
    mnuCancel.Enabled := False; 
    if self.Width = 487 then 
    begin 
      try 
        EnemyInit; 
        ctext.command := Cmodiwhatdoing; 
        ctext.num := 1; 
        IdTCPClient1.WriteBuffer(ctext, sizeof(ctext)); 
        IdTCPClient1.WriteBuffer(self.playerme, sizeof(self.playerme)); 
        ctext.command := Clogout; 
        IdTCPClient1.WriteBuffer(ctext, sizeof(ctext)); 
        IdTCPClient1.WriteBuffer(self.playerenemy, sizeof(self.playerenemy)); 
        self.Width := 280; 
      except 
        on e: exception do 
        begin 
          showmessage('无法连接' + playerenemy.username + '，请稍后重试！'); 
          self.Width := 280; 
          Init; 
          EnemyInit; 
          Timer1.Enabled := False; 
          Timer2.Enabled := False; 
          mnuStart.Enabled := True; 
          mnuPause.Enabled := False; 
          mnuCancel.Enabled := False; 
          exit; 
        end; 
      end; 
    end; 
  end 
  else 
  begin 
    Timer1.Enabled := True; 
    Timer2.Enabled := True; 
  end; 
end; 
 
procedure TfrmMain.Init; 
begin 
  FillChar(BG, 200, #0); 
  FillChar(FG, 200, #0); 
  ScrDraw; 
  if self.Width = 487 then 
    SendDraw; 
  NextDraw; 
  Score := 0; 
  lines := 0; 
  Speed := 0; 
  lblStatus.Caption := ''; 
  stScore.Caption := '0'; 
  stLines.Caption := '0'; 
  stSpeed.Caption := '0'; 
  stDuring.Caption := '0:00:00'; 
end; 
 
procedure TfrmMain.Timer2Timer(Sender: TObject); 
begin 
  ScrDraw; 
  if self.Width = 487 then 
    SendDraw; 
  NextDraw; 
end; 
 
end.