⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 描述了根据五子规则做出相应的分步预测和胜负判断!也对DELPHI的面向对象的程序开发系统做了相应的阐述!
💻 PAS
📖 第 1 页 / 共 2 页
字号:

  {  Image1.Canvas.Pen.Width := 2;
    Image1.Canvas.MoveTo(CellWidth, CellWidth-1);
    Image1.Canvas.LineTo(CellWidth, (BoardHeight) * CellWidth);
    Image1.Canvas.MoveTo(BoardWidth * CellWidth, CellWidth);
    Image1.Canvas.LineTo(BoardWidth * CellWidth, (BoardHeight) * CellWidth);
    Image1.Canvas.MoveTo(CellWidth, CellWidth);
    Image1.Canvas.LineTo(BoardWidth * CellWidth, CellWidth);
    Image1.Canvas.MoveTo(CellWidth, BoardHeight * CellWidth);
    Image1.Canvas.LineTo(BoardWidth * CellWidth, (BoardHeight) * CellWidth);
  }
  Image1.Canvas.Pen.Width := 2;
  Image1.Canvas.MoveTo(CellWidth - 4, CellWidth - 1 - 4);
  Image1.Canvas.LineTo(CellWidth - 4, (BoardHeight) * CellWidth + 4);
  Image1.Canvas.MoveTo(BoardWidth * CellWidth + 4, CellWidth - 4);
  Image1.Canvas.LineTo(BoardWidth * CellWidth + 4, (BoardHeight) * CellWidth + 4);
  Image1.Canvas.MoveTo(CellWidth - 4, CellWidth - 4);
  Image1.Canvas.LineTo(BoardWidth * CellWidth + 4, CellWidth - 4);
  Image1.Canvas.MoveTo(CellWidth - 4, BoardHeight * CellWidth + 4);
  Image1.Canvas.LineTo(BoardWidth * CellWidth + 4, (BoardHeight) * CellWidth + 4);

  //  画棋子
  for i := 1 to BoardWidth do
    for j := 1 to BoardHeight do
    begin
      le := i * CellWidth - CellWidth div 2 + 2;
      up := j * CellWidth - CellWidth div 2 + 2;
      case GameBoard1.GetXY(i, j) of
        White: Image1.Canvas.StretchDraw(rect(le, up, le + CellWidth - 2, up + CellWidth - 2), WhiteChessImage);
        Black: Image1.Canvas.StretchDraw(rect(le, up, le + CellWidth - 2, up + CellWidth - 2), BlackChessImage);
      end;
    end;

  //  显示数字:第几步
  if ShowNurmber then
  begin
    for i := 1 to CurrStep do
      Image1.Canvas.TextOut(CellWidth * StepRecord[i - 1].x - 5, CellWidth * StepRecord[i - 1].y - 5, inttostr(i));
  end;

  Image1.Refresh;

end;

function TForm1.PutChess(x, y: integer; TypeOfChess: TChessType): boolean;
var up, le: integer;
begin
  Result := False;
  if GameBoard1.SetXY(x, y, TypeOfChess) then
  begin
    DrawBox(OldDownX, OldDownY, DownColor);
    DrawBox(x, y, DownColor);
    OldDownX := x;
    OldDownY := y;

    if GameMode <> ReadRecord then
      RecordOneStep(x, y);

    le := x * CellWidth - CellWidth div 2 + 2;
    up := y * CellWidth - CellWidth div 2 + 2;
    case TypeOfChess of
      White: Image1.Canvas.StretchDraw(rect(le, up, le + CellWidth - 2, up + CellWidth - 2), WhiteChessImage);
      Black: Image1.Canvas.StretchDraw(rect(le, up, le + CellWidth - 2, up + CellWidth - 2), BlackChessImage);
    end;

    if ShowNurmber then
      Image1.Canvas.TextOut(x * CellWidth-5, y * CellWidth-5, inttostr(CurrStep));

    Result := True;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BackGroundColor := clOLive;
  LineColor := clBlack;

  WhoFirst := Computer;
  ShowNurmber := False;
  ComputerFirst := false;

  WhiteChessImage := TBitmap.Create;
  BlackChessImage := TBitmap.Create;
  BoardImage := TBitmap.Create;
  //  ChessImageList.GetBitmap(0, WhiteChessImage);
  //  ChessImageList.GetBitmap(1, BlackChessImage);
