rei_32.pas

来自「Delphi经典游戏程序设计40例.pdf 中国铁道出版社出版 含源码」· PAS 代码 · 共 220 行

unit Rei_32;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, StdCtrls;

type
  TRei40_32 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ReDraw(Sender: TObject);
  private
    { Private 定义 }
    procedure WhiteDot;
  public
    { Public 定义 }
  end;

const
  Cdot = 6;              //  追捕时的点数
  Crad = 9 * Pi / 180;   //  追捕的方向变更单位

var
  Rei40_32: TRei40_32;
  //  定义重绘用的点阵图
  Make_Bmap: TBitmap;
  //  定义各种变量类型（Byte、Word、Integer、Extended、TColor、TRect）
  St, R1, R2: Byte;
  Cheight, Cwidth: Word;
  X1, Y1, X2, Y2: Integer;
  TR1, DR1, TR2, DR2, QTR, TX, TY, TDR: Extended;
  Col: TColor;
  Rect_D: TRect;

implementation

{$R *.DFM}

procedure TRei40_32.FormCreate(Sender: TObject);
begin
  //  设定Form属性
  Rei40_32.Height := 480;
  Rei40_32.Width := 640;
  Button1.Height := 41;
  Button1.Left := 580;
  Button1.Top := 16;
  Button1.Width := 41;
  Cheight := Rei40_32.ClientHeight;
  Cwidth := 570;
  //  储存重绘用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Cwidth;
  Make_Bmap.Height := Cheight;
end;

procedure TRei40_32.Timer1Timer(Sender: TObject);
begin
  with Rei40_32 do
    case St of
      //  若St＝0则将画面与变量初始化
      0: begin
        Rect_D := Rect(0, 0, Cwidth, Cheight);
        Canvas.Brush.Color := clBlack;
        Canvas.FillRect(Rect_D);
        Make_Bmap.Canvas.Brush.Color := clBlack;
        Make_Bmap.Canvas.FillRect(Rect_D);
        X1 := Cwidth div 2;
        Y1 := 40;
        R1 := 187;
        TR1 := 270 * Pi / 180;
        DR1 := 2 * Pi / 180;
        X2 := Cwidth div 2;
        Y2 := 117;
        R2 := 100;
        TR2 := 270 * Pi / 180;
        DR2 := 359 * Pi / 180;
        St := 1;
      end;
      //  将白点与黄点旋转
      1: begin
        WhiteDot;
        Canvas.Pixels[X2, Y2] := clBlack;
        Canvas.Pixels[X2, Y2 + 1] := clBlack;
        Canvas.Pixels[X2 + 1, Y2] := clBlack;
        Canvas.Pixels[X2 + 1, Y2 + 1] := clBlack;
        QTR := TR2;
        TR2 := TR2 + DR2;
        if TR2 >= 2 * Pi then
          TR2 := TR2 - 2 * Pi;
        X2 := X2 + Round(R2 * (Cos(TR2) - Cos(QTR)));
        Y2 := Y2 + Round(R2 * (Sin(TR2) - Sin(QTR)));
        Canvas.Pixels[X2, Y2] := clYellow;
        Canvas.Pixels[X2, Y2 + 1] := clYellow;
        Canvas.Pixels[X2 + 1, Y2] := clYellow;
        Canvas.Pixels[X2 + 1, Y2 + 1] := clYellow;
      end;
      //  黄点追捕白点
      2: begin
        WhiteDot;
        TX := X1 - X2;
        TY := Y1 - Y2;
        if TX = 0 then
          TDR := Pi / 2
        else
          TDR := ArcTan(TY / TX);
        if ((TX <= 0) and (TY <= 0)) or ((TX < 0) and (TY > 0)) then
          TDR := TDR + Pi;
        if TDR < 0 then
          TDR := TDR + 2 * Pi;
        TDR := TDR - TR2;
        if TDR < 0 then
          TDR := TDR + 2 * Pi;
        if TDR <> 0 then
        begin
          if TDR <= Pi then
            TR2 := TR2 + Crad
          else
            TR2 := TR2 + (2 * Pi - Crad);
          if TR2 >= 2 * Pi then
            TR2 := TR2 - 2 * Pi;
        end;
        if X2 < Cwidth - 1 then
        begin
          Canvas.Pixels[X2, Y2] := clBlue;
          Canvas.Pixels[X2, Y2 + 1] := clBlue;
          Canvas.Pixels[X2 + 1, Y2] := clBlue;
          Canvas.Pixels[X2 + 1, Y2 + 1] := clBlue;
          Make_Bmap.Canvas.Pixels[X2, Y2] := clBlue;
          Make_Bmap.Canvas.Pixels[X2, Y2 + 1] := clBlue;
          Make_Bmap.Canvas.Pixels[X2 + 1, Y2] := clBlue;
          Make_Bmap.Canvas.Pixels[X2 + 1, Y2 + 1] := clBlue;
        end;
        X2 := X2 + Round(Cdot * Cos(TR2));
        Y2 := Y2 + Round(Cdot * Sin(TR2));
        if X2 < Cwidth - 1 then
        begin
          Canvas.Pixels[X2, Y2] := clYellow;
          Canvas.Pixels[X2, Y2 + 1] := clYellow;
          Canvas.Pixels[X2 + 1, Y2] := clYellow;
          Canvas.Pixels[X2 + 1, Y2 + 1] := clYellow;
        end;  
        if (Abs(X1 - X2) <= 3) and (Abs(Y1 - Y2) <= 3) then
        begin
          St := 3;
          Canvas.Pixels[X1, Y1] := clBlack;
          Canvas.Pixels[X1, Y1 + 1] := clBlack;
          Canvas.Pixels[X1 + 1, Y1] := clBlack;
          Canvas.Pixels[X1 + 1, Y1 + 1] := clBlack;
        end;
      end;
      //  猎捕结束时
      3: begin
        if Col = clRed then
          Col := clYellow
        else
          Col := clRed;
        Canvas.Pixels[X2, Y2] := Col;
        Canvas.Pixels[X2, Y2 + 1] := Col;
        Canvas.Pixels[X2 + 1, Y2] := Col;
        Canvas.Pixels[X2 + 1, Y2 + 1] := Col;
      end;
    end;
