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 3 by yamat0jp, Fri Jul 10 14:24:01 2015 UTC
# Line 83  type Line 83  type
83      FOnCreateOjama: TOjamaEvent;      FOnCreateOjama: TOjamaEvent;
84      BackGround: Boolean;      BackGround: Boolean;
85      FOnScoreEvent: TScoreEvent;      FOnScoreEvent: TScoreEvent;
86        FOnTextMessage: TNotifyEvent;
87        FText: string;
88      function Check(aItem: TItem): Boolean;      function Check(aItem: TItem): Boolean;
89        procedure SetText(const Value: string);
90    public    public
91      Temp: TItem;      Temp: TItem;
92      Item: TItem;      Item: TItem;
# Line 95  type Line 98  type
98      OjamaColor: TColor;      OjamaColor: TColor;
99      EffectCount: integer;      EffectCount: integer;
100      GameParam: TGameParam;      GameParam: TGameParam;
101        TextColor: TColor;
102        Name: string;
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 110  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;
118        property Text: string read FText write SetText;
119        property OnTextMessage: TNotifyEvent read FOnTextMessage
120          write FOnTextMessage;
121    end;    end;
122    
123    TForm1 = class(TForm)    TForm1 = class(TForm)
# Line 134  type Line 142  type
142      { Private 宣言 }      { Private 宣言 }
143      Buffer: TBitmap;      Buffer: TBitmap;
144      TextMessage: string;      TextMessage: string;
145        Limit: TTime;
146    public    public
147      { Public 宣言 }      { Public 宣言 }
148      Player1, Player2: TPlayer;      Player1, Player2: TPlayer;
# Line 141  type Line 150  type
150      procedure CreateOjama(Sender: TObject; aCount: integer);      procedure CreateOjama(Sender: TObject; aCount: integer);
151      procedure PlayerScore(Sender: TObject; const GameParam: TGameParam;      procedure PlayerScore(Sender: TObject; const GameParam: TGameParam;
152        var Score: integer);        var Score: integer);
153        procedure PlayerMessage(Sender: TObject);
154    end;    end;
155    
156  var  var
# Line 362  begin Line 372  begin
372    Player2.OnCreateOjama := CreateOjama;    Player2.OnCreateOjama := CreateOjama;
373    Player1.OnScore := PlayerScore;    Player1.OnScore := PlayerScore;
374    Player2.OnScore := PlayerScore;    Player2.OnScore := PlayerScore;
375      Player1.OnTextMessage := PlayerMessage;
376      Player2.OnTextMessage := PlayerMessage;
377      Player1.Name := 'Player1';
378      Player2.Name := 'Player2';
379    Rensa := TRensa.Create;    Rensa := TRensa.Create;
380    Player1.Com := true; { ComPlay }    Player1.Com := true; { ComPlay }
381    Player11.Checked := Player1.Com;    Player11.Checked := Player1.Com;
# Line 394  begin Line 408  begin
408      Player2.Start(true);      Player2.Start(true);
409      Buffer.Canvas.Brush.Color := Color;      Buffer.Canvas.Brush.Color := Color;
410      Buffer.Canvas.FillRect(Rect(0, 0, Buffer.Width, Buffer.Height));      Buffer.Canvas.FillRect(Rect(0, 0, Buffer.Width, Buffer.Height));
411        Limit := 0;
412      Exit;      Exit;
413    end;    end;
414    if (Player1.State = Shoot) or (Player1.State = Ojama) then    if (Player1.Com = false) and (Player1.State = Down) then
415      Exit;    begin
416    case Key of      case Key of
417      VK_DOWN:        VK_DOWN:
       if Player1.State = Down then  
418          Player1.State := Shoot;          Player1.State := Shoot;
419      VK_UP:        VK_UP:
420        Player1.Turn;          Player1.Turn;
421      VK_LEFT:        VK_LEFT:
422        Player1.Move(TDirector.Left);          Player1.Move(TDirector.Left);
423      VK_RIGHT:        VK_RIGHT:
424        Player1.Move(Right);          Player1.Move(Right);
425        end;
426        Paint;
427    end;    end;
   Paint;  
