main.pas

这个c程序是一个简单的汉诺塔小游戏。它可以直接运行

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Haulm, Buttons, ExtDlgs, JPEG, CheckLst;

type
  TMainfrm = class(TForm)
    PaintBoxHanoiTower: TPaintBox;
    GroupBox1: TGroupBox;
    grpTray: TGroupBox;
    StaticText1: TStaticText;
    edtCount: TEdit;
    StaticText2: TStaticText;
    grpGame: TGroupBox;
    StaticText3: TStaticText;
    edtTimer: TEdit;
    StaticText4: TStaticText;
    edtStep: TEdit;
    btnSet: TBitBtn;
    ColorBoxTray: TColorBox;
    Timer1: TTimer;
    label13: TStaticText;
    edtBrown: TSpeedButton;
    OpenPictureDialogBlack: TOpenPictureDialog;
    grpPlay: TGroupBox;
    StaticText5: TStaticText;
    edtSpeed: TEdit;
    btnStar: TBitBtn;
    clbRecord: TCheckListBox;
    clbUser: TCheckListBox;
    procedure PaintBoxHanoiTowerMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxHanoiTowerMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxHanoiTowerPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBoxHanoiTowerMouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    procedure btnSetClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnStarClick(Sender: TObject);
  private
    Step: Integer;
    AutoSpeed: Integer;
    PeekTray: TTray;
    PushingPos: Integer;
    TrayCount: Integer;
    TrayColor: TColor;
    Haulms: array[1..3] of THaulm;
    function CheckGameOver(): Boolean;
    procedure DrawGameInterface();
    procedure DrawHaulm();
    procedure DrawTray();
    procedure DrawMoveTray();
    procedure GetParameter();
    procedure SetGameStar();
    procedure AutoMoveHanoiTower(n: Integer; HaulmX,HaulmY,HaulmZ: THaulm);
    procedure GameHappy();
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Mainfrm: TMainfrm;

implementation

{$R *.dfm}

const
  MoveUpSpace = 25;
  VSpace = 45;  //Botton Line
  HSpace = 15;
  DefButtomLineLength = 130;
  DefHaulmHeight = 60;

  HaulmTopSpace = 20;
  LeastTrayWidth = 28;
  AddTrayWidth = 24;
  TrayTurnAngle = 5;

function CheckPointArea(X,Y: Integer; AreaRect: TRect): Boolean;
begin
  if (X > AreaRect.Left) and (X < AreaRect.Right)
    and (Y > AreaRect.Top) and (Y < AreaRect.Bottom) then
    Result := True
  else
    Result := False;
end;

function TMainfrm.CheckGameOver: Boolean;
begin
  Result := False;
  if Not Assigned(Haulms[1]) then exit;
  if Length(Haulms[1].Tray) <> 0 then exit;
  if Length(Haulms[2].Tray) <> 0 then exit;
  Timer1.Enabled := False;
  Result := True;
end;

procedure TMainfrm.GetParameter;
var
  i, Left: Integer;
begin
  //Haulms
  Left := HSpace - Haulms[1].Width - HSpace;
  for i := Low(Haulms) to High(Haulms) do
  begin
    Inc(Left, Haulms[1].Width + HSpace);
    Haulms[i].Left := Left;
    Haulms[i].Top := PaintBoxHanoiTower.Height - VSpace - Haulms[1].Height;
    Haulms[i].Pen.Width := 3;
  end;
end;

procedure TMainfrm.PaintBoxHanoiTowerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  if CheckGameOver then exit;
  for i := Low(Haulms) to High(Haulms) do
    if CheckPointArea(X,Y,Haulms[i].Rect) then
    begin
      PeekTray := Haulms[i].Peek;
      PushingPos := i;
      DrawGameInterface();
      exit;
    end;
end;

procedure TMainfrm.PaintBoxHanoiTowerMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i, PeekPosition: Integer;
  tmpstr: string;
begin
  PeekPosition := 0;
  for i := Low(Haulms) to High(Haulms) do
    if Haulms[i].Peeking then PeekPosition := i;
  if PeekPosition = 0 then exit;

  if (PeekPosition <> PushingPos) and (Haulms[PushingPos].Push(PeekTray)) then
  begin
    Haulms[PeekPosition].Pop;
    edtStep.Text := IntToStr(StrToIntDef(edtStep.Text,0) + 1);
    tmpstr := 'Step '+edtStep.Text+':   '+Haulms[PeekPosition].Flag +' -> '+Haulms[PushingPos].Flag;
    clbUser.Items.Add(tmpstr);
  end;
  Haulms[PeekPosition].Peeking := False;
  PushingPos := 0;
  DrawGameInterface();
  if CheckGameOver then
  begin
    GameHappy;
  end;
end;

procedure TMainfrm.PaintBoxHanoiTowerMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  Peeked: Boolean;
  i, MovePosition: Integer;
