mainform.pas

描述了根据五子规则做出相应的分步预测和胜负判断！也对DELPHI的面向对象的程序开发系统做了相应的阐述!

unit MainForm;

interface

uses
  GameBoard, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ToolWin, ActnMan, ActnCtrls, ActnList, ComCtrls,
  XPStyleActnCtrls, ExtCtrls, ImgList, StdCtrls;

const
  //  CellWidth = 20;
  MinCellWidth = 5;
  CompareType = Five;
  MaxDepth = 16;
  //  FuDu = -50;

  MouseColor = clred;
  DownColor = clGreen;

  FileID = '论文五子棋';

type
  TUserType = (Computer, Player);
  TGameMode = (VSComputer, VSHuman, ReadRecord);

  TStepRecord = record
    x, y: shortint;
  end;

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    ActionManager1: TActionManager;
    StatusBar1: TStatusBar;
    Action1: TAction;
    Action2: TAction;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Action3: TAction;
    N5: TMenuItem;
    N6: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    ChessImageList: TImageList;
    ImageList1: TImageList;
    Action4: TAction;
    Action5: TAction;
    N7: TMenuItem;
    N8: TMenuItem;
    Action6: TAction;
    Action7: TAction;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    Action8: TAction;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    Timer1: TTimer;
    Action9: TAction;
    N22: TMenuItem;
    procedure Action3Execute(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Action2Execute(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure Action5Execute(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure Action6Execute(Sender: TObject);
    procedure Action7Execute(Sender: TObject);
    procedure Action8Execute(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Action9Execute(Sender: TObject);
  private
    { Private declarations }
    BackGroundColor, LineColor: TColor;
    WhiteChessImage, BlackChessImage: TBitmap;
    BoardImage: TBitmap;
    CurrentChessType: TChessType;
    WhoFirst: TUserType;
    ComputerFirst: boolean;
    BlackTime, WhiteTime: integer;
    GameMode: TGameMode;

    ShowNurmber: boolean;

    OldMouseX, OldMouseY: integer;
    OldDownX, OldDownY: integer;

    StepRecord: array of TStepRecord;
    CurrStep: integer;

    procedure DrawBox(x, y: integer; bColor: TColor);
    procedure RedrawBoard;
    function PutChess(x, y: integer; TypeOfChess: TChessType): boolean;
    procedure RecordOneStep(x, y: integer);
    procedure GoBack(step: integer);
    procedure GoForward(step: integer);
    procedure SaveRecordToFile(FileName: string);
    procedure OpenRecordFromFile(FileName: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GameBoard1: TGameBoard;
  CellWidth: integer;

implementation

uses About;

{$R *.dfm}
{$R picture.res}

procedure TForm1.RecordOneStep(x, y: integer);
var Threshold: integer;
begin
  setLength(StepRecord, CurrStep + 1);
  StepRecord[CurrStep].x := x;
  StepRecord[CurrStep].y := y;
  inc(CurrStep);
  if GameMode = VSComputer then
    Threshold := 1
  else
    Threshold := 0;
  if CurrStep > Threshold then
    Action4.Enabled := True;
  Action5.Enabled := False;
end;

procedure TForm1.GoBack(Step: integer);
var i, Threshold: integer;
begin
  if ((Step <= 0) or (CurrStep - Step < 0)) then exit;
  for i := 0 to Step - 1 do
  begin
    GameBoard1.SetXY(StepRecord[CurrStep - i - 1].x, StepRecord[CurrStep - i - 1].y,
      None);
  end;
  if odd(Step) then
    if CurrentChessType = Black then
      CurrentChessType := White
    else
      CurrentChessType := Black;
  CurrStep := CurrStep - Step;

  if GameMode = VSComputer then
    Threshold := 1
  else
    Threshold := 0;
  if CurrStep < Threshold + 1 then
    Action4.Enabled := False;
  Action5.Enabled := True;

  if CurrStep > 0 then
  begin
    OldDownX := StepRecord[CurrStep - 1].x;
    OldDownY := StepRecord[CurrStep - 1].Y;
  end else
  begin
    OldDownX := 1;
    OldDownY := 1;
  end;
end;

procedure TForm1.GoForward(Step: integer);
var i, Threshold: integer;
begin
  if GameMode = VSComputer then
    Threshold := 1
  else
    Threshold := 0;
  if ((step <= 0) or (Step + CurrStep > Length(StepRecord))) then
    exit;
  for i := 0 to Step - 1 do
  begin
    GameBoard1.SetXY(StepRecord[CurrStep + i].x, StepRecord[CurrStep + i].y,
      CurrentChessType);
    if CurrentChessType = Black then
      CurrentChessType := White
    else
      CurrentChessType := Black;
  end;
  CurrStep := CurrStep + Step;

  if CurrStep >= Length(StepRecord) - Threshold then
    Action5.Enabled := False;
  Action4.Enabled := True;

  OldDownX := StepRecord[CurrStep - 1].x;
  OldDownY := StepRecord[CurrStep - 1].Y;
end;

procedure TForm1.SaveRecordToFile(FileName: string);
var FileStream: TMemoryStream;
  id: string[6];
  i: integer;
begin
  try
    FileStream := TMemoryStream.Create;
    id := FileID;
    FileStream.Write(id, SizeOf(id));
    //    FileStream.Write(GameMode, SizeOf(GameMode));
    //    FileStream.Write(WhoFirst, SizeOf(WhoFirst));
    i := Length(StepRecord);
    FileStream.Write(i, SizeOf(integer));
    for i := 1 to Length(StepRecord) do
    begin
      FileStream.Write(StepRecord[i - 1], SizeOf(TStepRecord));
    end;
    FileStream.SaveToFile(FileName);
    Showmessage('保存完毕！ 总步数：' + inttostr(Length(StepRecord)));
  finally
    FileStream.Free;
  end;
end;

procedure TForm1.OpenRecordFromFile(FileName: string);
var FileStream: TMemoryStream;
  id: string[6];
  i: integer;
begin
  try
    FileStream := TMemoryStream.Create;
    FileStream.LoadFromFile(FileName);
    FileStream.Read(id, SizeOf(id));
    if id <> FileID then
    begin
      ShowMessage('不是棋盘文件！');
      FileStream.Free;
      exit;
    end;
    //    FileStream.Read(GameMode, sizeof(GameMode));
    //    FileStream.Read(WhoFirst, SizeOf(WhoFirst));
    FileStream.Read(i, SizeOf(integer));
    setLength(StepRecord, i);
    CurrStep := 0;
    for i := 1 to Length(StepRecord) do
    begin
      FileStream.Read(StepRecord[i - 1], SizeOf(TStepRecord));
    end;

    GameBoard1.Reset;
    CurrentChessType := Black;
    GameMode := ReadRecord;
    GoForward(1);
    Action4.Enabled := False;
    Action5.Enabled := True;
    RedrawBoard;
    ShowMessage('成功读入! 总步数：' + inttostr(Length(StepRecord)));

  finally
    FileStream.Free;
  end;
end;

procedure TForm1.DrawBox(x, y: integer; bColor: TColor);
var le, up, size, lWidth: integer;
begin
  le := x * CellWidth - CellWidth div 2 + 2;
  up := y * CellWidth - CellWidth div 2 + 2;

  Image1.Canvas.Pen.Color := bColor;
  Image1.Canvas.Pen.Width := 2;
  Image1.Canvas.Pen.Mode := pmXor;
  size := CellWidth div 4;
  lWidth := CellWidth - 2;
  with Image1.Canvas do
  begin
    MoveTo(le, up);
    LineTo(le + size, up);
    MoveTo(le, up + 1);
    LineTo(le, up + size);

    MoveTo(le + lWidth, up);
    LineTo(le + lWidth - size, up);
    MoveTo(le + lWidth, up + 1);
    LineTo(le + lWidth, up + size);

    MoveTo(le, up + lWidth);
    LineTo(le + size, up + lWidth);
    MoveTo(le, up + lWidth - 1);
    LineTo(le, up + lWidth - size);

    MoveTo(le + lWidth, up + lWidth);
    LineTo(le + lWidth - size, up + lWidth);
    MoveTo(le + lWidth, up + lWidth - 1);
    LineTo(le + lWidth, up + lWidth - size);
  end;

end;

procedure TForm1.RedrawBoard;
var i, j: integer;
  NewCellWidth: integer;
  NewImage: TBitmap;
  le, up: integer;
begin
  i := (Image1.Width) div (BoardWidth + 1);
  j := (Image1.height) div (BoardHeight + 1);
  if i > j then
    NewCellWidth := j
  else
    NewCellWidth := i;

  //  画背景
//  if NewCellWidth <> CellWidth then
  begin
    CellWidth := NewCellWidth;
    NewImage := TBitmap.Create;
    NewImage.Width := Image1.Width;
    NewImage.Height := Image1.Height;
    NewImage.Canvas.CopyRect(Rect(0, 0, NewImage.Width, NewImage.Height), BoardImage.Canvas,
      Rect(0, 0, BoardImage.Width, BoardImage.Height));
    Image1.Picture.Assign(NewImage);
    NewImage.FreeImage;
  end;

  //  画小边框
  DrawBox(OldMouseX, OldMouseY, MouseColor);
  DrawBox(OldDownX, OldDownY, DownColor);


  //  画棋盘
  Image1.Canvas.Pen.Color := clred;
  Image1.Canvas.Pen.Mode := pmwhite;
  Image1.Canvas.Pen.Width := 1;
  for i := 1 to BoardWidth do
  begin
    Image1.Canvas.MoveTo(i * CellWidth, CellWidth);
    Image1.Canvas.LineTo(i * CellWidth, (BoardHeight) * CellWidth);
  end;

  for i := 1 to BoardHeight do
  begin
    Image1.Canvas.MoveTo(CellWidth, i * CellWidth);
    Image1.Canvas.LineTo((BoardWidth) * CellWidth, i * CellWidth);
  end;