planepanel.pas

这个软件是用Delphi 7开发的。 原本它是两个人在纸面上玩的益智游戏

{ *********************************************************************** }
{ 打飞机V1.0人机对奕版  PlanePanel核心控件                                }
{                                                                         }
{
作者:wqy
QQ:466798985
E-Mail:[e-mail]
你可以随意传播该源码，但请保证源码完整以及该文件头的存在
}

unit PlanePanel;
interface
uses windows, extctrls, classes, Graphics, controls, StdCtrls, sysutils, math, Dialogs;
type
   TPos = record
      x, y: Byte;
   end;
   TPosEx = record
      x, y: Byte;
      dir: Byte;
   end;
const
   DPlaneBody: array[1..4, 0..9, 0..1] of smallint = (
      ((0, 0), (-1, -2), (-1, -1), (-1, 0), (-1, 1), (-1, 2), (-2, 0), (-3, -1), (-3, 0), (-3, 1)),
      ((0, 0), (-2, 1), (-1, 1), (0, 1), (1, 1), (2, 1), (0, 2), (-1, 3), (0, 3), (1, 3)),
      ((0, 0), (1, -2), (1, -1), (1, 0), (1, 1), (1, 2), (2, 0), (3, 1), (3, 0), (3, -1)),
      ((0, 0), (-2, -1), (-1, -1), (0, -1), (1, -1), (2, -1), (0, -2), (-1, -3), (0, -3), (1, -3)));

   FillColor: array[0..8] of TColor = (clRed, clLime, clFuchsia, clGreen, clBlue, clTeal, clPurple, clYellow, clMoneyGreen);

type E_OnOneGridGuessed = procedure(x, y: Byte; GridType, PlaneIdx: Byte) of object;
   TBaseEvent = procedure of object;
   TBaseEvent2 = procedure(playerWin: Boolean) of object;

   TTenPoints = array[0..9] of TPos;
   TPlane = record
      Dirction: Byte; //1.Left 2.Right 3.Up 4.Down
      TenPoints: TTenPoints;
   end;
   TPlaneDrawer = record
      AppointedPlaneCou, NowPlaneCou: Byte;
      PlaneHeadSet: Boolean;
      PlaneHead: TPos;
      thisPlaneAvailable: Boolean;
      TenPoints: TTenPoints;
      LastPlane: Boolean;
      OldDirection: Byte; //飞机是否相同，避免闪烁
   end;
   TGridState = record
      GridType: Byte; //0.Plain Grid 1.Plane Head 2.Plane Body 3.Not body
      HoldPlaneIdx: Byte;
      Visited: Boolean;
   end;
   TGuessData = record
      tryCount: word;
      Hit: Byte;
      KnockDown: Byte;
   end;

   PTArr_GridState = ^TArr_GridState;
   TArr_GridState = array[0..19, 0..19] of TGridState;
   PTArr_Planes = ^TArr_Planes;
   TArr_Planes = array[1..9] of TPlane;

   PTPlanePanel = ^TPlanePanel;
   TPlanePanel= class(TPanel)
   private
      oldHLine, oldVLine: smallint;
      GridColor: TColor;
      GridActiveColor: TColor;
      HLabels, VLabels: array[0..19] of TLabel;

      FIfAPlaneDrawer: Boolean;
      FOnGridsMouseMove: TNotifyEvent;
      FOnSameGridGuessed: TBaseEvent;
      FOnOneGridGuessed: E_OnOneGridGuessed;
      FOnPlanesAllKnockedDown: TBaseEvent2;
      FOnNewGameStart: TBaseEvent;
      FComputerHitPlayerPlaneHead: TBaseEvent;
      FOnHandDrawPlaneBegin: TBaseEvent;
      FOnOnePlaneDrawed: TBaseEvent;

      FGuessMapGridPanel: TPlanePanel;
      FDrawPlaneGridPanel: TPlanePanel;

      procedure DrawAPlane;
      function DrawAPlaneExactly(Head: TPos; Direction: Byte; Color: TColor): Boolean;
      procedure EraseAPlane;
      procedure GridsMouseMove(Sender: TObject; Shift: TShiftState; X,
         Y: Integer);
      procedure GridsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
         Y: Integer);
   public
      ActiveGridX, ActiveGridY: Byte;
      PlaneDraw: TPlaneDrawer;
      Planes: TArr_Planes;
      GuessData: TGuessData;

      Grids: array[0..19, 0..19] of TShape;
      GridState: TArr_GridState;
      GridCou: Byte;

      Mode: Byte; //0.General 1.Drawing plane 2.Finished drawing plane 3.GuessMap User Guess  4.GuessMap Computer thinking 5.Game ended and player don't want to start another game

      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;

      procedure ChangeGridCou(NewGridCou: Byte);
      //IfAPlaneDrawer=True
      procedure NewGame(AutoGenerate: Boolean; _AppointedPlaneCou: Byte; con_Play: Boolean = True; ForOnlineGame: Boolean = False);
      procedure NewAsGuessMap;
      procedure CleanHeadSetButNotDrawnPlane; //清除已经开始画但还没画好的飞机
      procedure GenerateGame;
      procedure GeneratePlanes;
      //IfAPlaneDrawer=False
      procedure SetAGuessed(x, y: Byte);
      procedure ShowPlane(idx: Byte);
      procedure ComputerWin;
      procedure ComputerHitPlayerPlaneHead;
   published
      property IfAPlaneDrawer: Boolean read FIfAPlaneDrawer write FIfAPlaneDrawer;
      property OnGridsMouseMove: TNotifyEvent read FOnGridsMouseMove write FOnGridsMouseMove;
      property GuessMapGridPanel: TPlanePanel read FGuessMapGridPanel write FGuessMapGridPanel;
      property DrawPlaneGridPanel: TPlanePanel read FDrawPlaneGridPanel write FDrawPlaneGridPanel;

      property OnSameGridGuessed: TBaseEvent read FOnSameGridGuessed write FOnSameGridGuessed;
      property OnOneGridGuessed: E_OnOneGridGuessed read FOnOneGridGuessed write FOnOneGridGuessed;
      property OnPlanesAllKnockedDown: TBaseEvent2 read FOnPlanesAllKnockedDown write FOnPlanesAllKnockedDown;
      property OnNewGameStart: TBaseEvent read FOnNewGameStart write FOnNewGameStart;
      property OnComputerHitPlayerPlaneHead: TBaseEvent read FComputerHitPlayerPlaneHead write FComputerHitPlayerPlaneHead;
      property OnHandDrawPlaneBegin: TBaseEvent read FOnHandDrawPlaneBegin write FOnHandDrawPlaneBegin;
      property OnOnePlaneDrawed: TBaseEvent read FOnOnePlaneDrawed write FOnOnePlaneDrawed;
   end;