begin
  Peeked := False;
  for i := Low(Haulms) to High(Haulms) do
    if Haulms[i].Peeking then Peeked := True;
  if Not Peeked then exit;
  //Get Push Position
  MovePosition := 1;
  for i := Low(Haulms) to High(Haulms) do
    if Haulms[i].Left < X then
      MovePosition := i;
  if MovePosition <> PushingPos then
  begin
    PushingPos := MovePosition;
    DrawGameInterface();
  end;
end;

procedure TMainfrm.SetGameStar();
var
  i: Integer;
  PushTray: TTray;
  BottomLineLength, HaulmHeight: Integer;
begin
  for i := Low(Haulms) to High(Haulms) do
  begin
    if Assigned(Haulms[i]) then Haulms[i].Destroy;
    Haulms[i] := THaulm.Create;
  end;
  Haulms[1].Flag := 'X';
  Haulms[2].Flag := 'Y';
  Haulms[3].Flag := 'Z';

  for i := TrayCount downto 1 do
  begin
    PushTray.Level := i;
    PushTray.Color := TrayColor;
    PushTray.Width := LeastTrayWidth + (AddTrayWidth * (i -1));
    Haulms[1].Push(PushTray);
  end;

  BottomLineLength := LeastTrayWidth + AddTrayWidth * (TrayCount);
  if BottomLineLength < DefButtomLineLength then BottomLineLength := DefButtomLineLength;
  HaulmHeight := TrayCount * (Haulms[1].TrayHeight + Haulms[1].TrayVSpace) + HaulmTopSpace;
  if HaulmHeight < DefHaulmHeight then HaulmHeight := DefHaulmHeight;
  for i := Low(Haulms) to High(Haulms) do
  begin
    Haulms[i].Width := BottomLineLength;
    Haulms[i].Height := HaulmHeight;
  end;
end;

procedure TMainfrm.PaintBoxHanoiTowerPaint(Sender: TObject);
begin
  GetParameter();
  DrawGameInterface();
end;

procedure TMainfrm.DrawGameInterface();
begin
  With PaintBoxHanoiTower.Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Color := self.Color;
    Rectangle(0,0,PaintBoxHanoiTower.Width,PaintBoxHanoiTower.Height);
  end;

  DrawHaulm();
  DrawTray();
end;

procedure TMainfrm.DrawHaulm;
var
  i: Integer;
begin
  With PaintBoxHanoiTower.Canvas do
  begin
    //Draw BottomLine
    for i := Low(Haulms) to High(Haulms) do
    begin
      Pen := Haulms[i].Pen;
      MoveTo(Haulms[i].Rect.Left,  Haulms[i].Rect.Bottom);
      LineTo(Haulms[i].Rect.Right, Haulms[i].Rect.Bottom);
      MoveTo(Haulms[i].HaulmLeft,  Haulms[i].Rect.Top);
      LineTo(Haulms[i].HaulmLeft,  Haulms[i].Rect.Bottom);
    end;
    Font.Color := clBlack;
    Font.Size := 10;
    Font.Style := [fsBold];
    TextOut(Haulms[1].HaulmLeft - TextWidth('X') div 2, Haulms[1].Rect.Bottom + 5, 'X');
    TextOut(Haulms[2].HaulmLeft - TextWidth('Y') div 2, Haulms[2].Rect.Bottom + 5, 'Y');
    TextOut(Haulms[3].HaulmLeft - TextWidth('Z') div 2, Haulms[3].Rect.Bottom + 5, 'Z');
  end;
end;

procedure TMainfrm.DrawTray();
var
  i, j: Integer;
  TrayRect: TRect;
begin
  With PaintBoxHanoiTower.Canvas do
  begin
    for i := Low(Haulms) to High(Haulms) do
      for j := Low(Haulms[i].Tray) to High(Haulms[i].Tray) do
      begin
        Brush.Color := Haulms[i].Tray[j].Color;
        Pen.Width := Haulms[i].TrayPenWidth;
        TrayRect := Haulms[i].TrayRect(j);
        if (Not Haulms[i].Peeking) or (j < High(Haulms[i].Tray)) then
          RoundRect(TrayRect.Left, TrayRect.Top, TrayRect.Right, TrayRect.Bottom, TrayTurnAngle, TrayTurnAngle);
      end;
  end;
  DrawMoveTray;
end;

procedure TMainfrm.DrawMoveTray;
var
  i, PeekHaulm: Integer;
  X1, Y1, X2, Y2: Integer;
begin
  PeekHaulm := 0;
  for i := Low(Haulms) to High(Haulms) do
    if Haulms[i].Peeking then PeekHaulm := i;
  if PeekHaulm = 0 then exit;

  X1 := Haulms[PushingPos].HaulmLeft - PeekTray.Width div 2;
  X2 := Haulms[PushingPos].HaulmLeft + PeekTray.Width div 2;
  Y1 := Haulms[PushingPos].Top - MoveUpSpace;
  Y2 := Y1 + Haulms[PeekHaulm].TrayHeight;

  With PaintBoxHanoiTower.Canvas do
  begin
    Brush.Color := PeekTray.Color;
    Pen.Width := Haulms[PeekHaulm].TrayPenWidth;
    RoundRect(X1,Y1, X2, Y2, TrayTurnAngle, TrayTurnAngle);
  end;
