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 3 by yamat0jp, Fri Jul 10 14:24:01 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 84  type Line 85  type
85      BackGround: Boolean;      BackGround: Boolean;
86      FOnScoreEvent: TScoreEvent;      FOnScoreEvent: TScoreEvent;
87      FOnTextMessage: TNotifyEvent;      FOnTextMessage: TNotifyEvent;
     FText: string;  
88      function Check(aItem: TItem): Boolean;      function Check(aItem: TItem): Boolean;
     procedure SetText(const Value: string);  
89    public    public
90      Temp: TItem;      Temp: TItem;
91      Item: TItem;      Item: TItem;
# Line 100  type Line 99  type
99      GameParam: TGameParam;      GameParam: TGameParam;
100      TextColor: TColor;      TextColor: TColor;
101      Name: string;      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 115  type Line 115  type
115      property OnCreateOjama: TOjamaEvent read FOnCreateOjama      property OnCreateOjama: TOjamaEvent read FOnCreateOjama
116        write FOnCreateOjama;        write FOnCreateOjama;
117      property OnScore: TScoreEvent read FOnScoreEvent write FOnScoreEvent;      property OnScore: TScoreEvent read FOnScoreEvent write FOnScoreEvent;
     property Text: string read FText write SetText;  
     property OnTextMessage: TNotifyEvent read FOnTextMessage  
       write FOnTextMessage;  
118    end;    end;
119    
120    TForm1 = class(TForm)    TForm1 = class(TForm)
# Line 147  type Line 144  type
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);
     procedure PlayerMessage(Sender: TObject);  
150    end;    end;
151    
152  var  var
# Line 339  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 354  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 372  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;
   Player1.OnTextMessage := PlayerMessage;  
   Player2.OnTextMessage := PlayerMessage;  
386    Player1.Name := 'Player1';    Player1.Name := 'Player1';
387    Player2.Name := 'Player2';    Player2.Name := 'Player2';
388    Rensa := TRensa.Create;    Rensa := TRensa.Create;
# Line 431  procedure TForm1.FormPaint(Sender: TObje Line 440  procedure TForm1.FormPaint(Sender: TObje
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 510  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
   begin  
     s := Player2.Ground;  
     Main;  
     ItemDraw(Player2.Item);  
     OjamaDraw(Player2);  
   end  
   else if Sender = Player2 then  
524    begin    begin
525      s := Player1.Ground;      t:=Sender as TPlayer;
526        s := t.Ground;
527      Main;      Main;
528      ItemDraw(Player1.Item);      ItemDraw(t.Item);
529      OjamaDraw(Player1);      OjamaDraw(t);
530    end    end
531    else    else
532    begin    begin
# Line 544  begin Line 548  begin
548      if Time > Limit then      if Time > Limit then
549      begin      begin
550        Limit := 0;        Limit := 0;
551        FormPaint(Sender);        Paint;
552      end;      end;
553    end;    end;
554    Canvas.Draw(100, 50, Buffer);    Canvas.Draw(100, 50, Buffer);
# Line 557  begin Line 561  begin
561    Start1Click(Sender);    Start1Click(Sender);
562  end;  end;
563    
 procedure TForm1.PlayerMessage(Sender: TObject);  
 var  
   s: TPlayer;  
 begin  
   s := Sender as TPlayer;  
   if s.State = Stop then  
   begin  
     if s = Player1 then  
       TextMessage := 'Player2 WIN !!'  
     else  
       TextMessage := 'Player1 WIN !!';  
   end  
   else  
     TextMessage := s.Text;  
   Canvas.Font.Color := s.TextColor;  
   Limit := Time + 1 / (24 * 60 * 60);  
 end;  
   
564  procedure TForm1.PlayerScore(Sender: TObject; const GameParam: TGameParam;  procedure TForm1.PlayerScore(Sender: TObject; const GameParam: TGameParam;
565    var Score: integer);    var Score: integer);
566  begin  begin
# Line 856  begin Line 842  begin
842      if Assigned(FOnScoreEvent) = true then      if Assigned(FOnScoreEvent) = true then
843        FOnScoreEvent(Self, GameParam, Score);        FOnScoreEvent(Self, GameParam, Score);
844    end;    end;
   if GameParam.Rensa >= 2 then  
     Text := Name + Format(' %d 連鎖', [GameParam.Rensa]);  
845  end;  end;
846    
847  function TPlayer.Drop: Boolean;  function TPlayer.Drop: Boolean;
# Line 900  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 914  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            if State <> Down then
909              break;              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 962  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 979  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 996  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;
989    
 procedure TPlayer.SetText(const Value: string);  
 begin  
   FText := Value;  
   if Assigned(FOnTextMessage) = true then  
     FOnTextMessage(Self);  
 end;  
   
990  procedure TPlayer.Start(const Resume: Boolean);  procedure TPlayer.Start(const Resume: Boolean);
991  begin  begin
992    OjamaClean;    OjamaClean;
# Line 1022  begin Line 1001  begin
1001    if Check(Item) = false then    if Check(Item) = false then
1002    begin    begin
1003      State := TState.Stop;      State := TState.Stop;
1004      Text := Name + 'Game Over';      if Assigned(FOnCreateOjama) = true then
1005          FOnCreateOjama(Self, 0, 'Game Over');
1006    end    end
1007    else    else
1008    begin    begin
Legend:
Removed from v.3  
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