Develop and Download Open Source Software

Browse Subversion Repository

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 4 by yamat0jp, Fri Jul 10 23:55:37 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 115  type Line 114  type
114      property OnCreateOjama: TOjamaEvent read FOnCreateOjama      property OnCreateOjama: TOjamaEvent read FOnCreateOjama
115        write FOnCreateOjama;        write FOnCreateOjama;
116      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;  
117    end;    end;
118    
119    TForm1 = class(TForm)    TForm1 = class(TForm)
# Line 147  type Line 143  type
143      { Public 宣言 }      { Public 宣言 }
144      Player1, Player2: TPlayer;      Player1, Player2: TPlayer;
145      Rensa: TThread;      Rensa: TThread;
146      procedure CreateOjama(Sender: TObject; aCount: integer);      procedure CreateOjama(Sender: TObject; aCount: integer; const Text: string);
147      procedure PlayerScore(Sender: TObject; const GameParam: TGameParam;      procedure PlayerScore(Sender: TObject; const GameParam: TGameParam;
148        var Score: integer);        var Score: integer);
     procedure PlayerMessage(Sender: TObject);  
149    end;    end;
150    
151  var  var
# Line 339  begin Line 334  begin
334        Player1.State := Stop;        Player1.State := Stop;
335      end;      end;
336      Player1.Execute;      Player1.Execute;
337      Paint;      FormPaint(Player1);
338      Done := false;      Done := false;
339    end    end
340    else if Player2.State <> Stop then    else if Player2.State <> Stop then
# Line 354  begin Line 349  begin
349    Close;    Close;
350  end;  end;
351    
352  procedure TForm1.CreateOjama(Sender: TObject; aCount: integer);  procedure TForm1.CreateOjama(Sender: TObject; aCount: integer;
353      const Text: string);
354  begin  begin
355    if Sender = Player1 then    if Sender = Player1 then
356      Player2.Make(aCount)      if aCount = 0 then
357          TextMessage := 'Player2 WIN !!'
358        else
359          Player2.Make(aCount)
360      else if aCount = 0 then
361        TextMessage := 'Player1 WIN !!'
362    else    else
363      Player1.Make(aCount);      Player1.Make(aCount);
364      if aCount > 0 then
365        TextMessage := Text;
366      Buffer.Canvas.Font.Color := (Sender as TPlayer).TextColor;
367      Limit := Time + 1 / (24 * 60 * 60);
368      Paint;
369  end;  end;
370    
371  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
# Line 372  begin Line 378  begin
378    Player2.OnCreateOjama := CreateOjama;    Player2.OnCreateOjama := CreateOjama;
379    Player1.OnScore := PlayerScore;    Player1.OnScore := PlayerScore;
380    Player2.OnScore := PlayerScore;    Player2.OnScore := PlayerScore;
   Player1.OnTextMessage := PlayerMessage;  
   Player2.OnTextMessage := PlayerMessage;  
381    Player1.Name := 'Player1';    Player1.Name := 'Player1';
382    Player2.Name := 'Player2';    Player2.Name := 'Player2';
383    Rensa := TRensa.Create;    Rensa := TRensa.Create;
# Line 431  procedure TForm1.FormPaint(Sender: TObje Line 435  procedure TForm1.FormPaint(Sender: TObje
435  var  var
436    i: integer;    i: integer;
437    s: TGround;    s: TGround;
438      t: TPlayer;
439    
440    procedure GroundDraw;    procedure GroundDraw;
441    var    var
# Line 510  begin Line 515  begin
515    Buffer.Canvas.FillRect(Rect(Player1.Ground.Left + Wid * Size, 0,    Buffer.Canvas.FillRect(Rect(Player1.Ground.Left + Wid * Size, 0,
516      Player2.Ground.Left, Hei * Size));      Player2.Ground.Left, Hei * Size));
517    Buffer.Canvas.Brush.Color := clWhite;    Buffer.Canvas.Brush.Color := clWhite;
518    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  
519    begin    begin
520      s := Player1.Ground;      t:=Sender as TPlayer;
521        s := t.Ground;
522      Main;      Main;
523      ItemDraw(Player1.Item);      ItemDraw(t.Item);
524      OjamaDraw(Player1);      OjamaDraw(t);
525    end    end
526    else    else
527    begin    begin
# Line 544  begin Line 543  begin
543      if Time > Limit then      if Time > Limit then
544      begin      begin
545        Limit := 0;        Limit := 0;
546        FormPaint(Sender);        Paint;
547      end;      end;
548    end;    end;
549    Canvas.Draw(100, 50, Buffer);    Canvas.Draw(100, 50, Buffer);
# Line 557  begin Line 556  begin
556    Start1Click(Sender);    Start1Click(Sender);
557  end;  end;
558    
 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;  
   
559  procedure TForm1.PlayerScore(Sender: TObject; const GameParam: TGameParam;  procedure TForm1.PlayerScore(Sender: TObject; const GameParam: TGameParam;
560    var Score: integer);    var Score: integer);
561  begin  begin
# Line 856  begin Line 837  begin
837      if Assigned(FOnScoreEvent) = true then      if Assigned(FOnScoreEvent) = true then
838        FOnScoreEvent(Self, GameParam, Score);        FOnScoreEvent(Self, GameParam, Score);
839    end;    end;
   if GameParam.Rensa >= 2 then  
     Text := Name + Format(' %d 連鎖', [GameParam.Rensa]);  
840  end;  end;
841    
842  function TPlayer.Drop: Boolean;  function TPlayer.Drop: Boolean;
# Line 944  begin Line 923  begin
923        begin        begin
924          State := Ojama;          State := Ojama;
925          if Assigned(FOnCreateOjama) = true then          if Assigned(FOnCreateOjama) = true then
926            FOnCreateOjama(Self, GameParam.Rensa - 1);            if Zenkesi = true then
927          if (Zenkesi = true) and (Assigned(FOnCreateOjama) = true) then              FOnCreateOjama(Self, 2 * Wid, '**全消し**')
928            FOnCreateOjama(Self, 2 * Wid);            else if GameParam.Rensa > 1 then
929                FOnCreateOjama(Self, GameParam.Rensa - 1,
930                  Name + Format(' %d 連鎖', [GameParam.Rensa]));
931        end;        end;
932      Effect:      Effect:
933        begin        begin
# Line 1001  begin Line 982  begin
982    end;    end;
983  end;  end;
984    
 procedure TPlayer.SetText(const Value: string);  
 begin  
   FText := Value;  
   if Assigned(FOnTextMessage) = true then  
     FOnTextMessage(Self);  
 end;  
   
985  procedure TPlayer.Start(const Resume: Boolean);  procedure TPlayer.Start(const Resume: Boolean);
986  begin  begin
987    OjamaClean;    OjamaClean;
# Line 1022  begin Line 996  begin
996    if Check(Item) = false then    if Check(Item) = false then
997    begin    begin
998      State := TState.Stop;      State := TState.Stop;
999      Text := Name + 'Game Over';      if Assigned(FOnCreateOjama) = true then
1000          FOnCreateOjama(Self, 0, 'Game Over');
1001    end    end
1002    else    else
1003    begin    begin

Legend:
Removed from v.3  
changed lines
  Added in v.4

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26