428  end;  end;
429    
430  procedure TForm1.FormPaint(Sender: TObject);  procedure TForm1.FormPaint(Sender: TObject);
# Line 502  begin Line 517  begin
517      ItemDraw(Player2.Item);      ItemDraw(Player2.Item);
518      OjamaDraw(Player2);      OjamaDraw(Player2);
519    end    end
520      else if Sender = Player2 then
521      begin
522        s := Player1.Ground;
523        Main;
524        ItemDraw(Player1.Item);
525        OjamaDraw(Player1);
526      end
527    else    else
528    begin    begin
529      s := Player1.Ground;      s := Player1.Ground;
530      Main;      Main;
531      ItemDraw(Player1.Item);      ItemDraw(Player1.Item);
532      OjamaDraw(Player1);      OjamaDraw(Player1);
533        Buffer.Canvas.Brush.Color := clWhite;
534        s := Player2.Ground;
535        Main;
536        ItemDraw(Player2.Item);
537        OjamaDraw(Player2);
538    end;    end;
539    if (Player1.State = Stop) and (Player2.State = Stop) then    if Limit > 0 then
540    begin    begin
541      i := (Buffer.Width - Buffer.Canvas.TextWidth(TextMessage)) div 2;      i := (Buffer.Width - Buffer.Canvas.TextWidth(TextMessage)) div 2;
542      Buffer.Canvas.Brush.Color := Color;      Buffer.Canvas.Brush.Color := Color;
543      Buffer.Canvas.TextOut(i, 0, TextMessage);      Buffer.Canvas.TextOut(i, 0, TextMessage);
544        if Time > Limit then
545        begin
546          Limit := 0;
547          FormPaint(Sender);
548        end;
549    end;    end;
550    Canvas.Draw(100, 50, Buffer);    Canvas.Draw(100, 50, Buffer);
551  end;  end;
# Line 525  begin Line 557  begin
557    Start1Click(Sender);    Start1Click(Sender);
558  end;  end;
559    
560    procedure TForm1.PlayerMessage(Sender: TObject);
561    var
562      s: TPlayer;
563    begin
564      s := Sender as TPlayer;
565      if s.State = Stop then
566      begin
567        if s = Player1 then
568          TextMessage := 'Player2 WIN !!'
569        else
570          TextMessage := 'Player1 WIN !!';
571      end
572      else
573        TextMessage := s.Text;
574      Canvas.Font.Color := s.TextColor;
575      Limit := Time + 1 / (24 * 60 * 60);
576    end;
577    
578  procedure TForm1.PlayerScore(Sender: TObject; const GameParam: TGameParam;  procedure TForm1.PlayerScore(Sender: TObject; const GameParam: TGameParam;
579    var Score: integer);    var Score: integer);
580  begin  begin
581    with GameParam do    with GameParam do
582      Score:=Rensa*Rensa*10+Group*Group*15;      Score := Rensa * Rensa * 10 + Group * Group * 15;
583  end;  end;
584    
585  procedure TForm1.Start1Click(Sender: TObject);  procedure TForm1.Start1Click(Sender: TObject);
# Line 806  begin Line 856  begin
856      if Assigned(FOnScoreEvent) = true then      if Assigned(FOnScoreEvent) = true then
857        FOnScoreEvent(Self, GameParam, Score);        FOnScoreEvent(Self, GameParam, Score);
858    end;    end;
859      if GameParam.Rensa >= 2 then
860        Text := Name + Format(' %d 連鎖', [GameParam.Rensa]);
861  end;  end;
862    
863  function TPlayer.Drop: Boolean;  function TPlayer.Drop: Boolean;
# Line 871  begin Line 923  begin
923          begin          begin
924            Sleep(3);            Sleep(3);
925            Application.ProcessMessages;            Application.ProcessMessages;
926              if State <> Down then
927                break;
928          end;          end;
929        end;        end;
930      Shoot:      Shoot:
# Line 947  begin Line 1001  begin
1001    end;    end;
1002  end;  end;
1003    
1004    procedure TPlayer.SetText(const Value: string);
1005    begin
1006      FText := Value;
1007      if Assigned(FOnTextMessage) = true then
1008        FOnTextMessage(Self);
1009    end;
1010    
1011  procedure TPlayer.Start(const Resume: Boolean);  procedure TPlayer.Start(const Resume: Boolean);
1012  begin  begin
1013    OjamaClean;    OjamaClean;
# Line 959  begin Line 1020  begin
1020    Item.Assign(Temp);    Item.Assign(Temp);
1021    Item.Visible := true;    Item.Visible := true;
1022    if Check(Item) = false then    if Check(Item) = false then
1023      State := TState.Stop    begin
1024        State := TState.Stop;
1025        Text := Name + 'Game Over';
1026      end
1027    else    else
1028    begin    begin
1029      if Com = true then      if Com = true then
Legend:
Removed from v.2  
changed lines
  Added in v.3
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help