Develop and Download Open Source Software

rensa

Browse Subversion Repository

/[rensa]/Unit1.pas

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2 by yamat0jp, Fri Jul 10 10:00:49 2015 UTC revision 5 by yamat0jp, Sun Sep 6 02:21:34 2015 UTC
# Line 66  type Line 66  type
66    
67    TDirector = (Under, Left, Right);    TDirector = (Under, Left, Right);
68    
69    TOjamaEvent = procedure(Sender: TObject; Count: integer) of object;    TOjamaEvent = procedure(Sender: TObject; Count: integer; const Text: string)
70        of object;
71    
72    TGameParam = record    TGameParam = record
73      Rensa: integer;      Rensa: integer;
# Line 83  type Line 84  type
84      FOnCreateOjama: TOjamaEvent;      FOnCreateOjama: TOjamaEvent;
85      BackGround: Boolean;      BackGround: Boolean;
86      FOnScoreEvent: TScoreEvent;      FOnScoreEvent: TScoreEvent;
87        FOnTextMessage: TNotifyEvent;
88      function Check(aItem: TItem): Boolean;      function Check(aItem: TItem): Boolean;
89    public    public
90      Temp: TItem;      Temp: TItem;
# Line 95  type Line 97  type
97      OjamaColor: TColor;      OjamaColor: TColor;
98      EffectCount: integer;      EffectCount: integer;
99      GameParam: TGameParam;      GameParam: TGameParam;
100        TextColor: TColor;
101        Name: string;
102        Sleeps: Boolean;
103      constructor Create;      constructor Create;
104      destructor Destroy; override;      destructor Destroy; override;
105      procedure Start(const Resume: Boolean = false);      procedure Start(const Resume: Boolean = false);
# Line 134  type Line 139  type
139      { Private 宣言 }      { Private 宣言 }
140      Buffer: TBitmap;      Buffer: TBitmap;
141      TextMessage: string;      TextMessage: string;
142        Limit: TTime;
143    public    public
144      { Public 宣言 }      { Public 宣言 }
145      Player1, Player2: TPlayer;      Player1, Player2: TPlayer;
146      Rensa: TThread;      Rensa: TThread;
147      procedure CreateOjama(Sender: TObject; aCount: integer);      procedure CreateOjama(Sender: TObject; aCount: integer; const Text: string);
148      procedure PlayerScore(Sender: TObject; const GameParam: TGameParam;      procedure PlayerScore(Sender: TObject; const GameParam: TGameParam;
149        var Score: integer);        var Score: integer);
150    end;    end;
# Line 329  begin Line 335  begin
335        Player1.State := Stop;        Player1.State := Stop;
336      end;      end;
337      Player1.Execute;      Player1.Execute;
338      Paint;      if Player1.Sleeps = true then
339          Sleep(100)
340        else
341          Player1.Sleeps:=true;
342        FormPaint(Player1);
343      Done := false;      Done := false;
344    end    end
345    else if Player2.State <> Stop then    else if Player2.State <> Stop then
# Line 344  begin Line 354  begin
354    Close;    Close;
355  end;  end;
356    
357  procedure TForm1.CreateOjama(Sender: TObject; aCount: integer);  procedure TForm1.CreateOjama(Sender: TObject; aCount: integer;
358      const Text: string);
359  begin  begin
360    if Sender = Player1 then    if Sender = Player1 then
361      Player2.Make(aCount)      if aCount = 0 then
362          TextMessage := 'Player2 WIN !!'
363        else
364          Player2.Make(aCount)
365      else if aCount = 0 then
366        TextMessage := 'Player1 WIN !!'
367    else    else
368      Player1.Make(aCount);      Player1.Make(aCount);
369      if aCount > 0 then
370        TextMessage := Text;
371      Buffer.Canvas.Font.Color := (Sender as TPlayer).TextColor;
372      Limit := Time + 1 / (24 * 60 * 60);
373      Paint;
374  end;  end;
375    
376  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
# Line 362  begin Line 383  begin
383    Player2.OnCreateOjama := CreateOjama;    Player2.OnCreateOjama := CreateOjama;
384    Player1.OnScore := PlayerScore;    Player1.OnScore := PlayerScore;
385    Player2.OnScore := PlayerScore;    Player2.OnScore := PlayerScore;
386      Player1.Name := 'Player1';
387      Player2.Name := 'Player2';
388    Rensa := TRensa.Create;    Rensa := TRensa.Create;
389    Player1.Com := true; { ComPlay }    Player1.Com := true; { ComPlay }
390    Player11.Checked := Player1.Com;    Player11.Checked := Player1.Com;
# Line 394  begin Line 417  begin
417      Player2.Start(true);      Player2.Start(true);
418      Buffer.Canvas.Brush.Color := Color;      Buffer.Canvas.Brush.Color := Color;
419      Buffer.Canvas.FillRect(Rect(0, 0, Buffer.Width, Buffer.Height));      Buffer.Canvas.FillRect(Rect(0, 0, Buffer.Width, Buffer.Height));
420        Limit := 0;
421      Exit;      Exit;
422    end;    end;
423    if (Player1.State = Shoot) or (Player1.State = Ojama) then    if (Player1.Com = false) and (Player1.State = Down) then
424      Exit;    begin
425    case Key of      case Key of
426      VK_DOWN:        VK_DOWN:
       if Player1.State = Down then  