//  .LoadFromFile('White1.bmp');
//  BlackChessImage.LoadFromFile('Black1.bmp');
//  BoardImage.LoadFromFile('qipan.bmp');
  BoardImage.LoadFromResourceName(HInstance, 'qipan');
  WhiteChessImage.LoadFromResourceName(HInstance, 'whitechess');
  BlackChessImage.LoadFromResourceName(HInstance, 'Blackchess');
  WhiteChessImage.Transparent := True;
  BlackChessImage.Transparent := True;
  WhiteChessImage.TransParentColor := WhiteChessImage.canvas.pixels[1, 1];
  BlackChessImage.TransParentColor := BlackChessImage.canvas.pixels[1, 1];
  WhiteChessImage.TransparentMode := tmAuto;
  BlackChessImage.TransparentMode := tmAuto;

  GameBoard1 := TGameBoard.Create;

  OldMouseX := 3;
  OldMouseY := 3;
  OldDownX := 1;
  OldDownY := 1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CurrStep := 0;
  setLength(StepRecord, 0);

  WhiteChessImage.FreeImage;
  BlackChessImage.FreeImage;
  BoardImage.FreeImage;

  GameBoard1.Free;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var NewX, NewY: integer;
begin
  NewX := (x - CellWidth div 2) div CellWidth + 1;
  NewY := (y - CellWidth div 2) div CellWidth + 1;

  if not ((NewX > 0) and (NewX <= BoardWidth) and (NewY > 0) and (NewY <= BoardHeight)) then
    exit;

  if GameMode = ReadRecord then
    if Action8.Checked then
      GameMode := VSComputer
    else
      GameMode := VSHuman;

  if not PutChess(NewX, NewY, CurrentChessType) then
    exit;

  if (CurrentChessType = White) then
    CurrentChessType := Black
  else
    CurrentChessType := White;

  if GameMode = VSComputer then
  begin
    //  GameBoard1.GetNextStep(CurrentChessType, NewX, NewY);
    GameBoard1.GetNextStepWithDepth(CurrentChessType, NewX, NewY, MaxDepth);

    PutChess(NewX, NewY, CurrentChessType);

    if (CurrentChessType = White) then
      CurrentChessType := Black
    else
      CurrentChessType := White;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Action1.OnExecute(Sender);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var dx, dy: integer;
  Pos: integer;
  str: string;
  dir: TDirection;
begin
  dx := (x - CellWidth div 2) div CellWidth + 1;
  dy := (y - CellWidth div 2) div CellWidth + 1;
  if not ((dx > 0) and (dx <= BoardWidth) and (dy > 0) and (dy <= BoardHeight)) then
    exit;

  if ((OldMouseX <> dx) or (OldMouseY <> dy)) then
  begin
    DrawBox(OldMouseX, OldMouseY, MouseColor);
    DrawBox(dx, dy, MouseColor);
    OldMouseX := dx;
    OldMouseY := dy;
  end;

  StatusBar1.Panels[1].Text := inttostr(dx)+' : '+inttostr(dy);
end;