end;

procedure TRei40_32.WhiteDot;
begin
  //  将白点旋转
  With Rei40_32 do
    Canvas.Pixels[X1, Y1] := clBlack;
    Canvas.Pixels[X1, Y1 + 1] := clBlack;
    Canvas.Pixels[X1 + 1, Y1] := clBlack;
    Canvas.Pixels[X1 + 1, Y1 + 1] := clBlack;
    QTR := TR1;
    TR1 := TR1 + DR1;
    if TR1 >= 2 * Pi then
      TR1 := TR1 - 2 * Pi;
    X1 := X1 + Round(R1 * (Cos(TR1) - Cos(QTR)));
    Y1 := Y1 + Round(R1 * (Sin(TR1) - Sin(QTR)));
    Canvas.Pixels[X1, Y1] := clWhite;
    Canvas.Pixels[X1, Y1 + 1] := clWhite;
    Canvas.Pixels[X1 + 1, Y1] := clWhite;
    Canvas.Pixels[X1 + 1, Y1 + 1] := clWhite;
  if Random(50) = 0 then
    if DR1 = 2 * Pi / 180 then
      DR1 := 358 * Pi / 180
    else
      DR1 := 2 * Pi / 180;
end;

procedure TRei40_32.Button1Click(Sender: TObject);
begin
  //  开始猎捕（旋转中）或Reset的指示
  if St = 1 then
    St := 2
  else
    St := 0;
end;

procedure TRei40_32.ReDraw(Sender: TObject);
begin
  //  重绘Form
  Rei40_32.Canvas.CopyMode := cmSrcCopy;
  Rei40_32.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_32.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将重绘用的点阵图释放掉
  Make_Bmap.Free;
end;

end.