end;

procedure TMainfrm.FormCreate(Sender: TObject);
begin
  PaintBoxHanoiTower.Parent.DoubleBuffered := True;
  TrayColor := clBlack;
  TrayCount := 5;
  SetGameStar();
  GetParameter();
end;

procedure TMainfrm.btnSetClick(Sender: TObject);
begin
  try
    if StrToInt(edtCount.Text) < 1 then
    begin
      Application.MessageBox('Count must btween 1 and 100','Hind',64);
      exit;
    end;
  except
    Application.MessageBox('It is''t a int type!','Hind',64);
    exit;
  end;
  TrayCount := StrToInt(edtCount.Text);
  TrayColor := ColorBoxTray.Selected;
  Timer1.Enabled := True;
  edtTimer.Text := '0';
  edtStep.Text := '0';
  clbUser.Items.Clear;
  SetGameStar();
  GetParameter();
  DrawGameInterface();
end;

procedure TMainfrm.Timer1Timer(Sender: TObject);
begin
  edtTimer.Text := IntToStr(StrToIntDef(edtTimer.Text,0)+1);
end;

//

procedure TMainfrm.AutoMoveHanoiTower(n: Integer; HaulmX,HaulmY,HaulmZ: THaulm);
  procedure MoveOneDisk(var HaulmA, HaulmB: THaulm);
  var
    tmpstr: string;
    i: Integer;
  begin
    //ShowMessage
    Inc(Step);
    edtStep.Text := IntToStr(Step);
    tmpstr := 'Step '+IntToStr(Step)+': '+HaulmA.Flag+' -> '+HaulmB.Flag;
    clbRecord.Items.Add(tmpstr);
    //Do Move  {Peek -> Move -> Push}
    PeekTray := HaulmA.Peek;
    for i := Low(Haulms) to High(Haulms) do
      if Haulms[i].Peeking then PushingPos := i;
    DrawGameInterface();
    self.Refresh;
    Sleep(AutoSpeed div 3);
    if HaulmB.Flag = 'X' then PushingPos := 1
    else if HaulmB.Flag = 'Y' then PushingPos := 2
    else if HaulmB.Flag = 'Z' then PushingPOs := 3;
    DrawGameInterface();
    self.Refresh;
    Sleep(AutoSpeed div 3);
    HaulmB.Push(HaulmA.Pop);
    DrawGameInterface();
    self.Refresh;
    Sleep(AutoSpeed div 3);
  end;
begin
  if n = 1 then
    MoveOneDisk(HaulmX,HaulmZ)
  else begin
    AutoMoveHanoiTower(n-1,HaulmX,HaulmZ,HaulmY);
    MoveOneDisk(HaulmX,HaulmZ);
    AutoMoveHanoiTower(n-1,HaulmY,HaulmX,HaulmZ);
  end;
end;

procedure TMainfrm.btnStarClick(Sender: TObject);
begin
  try
    if StrToInt(edtSpeed.Text) <= 0 then
    begin
      Application.MessageBox('The speed must lage 0 !','Hind',64);
      exit;
    end;
  except
    Application.MessageBox(PChar(''''+edtSpeed.Text+''' isn''t a integer type!'),'Hind',64);
    exit;
  end;

  AutoSpeed := StrToInt(edtSpeed.Text);
  edtTimer.Text := '';
  Timer1.Enabled := False;
  clbRecord.Items.Clear;
  btnSetClick(btnSet);
  Step := 0;
  AutoMoveHanoiTower(TrayCount,Haulms[1],Haulms[2],Haulms[3]);
end;

procedure TMainfrm.GameHappy;
const
  FontSpace = 100;
var
  i, X, Y: Integer;
begin
  Y := FontSpace;
  With PaintBoxHanoiTower.Canvas do
  begin
    Font.Color := clBlue;
    Font.Style := [fsBold];
    Brush.Color := self.Color;
    for i := 1 to 80 do
    begin
      Font.Size := i;
      X := (Haulms[3].Rect.Right - Haulms[1].Left) div 2 - (TextWidth('Win!') div 2);
      TextOut(X, FontSpace,'Win!');
      Sleep(3);
    end;
    for i := 1 to 12 do
    begin
      case i mod 2 of
        1:
          begin
            Inc(X,20);
            Inc(Y,20);
            TextOut(X, FontSpace,'Win!');
          end;
        0:
          begin
            Dec(X,20);
            Dec(Y,20);
            TextOut(X, FontSpace,'Win!');
          end;
      end;
      Sleep(30);
    end;
  end;
end;

end.