procedure TForm1.FormResize(Sender: TObject);
var blank: integer;
begin
  if Image1.Width div (BoardWidth + 1) < MinCellWidth then
  begin
    Form1.Width := MinCellWidth * BoardWidth + 100;
  end;
  if Image1.Height div (BoardHeight + 1) < MinCellWidth then
  begin
    Form1.Height := MinCellWidth * BoardHeight + 100;
  end;

  blank := Image1.Width mod (BoardWidth + 1);
  if blank > 0 then
    Form1.Width := Form1.Width - blank;
  blank := Image1.Height mod (BoardHeight + 1);
  if blank > 0 then
    Form1.Height := Form1.Height - blank;

  if Image1.Width <> Image1.Height then
  begin
    if Image1.Width > Image1.Height then
    begin
      Form1.Width := Form1.Width - (Image1.Width - Image1.Height)
    end else
    begin
      Form1.Height := Form1.Height - (Image1.Height - Image1.Width);
    end;
  end;

  if Image1.Width = Image1.Height then
    RedrawBoard;
end;

procedure TForm1.Action1Execute(Sender: TObject);
begin
  CurrentChessType := Black;
  BlackTime :=0;
  WhiteTime :=0;
  setLength(StepRecord, 0);
  CurrStep := 0;
  GameBoard1.Reset;
  if ComputerFirst then
  begin
    PutChess(8, 8, Black);
    CurrentChessType := White;
  end;
  //  PutChess(7,7,White);
  //  CurrentChessType := Black;
  RedrawBoard;
  Timer1.Enabled := Action9.Checked;
end;

procedure TForm1.Action2Execute(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Action3Execute(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.Action4Execute(Sender: TObject);
begin
  GoBack(1);
  if GameMode = VSComputer then
    GoBack(1);
  RedrawBoard;
end;

procedure TForm1.Action5Execute(Sender: TObject);
begin
  GoForward(1);
  if GameMode = VSComputer then
    GoForward(1);
  RedrawBoard;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  ShowNurmber := not N8.Checked;
  N8.Checked := ShowNurmber;
  RedrawBoard;
end;

procedure TForm1.Action6Execute(Sender: TObject);
begin
  SaveDialog1.Filter := '*.wzq|*.wzq';
  SaveDialog1.DefaultExt := 'wzq';
  if SaveDialog1.Execute then
    SaveRecordToFile(SaveDialog1.FileName);
end;

procedure TForm1.Action7Execute(Sender: TObject);
begin
  OpenDialog1.Filter := '*.wzq|*.wzq';
  OpenDialog1.DefaultExt := 'wzq';
  if OpenDialog1.Execute then
    OpenRecordFromFile(OpenDialog1.FileName);
end;

procedure TForm1.Action8Execute(Sender: TObject);
begin
  Action8.Checked := not Action8.Checked;
  if Action8.Checked then
  begin
    GameMode := VSComputer;
    N16.Enabled := True;
  end
  else
  begin
    GameMode := VSHuman;
    N16.Enabled := False;
  end;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
  if GameMode <> VSComputer then
    Action8.Execute;
  N11.Checked := True;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
  if GameMode <> VSHuman then
    Action8.Execute;
  N12.Checked := True;
end;

procedure TForm1.N16Click(Sender: TObject);
begin
  ComputerFirst := N16.Checked;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
  N13.Checked := not N13.Checked;
  StatusBar1.Visible := N13.Checked;
  if N13.Checked then
    Form1.Height := Form1.Height + 50
  else
    Form1.Resize;
end;

procedure TForm1.N14Click(Sender: TObject);
begin
  N14.Checked := not N14.Checked;

  if N14.Checked then
    Form1.Height := Form1.Height + 50
  else
    Form1.Resize;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if CurrentChessType=White then
    inc(WhiteTime)
  else
    inc(BlackTime);
  StatusBar1.Panels[2].Text := '黑方所用时间: '+FloatToStr(BlackTime/10)+' 秒';
  StatusBar1.Panels[3].Text := '白方所用时间: '+FloatToStr(WhiteTime/10)+' 秒';
end;

procedure TForm1.Action9Execute(Sender: TObject);
begin
  Action9.Checked := not Action9.Checked ;
  if Action9.Checked then
    Timer1.Enabled := True
  else
    Timer1.Enabled := False;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -