1  unit SimonU;
   2   
   3  interface
   4   
   5  uses
   6    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   7    Dialogs,TrumpU, ExtCtrls, StdCtrls;
   8   
   9  type
  10    TCol       = 1..10;
  11    TRow       = 0..52;
  12    TColAndRow = record
  13                   Col: TCol;
  14                   Row: TRow;
  15                 end;
  16    TTable     = array [TCol,TRow] of TCardNo;
  17    TMaisuu    = array [TCol] of TRow;
  18    TBasyo     = array [TCardNo] of TColAndRow;
  19    TFormSimon = class(TForm)
  20      TimerSakusei: TTimer;
  21      PanelMain: TPanel;
  22      ButtonClose: TButton;
  23      ImageTable: TImage;
  24      ButtonStart: TButton;
  25      ButtonNew: TButton;
  26      Button: TButton;
  27      procedure TimerSakuseiTimer(Sender: TObject);
  28      procedure ButtonCloseClick(Sender: TObject);
  29      procedure CardMouseDown(Sender: TObject; Button: TMouseButton;
  30                Shift: TShiftState; X, Y: Integer);
  31      procedure CardMouseUp(Sender: TObject; Button: TMouseButton;
  32                Shift: TShiftState; X, Y: Integer);
  33      procedure CardMouseMove(Sender: TObject; Shift: TShiftState;
  34                X,Y: Integer);
  35      procedure ButtonStartClick(Sender: TObject);
  36      procedure ButtonNewClick(Sender: TObject);
  37      procedure ButtonClick(Sender: TObject);
  38      procedure ImageTableMouseDown(Sender: TObject; Button: TMouseButton;
  39        Shift: TShiftState; X, Y: Integer);
  40    private
  41      { Private 宣言 }
  42      Trump      : TTrump;
  43      Table      : TTable;
  44      Maisuu     : TMaisuu;
  45      Basyo      : TBasyo;
  46      SentakuChuu: Boolean;
  47      ErandaFuda : TCardNo;
  48      NokoriSuit : 0..4;
  49      XDown      : Integer;
  50      YDown      : Integer;
  51      procedure Kuwaeru(Col : TCol; CardNo : TCardNo);
  52      procedure Layout;
  53      procedure Hyouji;
  54      procedure Start;
  55      procedure Erabu(CardNo : TCardNo);
  56      procedure SentakuKaijo;
  57      procedure Utsusu(ColTo : TCol);
  58      procedure SorottaraAgeru(Col : TCol);
  59      procedure Ageru(Col : TCol);
  60      procedure GameOver(Seikou : Boolean);
  61    public
  62      { Public 宣言 }
  63    end;
  64   
  65  var
  66    FormSimon: TFormSimon;
  67   
  68  implementation
  69   
  70  {$R *.DFM}
  71  (********** Method **********)
  72  procedure TFormSimon.Kuwaeru(Col : TCol; CardNo : TCardNo);
  73            (* Col 列にCardNo番の札を追加する *)
  74    var
  75      Row : TRow;
  76    begin
  77      // 内部処理
  78      Inc(Maisuu[Col]);                  // Col 列の札が１枚増える
  79      Row := Maisuu[Col];                // 枚数行目に
  80      Table[Col,Row] := CardNo;          // CrdNo 番の札を置く
  81      Basyo[CardNo].Col := Col;          // その場所を逆引きできるように
  82      Basyo[CardNo].Row := Row;
  83      // 表示
  84      with Trump.Cards[CardNo] do
  85        begin
  86          Top  := 30*Row;
  87          Left := 80*Col-40;
  88          BringToFront;
  89          Visible := True;
  90        end;
  91    end; {Kuwaeru}
  92   
  93  procedure TFormSimon.Layout;
  94            (* 開始状態に並べる *)
  95            (* Tableを作る      *)
  96   
  97    var
  98      Col    : TCol;
  99      Row    : TRow;
 100      CardNo : TCardNo;
 101    begin
 102      for Col := 1 to 10 do                 // すべての列を空にする
 103        Maisuu[Col] := 0;
 104      Row := 1;                             // １行目から始める
 105      Col := 1;                             // １列目から始める
 106      for CardNo := 0 to 51 do
 107        begin
 108          Kuwaeru(Col,CardNo);              // １枚並べる
 109          if Col < 10                       // 10列になるまで
 110            then Inc(Col)                   // 次の列にする
 111            else begin                      // 10列まで終わったら
 112                   Inc(Row);                // 次の行にする
 113                   Col := Row;              // 行と同じ番号の列から始める
 114                 end;
 115        end;
 116    end; {Layout}
 117   
 118  procedure TFormSimon.Hyouji;
 119            (* Tableを表示する *)
 120    var
 121      Col : TCol;
 122      Row : TRow;
 123    begin
 124      with ImageTable.Canvas do
 125        begin
 126          Brush.Color := clTeal;
 127          FillRect(ClipRect);
 128          Brush.Color := clAqua;
 129          for Col := 1 to 10 do
 130            FillRect(Bounds(80*Col-40,30,72,96));
 131        end;
 132      for Col := 1 to 10 do
 133        for Row := 1 to Maisuu[Col] do
 134          with Trump.Cards[Table[Col,Row]] do
 135            begin
 136              Visible := True;
 137              PosiNiSuru;
 138              Top  := 30*Row;
 139              Left := 80*Col-40;
 140              BringToFront;
 141            end;
 142    end; {Hyouji}
 143   
 144  procedure TFormSimon.Start;
 145    begin
 146      Layout;
 147      Hyouji;
 148      SentakuChuu := False;
 149      NokoriSuit := 4;
 150      TimerSakusei.Enabled := False;
 151    end; {Start}
 152   
 153  procedure TFormSimon.Erabu(CardNo : TCardNo);
 154            (* CardNo番の札から上の一群が選択可能ならば選択する *)
 155            (* 選択可能＝同じスーツでランクが１ずつ減少している *)
 156    var
 157      Col : TCol;
 158      Row : TRow;
 159    begin
 160      with Trump do
 161        begin
 162          Col := Basyo[CardNo].Col;
 163          Row := Basyo[CardNo].Row;       // CardNo番の札がある行から始めて
 164          while (Row < Maisuu[Col]) and
 165                (Cards[Table[Col,Row+1]].Suit = Cards[Table[Col,Row]].Suit)  and
 166                (Cards[Table[Col,Row+1]].Rank = Cards[Table[Col,Row]].Rank-1)  do
 167            Inc(Row);                     // 選択可能条件を満たしていたら次の行へ
 168          SentakuChuu := Row = Maisuu[Col];   // 上の札がすべて満たしていたらＯＫ
 169          if SentakuChuu
 170            then begin
 171                   ErandaFuda := CardNo;                        // 選んだ群の先頭
 172                   for Row :=  Basyo[CardNo].Row to Row  do     // 選んだ群を
 173                     with Cards[Table[Col,Row]] do
 174                       begin
 175                         NegaNiSuru;                            // ネガにする
 176                         BringToFront;                          // 手前にする
 177                       end;
 178                 end;
 179        end;
 180    end; {Erabu}
 181   
 182  procedure TFormSimon.SentakuKaijo;
 183            (* 札が選ばれている状態を解除する *)
 184    var
 185      Col : TCol;
 186      Row : TRow;
 187    begin
 188      Col := Basyo[ErandaFuda].Col;                      // 群（の先頭）がある列
 189      for Row := Basyo[ErandaFuda].Row to Maisuu[Col] do // 群の札を
 190        Trump.Cards[Table[Col,Row]].PosiNiSuru;          // ポジにする
 191      SentakuChuu := False;                              // 選ばれてない
 192    end; {SentakuKaijo}
 193   
 194  procedure TFormSimon.Utsusu(ColTo : TCol);
 195            (* 選んだ群をColTo列に移動可能ならば移動する *)
 196            (* 移動可能＝移動先が空または一番上の札のランクが１大きい *)
 197    var
 198      RowFrom : TRow;
 199      ColFrom : TCol;
 200    begin
 201      ColFrom := Basyo[ErandaFuda].Col;
 202      if (Maisuu[ColTo] = 0) or
 203         (Trump.Cards[Table[ColTo,Maisuu[ColTo]]].Rank = Trump.Cards[ErandaFuda].Rank+1)
 204        then begin
 205               for RowFrom := Basyo[ErandaFuda].Row to Maisuu[ColFrom] do
 206                 begin
 207                   Kuwaeru(ColTo,Table[ColFrom,RowFrom]);
 208                   Dec(Maisuu[ColFrom]);
 209                 end;
 210             end
 211        else begin
 212               for RowFrom := Basyo[ErandaFuda].Row to Maisuu[ColFrom] do
 213                 with Trump.Cards[Table[ColFrom,RowFrom]] do
 214                   begin
 215                     Top  := 30*RowFrom;
 216                     Left := 80*ColFrom-40;
 217                 end;
 218             end;
 219      SentakuKaijo;
 220      SorottaraAgeru(ColTo);
 221    end; {Utsusu}
 222   
 223  procedure TFormSimon.SorottaraAgeru(Col : TCol);
 224            (* 13 枚揃ったら取り除く *)
 225    begin
 226      if Maisuu[Col] >= 13
 227        then begin
 228               Erabu(Table[Col,Maisuu[Col]-12]);
 229               if SentakuChuu
 230                 then Ageru(Col);
 231             end;
 232    end; {SorottaraAgeru}
 233   
 234  procedure TFormSimon.Ageru(Col : TCol);
 235            (* 13枚揃った群を上げる（取り除く） *)
 236    var
 237      K : 1..13;
 238    begin
 239      SentakuKaijo;                                   // 選択状態を解除する
 240      for K := 1 to 13 do
 241        with Trump.Cards[Table[Col,Maisuu[Col]]] do
 242          begin
 243            repeat
 244              Top := Top+1;
 245              Application.ProcessMessages;            // 表示する
 246            until Top+Height >= ImageTable.Height;
 247            Visible := False;                         // 見えなくする
 248            Dec(Maisuu[Col]);                         // １枚減らす
 249          end;
 250      Dec(NokoriSuit);
 251      if NokoriSuit = 0
 252        then GameOver(True);
 253    end; {Ageru}
 254   
 255  procedure TFormSimon.GameOver(Seikou : Boolean);
 256            (* ゲーム終了 *)
 257    begin
 258      TimerSakusei.Enabled := True;
 259      if Seikou
 260        then ShowMessage(#13+#13+#13+'　　　おめでとう　　　'+#13+#13+#13)
 261        else ShowMessage(#13+#13+#13+'　　　残念でした　　　'+#13+#13+#13);
 262    end; {GameOveer}
 263   
 264  (********** Event Handler **********)
 265  procedure TFormSimon.CardMouseDown(Sender: TObject; Button: TMouseButton;
 266            Shift: TShiftState; X, Y: Integer);
 267  begin
 268    with TCard(Sender) do
 269      begin
 270        if not SentakuChuu and (Button = mbLeft)
 271          then begin
 272                 Erabu(Tag);                    // Tag = CardNo
 273                 XDown := X;
 274                 YDown := Y;
 275               end;
 276      end;
 277  end; {CardMouseDown}
 278   
 279  procedure TFormSimon.CardMouseUp(Sender: TObject; Button: TMouseButton;
 280            Shift: TShiftState; X, Y: Integer);
 281  var
 282    Col : TCol;
 283  begin
 284    if SentakuChuu and (Button = mbLeft)
 285      then with TCard(Sender) do
 286             begin
 287               Col := Left div 80 +1;
 288               Utsusu(Col);
 289             end;
 290  end; {CardMouseUp}
 291   
 292  procedure TFormSimon.CardMouseMove(Sender: TObject; Shift: TShiftState;
 293            X,Y: Integer);
 294  var
 295    Row : TRow;
 296    Col : TCol;
 297  begin
 298    if SentakuChuu
 299      then with TCard(Sender) do
 300             begin
 301               Col := Basyo[Tag].Col;
 302               for Row := Basyo[Tag].Row to Maisuu[Col] do     
 303               with Trump.Cards[Table[Col,Row]] do
 304                 begin
 305                   Left := Left+X-XDown;
 306                   Top  := Top +Y-YDown;
 307                 end;
 308             end;
 309  end; {CardMouseMove}
 310   
 311  procedure TFormSimon.ButtonCloseClick(Sender: TObject);
 312  begin
 313    Close;
 314  end; {ButtonCloseClick}
 315   
 316  procedure TFormSimon.TimerSakuseiTimer(Sender: TObject);
 317  var
 318    CardNo : TCardNo;
 319    RectSaki : TRect;
 320    RectMoto : TRect;
 321    X1,Y1 : Integer;
 322  begin
 323    if Trump = NiL                    // 未作成なら作成する
 324      then begin                      // 最初に１回だけ実行
 325             Trump := TTrump.Create;
 326             Trump.Sakusei(Self);
 327             Trump.MouseHandler(CardMouseDown,CardMouseUp,CardMouseMove);
 328           end;
 329    Trump.Hide;
 330    X1 := Random(ClientWidth)-36;
 331    Y1 := Random(ClientHeight)-48;
 332    CardNo := Random(52);
 333    with  Trump.Cards[CardNo] do
 334      begin
 335        RectMoto := Canvas.ClipRect;
 336        RectSaki := Bounds(X1,Y1,72,96);
 337        ImageTable.Canvas.CopyRect(RectSaki,Canvas,RectMoto);
 338      end;
 339  end; {TimerSakuseiTimer}
 340   
 341   
 342  procedure TFormSimon.ButtonStartClick(Sender: TObject);
 343  begin
 344    Start;
 345  end; {ButtonStartClick}
 346   
 347  procedure TFormSimon.ButtonNewClick(Sender: TObject);
 348  begin
 349    Trump.Shuffle;
 350    Start;
 351  end; {ButtonNewClick}
 352   
 353  procedure TFormSimon.ButtonClick(Sender: TObject);
 354  begin
 355    GameOver(False);
 356  end; {ButtonClick}
 357   
 358  procedure TFormSimon.ImageTableMouseDown(Sender: TObject;
 359    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 360  begin
 361    if SentakuChuu and (ImageTable.Canvas.Pixels[X,Y] = clAqua)
 362      then Utsusu((X+42) div 80);
 363  end; {ImageTableMouseDown}
 364   
 365  end.