427          Player1.State := Shoot;          Player1.State := Shoot;
428      VK_UP:        VK_UP:
429        Player1.Turn;          Player1.Turn;
430      VK_LEFT:        VK_LEFT:
431        Player1.Move(TDirector.Left);          Player1.Move(TDirector.Left);
432      VK_RIGHT:        VK_RIGHT:
433        Player1.Move(Right);          Player1.Move(Right);
434        end;
435        Paint;
436    end;    end;
   Paint;  
437  end;  end;
438    
439  procedure TForm1.FormPaint(Sender: TObject);  procedure TForm1.FormPaint(Sender: TObject);
440  var  var
441    i: integer;    i: integer;
442    s: TGround;    s: TGround;
443      t: TPlayer;
444    
445    procedure GroundDraw;    procedure GroundDraw;
446    var    var
# Line 495  begin Line 520  begin
520    Buffer.Canvas.FillRect(Rect(Player1.Ground.Left + Wid * Size, 0,    Buffer.Canvas.FillRect(Rect(Player1.Ground.Left + Wid * Size, 0,
521      Player2.Ground.Left, Hei * Size));      Player2.Ground.Left, Hei * Size));
522    Buffer.Canvas.Brush.Color := clWhite;    Buffer.Canvas.Brush.Color := clWhite;
523    if Sender = nil then    if Sender is TPlayer then
524    begin    begin
525      s := Player2.Ground;      t:=Sender as TPlayer;
526        s := t.Ground;
527      Main;      Main;
528      ItemDraw(Player2.Item);      ItemDraw(t.Item);
529      OjamaDraw(Player2);      OjamaDraw(t);
530    end    end
531    else    else
532    begin    begin
# Line 508  begin Line 534  begin
534      Main;      Main;
535      ItemDraw(Player1.Item);      ItemDraw(Player1.Item);
536      OjamaDraw(Player1);      OjamaDraw(Player1);
537        Buffer.Canvas.Brush.Color := clWhite;
538        s := Player2.Ground;
539        Main;
540        ItemDraw(Player2.Item);
541        OjamaDraw(Player2);
542    end;    end;
543    if (Player1.State = Stop) and (Player2.State = Stop) then    if Limit > 0 then
544    begin    begin
545      i := (Buffer.Width - Buffer.Canvas.TextWidth(TextMessage)) div 2;      i := (Buffer.Width - Buffer.Canvas.TextWidth(TextMessage)) div 2;
546      Buffer.Canvas.Brush.Color := Color;      Buffer.Canvas.Brush.Color := Color;
547      Buffer.Canvas.TextOut(i, 0, TextMessage);      Buffer.Canvas.TextOut(i, 0, TextMessage);
548        if Time > Limit then
549        begin
550          Limit := 0;
551          Paint;
552        end;
553    end;    end;
554    Canvas.Draw(100, 50, Buffer);    Canvas.Draw(100, 50, Buffer);
555  end;  end;
# Line 529  procedure TForm1.PlayerScore(Sender: TOb Line 565  procedure TForm1.PlayerScore(Sender: TOb
565    var Score: integer);    var Score: integer);
566  begin  begin
567    with GameParam do    with GameParam do
568      Score:=Rensa*Rensa*10+Group*Group*15;      Score := Rensa * Rensa * 10 + Group * Group * 15;
569  end;  end;
570    
571  procedure TForm1.Start1Click(Sender: TObject);  procedure TForm1.Start1Click(Sender: TObject);
# Line 848  procedure TPlayer.Execute; Line 884  procedure TPlayer.Execute;
884  var  var
885    i, j: integer;    i, j: integer;
886    s: TBall;    s: TBall;
   