procedure Register;
function CheckPoint(x, y: smallint): Boolean;

implementation
var _GridCou: Byte;

constructor TPlanePanel.Create(AOwner: TComponent);
var i, t: Byte;
   cou: word;
begin
   inherited Create(AOwner);
   GridCou := 10;
   GridColor := clWhite;
   GridActiveColor := clblue;
   BevelOuter := bvnone;
   Mode := 0;
   PlaneDraw.OldDirection := 0;
   Caption := '';

   cou := 0;
   for i := 0 to 19 do
      for t := 0 to 19 do begin
         GridState[i, t].GridType := 0;
         Grids[i, t] := TShape.Create(Self);
         with Grids[i, t] do begin
            Parent := Self;
            Visible := False;
            Tag := cou;
            inc(cou);
            OnMouseMove := GridsMouseMove;
            OnMouseDown := GridsMouseDown;
         end;
      end;
   for i := 0 to 19 do begin
      HLabels[i] := TLabel.Create(Self);
      VLabels[i] := TLabel.Create(Self);
      with HLabels[i] do begin
         Parent := Self;
         Caption := chr(i + 65);
         Visible := False;
         Height := 11;
         Top := 2;
         Font.Style := Font.Style + [fsbold];
      end;
      with VLabels[i] do begin
         Parent := Self;
         Caption := IntToStr(i + 1);
         Visible := False;
         Height := 11;
         Font.Style := Font.Style + [fsbold];
      end;
   end;
   ChangeGridCou(GridCou);
end;

destructor TPlanePanel.Destroy;
var i, t: Byte;
begin
   for i := 0 to 19 do
      for t := 0 to 19 do
         Grids[i, t].Free;
   inherited destroy;
end;

procedure TPlanePanel.ChangeGridCou(NewGridCou: Byte);
var i, t: Byte; x, y, Step, size: Byte;
   cou: word;
