Delphi 经典游戏程序设计40例 的学习 例19 闪电

 

 

unit R19;

interface

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

type


  TRei19 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    
  private
    { Private declarations }
    procedure Thunder(X1,Y1,X2,Y2:Integer;W1,W2,W3:Word;TM:Byte;Bmap:TBitmap);
    procedure ChrDi(Xsiz,Ysiz:Byte;Dpon:Word;X1,Y1:Integer;Bmap:TBitmap);
    procedure PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);

  public
    { Public declarations }
  end;

const
  Yoko = 37;
  Tate = 27;
  DYoko = Yoko * 16;
  DTate = Tate * 16;
  PtFull = 16;

var
  Rei19: TRei19;
  LoadBmap,XpatBmap,MakeBmap,BackBmap : TBitmap;
  RectL,RectM,RectD,RectB : TRect;

  PX,PY,Ray,TC :Byte;
  ChX : Word = 300;
  ChY : Word = 360;
  ChM : ShortInt = 2;




  //复合图案0-1 数组
  SpDat : array[0..9] of Byte = (28,29,30,31, 64,65,80,81,96,97);
  


implementation

{$R *.dfm}

procedure TRei19.FormCreate(Sender: TObject);
var
  X,Y  : Byte;
begin
  LoadBmap := TBitmap.Create;
  LoadBmap.LoadFromFile(GetCurrentDir + '\Pat_Sample.bmp');
  XpatBmap := TBitmap.Create;
  XpatBmap.Width := 256;
  XpatBmap.Height := 256;
  RectL := Rect(0,0,256,256);
  XpatBmap.Canvas.CopyMode := cmSrcCopy;
  XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
  XpatBmap.Canvas.Brush.Color := clBlack;
  XpatBmap.Canvas.BrushCopy(RectL,LoadBmap,RectL,clWhite);
  XpatBmap.Canvas.CopyMode := cmMergePaint;
  XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);

  BackBmap := TBitmap.Create;
  BackBmap.Width := DYoko;
  BackBmap.Height := DTate;

  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko -1) do
      case Y of
        0..20: PatDi(1,X * 16,Y * 16,BackBmap);
        21..Tate - 1:PatDi(15,X * 16,Y * 16,BackBmap);
      end;

  for X := 0  to (Yoko -1) do
    PatDi(16,X * 16,Y * 16,BackBmap);
  ChrDi(2,2,0,280,10,BackBmap);


  MakeBmap := TBitmap.Create;
  MakeBmap.Width := DYoko + 32;
  MakeBmap.Height := DTate + 32;



end;

procedure TRei19.Timer1Timer(Sender: TObject);
var
  Th1,Th2,Th3 :Word;
  ThM : Byte;
begin
  MakeBmap.Canvas.CopyMode := cmSrcCopy;
  RectB := Rect(0,0,DYoko,DTate);
  RectM := Rect(16,16,DYoko + 16,DTate + 16);
  MakeBmap.Canvas.CopyRect(RectM,BackBmap.Canvas,RectB);

  ChX := ChX + ChM;
  if (ChX < 0) or (ChX > DYoko - 32) then
  begin
    ChM := - ChM;
    ChX := ChX + ChM;
   end;
   ChrDi(2,3,4,ChX + 16,ChY + 16,MakeBmap);

   case Ray of
     1:begin
       Th1 := 0;
       Th2 := 16;
       Th3 := 0;
       ThM := 1;
     end;
     2:begin
       Th1 := 4;
       Th2 := 20;
       Th3 := 6;
       ThM := 4;
     end;
     3:begin
       Th1 := 8;
       Th2 := 32;
       Th3 := 286;
       ThM := 6;
     end;
   end;

   if Ray <> 0 then
     Thunder(296 + 16,43 + 16,ChX + 32,ChY + 15,Th1,Th2,Th3,ThM,MakeBmap);

   Rei19.Canvas.CopyMode := cmSrcCopy;
   RectD := Rect(0,0,DYoko,DTate);
   Rei19.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM);