887  begin  begin
888    case State of    case State of
889      Down:      Down:
# Line 862  begin Line 897  begin
897            Item.Left := Item.Left + 1            Item.Left := Item.Left + 1
898          else          else
899            Item.Left := Item.Left - 1;            Item.Left := Item.Left - 1;
         Sleep(100);  
900        end        end
901        else        else
902        begin        begin
903          Move(Under);          Move(Under);
904          for i := 1 to 100 do          for i := 1 to 10 do
905          begin          begin
906            Sleep(3);            Sleep(30);
907            Application.ProcessMessages;            Application.ProcessMessages;
908              if State <> Down then
909                break;
910          end;          end;
911            Sleeps:=false;
912        end;        end;
913      Shoot:      Shoot:
       begin  
914          Move(Under);          Move(Under);
         Sleep(100);  
       end;  
915      Sys:      Sys:
916        if Drop = true then        if Drop = false then
         Sleep(100)  
       else if Remove = true then  
       begin  
         State := Effect;  
         EffectCount := 1;  
       end  
       else  
917        begin        begin
918          State := Ojama;          Sleeps:=false;
919          if Assigned(FOnCreateOjama) = true then          if Remove = true then
920            FOnCreateOjama(Self, GameParam.Rensa - 1);          begin
921          if (Zenkesi = true) and (Assigned(FOnCreateOjama) = true) then            State := Effect;
922            FOnCreateOjama(Self, 2 * Wid);            EffectCount := 1;
923            end
924            else
925            begin
926              State := Ojama;
927              if Assigned(FOnCreateOjama) = true then
928                if Zenkesi = true then
929                  FOnCreateOjama(Self, 2 * Wid, '**全消し**')
930                else if GameParam.Rensa > 1 then
931                  FOnCreateOjama(Self, GameParam.Rensa - 1,
932                    Name + Format(' %d 連鎖', [GameParam.Rensa]));
933            end;
934        end;        end;
935      Effect:      Effect:
936        begin        begin
# Line 908  begin Line 946  begin
946                    Ground[i, j].Index := 0;                    Ground[i, j].Index := 0;
947                  end;                  end;
948          end;          end;
         Sleep(100);  
949          dec(EffectCount);          dec(EffectCount);
950        end;        end;
951      Ojama:      Ojama:
952        if OjamaList.Count = 0 then        if OjamaList.Count = 0 then
953          Start        begin
954            Start;
955            Sleeps:=false;
956          end
957        else        else
958        begin        begin
959          for i := 0 to OjamaList.Count - 1 do          for i := 0 to OjamaList.Count - 1 do
# Line 925  begin Line 965  begin
965            else if (s.Y = 0) and (Ground[s.X, 0].Color <> clWhite) then            else if (s.Y = 0) and (Ground[s.X, 0].Color <> clWhite) then
966            begin            begin
967              State := Stop;              State := Stop;
968                Sleeps:=false;
969              Exit;              Exit;
970            end            end
971            else            else
# Line 942  begin Line 983  begin
983              OjamaList.Delete(i);              OjamaList.Delete(i);
984            end;            end;
985          end;          end;
         Sleep(100);  
986        end;        end;
987    end;    end;
988  end;  end;
# Line 959  begin Line 999  begin
999    Item.Assign(Temp);    Item.Assign(Temp);
1000    Item.Visible := true;    Item.Visible := true;
1001    if Check(Item) = false then    if Check(Item) = false then
1002      State := TState.Stop    begin
1003        State := TState.Stop;
1004        if Assigned(FOnCreateOjama) = true then
1005          FOnCreateOjama(Self, 0, 'Game Over');
1006      end
1007    else    else
1008    begin    begin
1009      if Com = true then      if Com = true then
Legend:
Removed from v.2  
changed lines
  Added in v.5
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help