begin
   GridCou := NewGridCou;
   _GridCou := NewGridCou;
   for i := 0 to 19 do begin
      HLabels[i].Visible := False;
      VLabels[i].Visible := False;
      for t := 0 to 19 do
         Grids[i, t].visible := False;
   end;
   y := 15; Step := (300 div NewGridCou) - 1; size := 300 div NewGridCou; cou := 0;
   for i := 0 to GridCou - 1 do begin
      x := 15;
      for t := 0 to GridCou - 1 do begin
         with Grids[i, t] do begin
            SetBounds(x + Step * t, y + Step * i, size, size);
            Brush.Color := GridColor;
            Visible := True;
            Tag := cou;
            inc(cou);
         end;
      end;
   end;
   cou := Grids[0, 0].Left + (Step div 2) - 3;
   for i := 0 to GridCou - 1 do begin
      HLabels[i].Left := Cou + i * Step;
      HLabels[i].Font.Color := clBlack;
      HLabels[i].Visible := True;
   end;
   dec(cou, 3);
   for i := 0 to GridCou - 1 do begin
      VLabels[i].Top := Cou + i * Step;
      VLabels[i].Font.Color := clBlack;
      VLabels[i].Visible := True;
   end;
   oldHLine := -1; oldVLine := -1;
end;

procedure TPlanePanel.GridsMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
begin
   ActiveGridY := (Sender as TComponent).tag div GridCou;
   ActiveGridX := (Sender as TComponent).tag mod GridCou;
   if Assigned(FOnGridsMouseMove) then FOnGridsMouseMove(Self);
   if OldVLine <> ActiveGridX then begin
      if OldVLine <> -1 then
         HLabels[OldVLine].Font.Color := clBlack;
      HLabels[ActiveGridX].Font.Color := GridActiveColor;
   end;
   if OldHLine <> ActiveGridY then begin
      if OldHLine <> -1 then
         VLabels[OldHLine].Font.Color := clBlack;
      VLabels[ActiveGridY].Font.Color := GridActiveColor;
   end;
   OldVLine := ActiveGridX;
   OldHLine := ActiveGridY;

   if Mode = 1 then begin //Drawing plane
      if PlaneDraw.PlaneHeadSet = False then exit;
      if (ActiveGridX = PlaneDraw.PlaneHead.X) and (ActiveGridY = PlaneDraw.PlaneHead.Y) then begin
         if PlaneDraw.LastPlane = False then planedraw.thisPlaneAvailable := False;
         exit;
      end;
      DrawAPlane;
   end;
end;

procedure TPlanePanel.DrawAPlane;
var k: Single; Direction: Byte; //1.Left 2
label Jump;
begin
   if ActiveGridX = PlaneDraw.PlaneHead.X then begin //根据斜率判断飞机方向
      if ActiveGridY > PlaneDraw.PlaneHead.Y then Direction := 2 else Direction := 4
   end else begin
      k := (ActiveGridY - PlaneDraw.PlaneHead.Y) / (ActiveGridX - PlaneDraw.PlaneHead.X);
      if (((k >= 0) and (k < 1)) or ((k >= -1) and (k < 0))) and (ActiveGridX > PlaneDraw.PlaneHead.X) then begin
         Direction := 3; goto Jump; end;
      if ((k < -1) and (ActiveGridX > PlaneDraw.PlaneHead.X)) or ((k >= 1) and (ActiveGridX < PlaneDraw.PlaneHead.X)) then begin
         Direction := 4; goto Jump; end;
      if (((k >= 0) and (k <= 1)) or ((k > -1) and (k < 0))) and (ActiveGridX < PlaneDraw.PlaneHead.X) then begin
         Direction := 1; goto Jump; end;
      if ((K <= -1) and (ActiveGridX < PlaneDraw.PlaneHead.X)) or ((k >= 1) and (ActiveGridX > PlaneDraw.PlaneHead.X)) then begin
         Direction := 2; goto Jump; end;
   end;
   Jump:
   if Direction <> PlaneDraw.OldDirection then begin
      PlaneDraw.OldDirection := Direction;
      if PlaneDraw.LastPlane = True then EraseAPlane; //擦去上一个飞机
      PlaneDraw.thisPlaneAvailable := DrawAPlaneExactly(PlaneDraw.PlaneHead, Direction, FillColor[PlaneDraw.NowPlaneCou]);
   end;