end;


procedure TRei19.Thunder(X1,Y1,X2,Y2:Integer;W1,W2,W3:Word;TM:Byte;Bmap:TBitmap);
var
  Xadd,TX,TY,LX,RX : Integer;
  Yadd,Wadd,Wran,n : Byte;
begin
  TC := TC xor 1;
  if TC = 0 then
    Bmap.Canvas.Pen.Color := clWhite
  else
    Bmap.Canvas.Pen.Color := clYellow;
  Bmap.Canvas.Pen.Width := 2;

  for n := 1 to TM do
  begin
    Wran := Random(4) + (Y2 - Y1) div 40 + 1;
    Xadd := (X2 - X1) div Wran;
    Yadd := (Y2 - Y1) div Wran + 1;
    Wadd := W3 div Wran;
    LX := X1;
    RX := X1;
    TX := X1 - W1 + Random(W1 * 2 + 1);
    TY := Y1;
    BackBmap.Canvas.MoveTo(TX,TY);
    while TY < Y2 do
    begin
      TY := TY + Yadd;
      LX := LX + Xadd - Wadd;
      RX := RX + Xadd + Wadd;
      if TX - Wadd < LX  then
        TX := RX + W2 - Random(W2 * 2 + Wadd + 1)
      else if TX + Wadd > TX then
        TX := TX + W2 - Random(W2 * 2 + Wadd + 1)
      else
       TX := TX + Xadd - Wadd - W2 + Random((W2 + Wadd)* 2 + 1);

      if TX >= Y2 then
      begin
        TY := Y2;
        if TX < X2 - W3  then
          TX := X2 - W3 + Random(Wadd + 1)
        else if TX > X2 + W3 then
          TX := X2 + W3 - Random(Wadd + 1);
      end;
      Bmap.Canvas.LineTo(TX,TY);
    end;
  end;
end;

procedure TRei19.ChrDi(Xsiz,Ysiz:Byte;Dpon:Word;X1,Y1:Integer;Bmap:TBitmap);
var
  CDX,CDY :Byte;
begin
  for CDY := 0 to (Ysiz - 1) do
    for CDX := 0 to (Xsiz -1 ) do
    begin
      if (X1 + CDX * 16 >= 0 ) and  (X1 + CDX * 16 <= DYoko + 16) and
         (Y1 + CDY * 16 >= 0 ) and (Y1 + CDY * 16 <= DTate + 16 ) then
        PatDi(SpDat[Dpon],X1 + CDX * 16,Y1 + CDY * 16,Bmap);
      Dpon := Dpon + 1;
    end;

end;
procedure TRei19.PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);
begin
PX  := (Pnum and $F) * 16;
  PY := Pnum and $F0 ;
  RectL := Rect(PX,PY,PX + 16,PY + 16);
  RectD := Rect(X1,Y1,X1 + 16,Y1 + 16);

  if Pnum <> 0 then
   if Pnum >= PtFull  then

    begin
      Bmap.Canvas.CopyMode := cmSrcPaint;
      Bmap.Canvas.CopyRect(RectD,XpatBmap.Canvas,RectL);
      Bmap.Canvas.CopyMode := cmSrcAnd;
      Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);
    end
   else
    begin
      Bmap.Canvas.CopyMode := cmSrcCopy;
      Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);
    end;
end;


procedure TRei19.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Ray := 1;
end;

procedure TRei19.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Ray := 0;
end;

procedure TRei19.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Ray := 2;
end;

procedure TRei19.Button2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Ray :=  0;
end;

procedure TRei19.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Ray := 3;
end;

procedure TRei19.Button3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Ray :=  0;
end;





procedure TRei19.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoadBmap.Free;
  XpatBmap.Free;
  MakeBmap.Free;
  BackBmap.Free;
end;



end.

这个用线段来模拟闪电，

程序结构能看明白，

但是闪电的模拟看的头晕，看起来也不是什么算法，而是各种变量的限制

 

 

算了，不研究了，

练个敲键盘是熟练度吧。