Delphi 經典遊戲程式設計40例 的學習 例9 可大可小 隨處移動的聚光燈處理
阿新 • • 發佈：2022-02-04
unit rei09; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TR09 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; tmr1: TTimer; procedure FormCreate(Sender: TObject); procedure tmr1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure FormClose(Sender: TObject;var Action: TCloseAction); private { Private declarations } procedure MakeSpot; procedure SbanDi(Sary:array of Byte; 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; //592 DTate = Tate * 16; //432 PtFull = 16; var R09: TR09; LoadBmap,XpatBmap,BackBmap,SpotBmap,MakeBmap : TBitmap; PX,PY :Byte; n,SpotR: Word; SpotX,SpotY : Integer; RectL,RectB,RectS,RectM,RectD : TRect; MoveS : Byte =0; Xadd:ShortInt=2; Yadd:ShortInt=2; Radd : ShortInt= 0; Spr00 : array[0..(31*17+1)] of Byte =( 31, 17, 19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19, 19,19,19,19,19,19,19,19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,19,19,19,19,19, 0, 0,19,19,19,19,19,19, 0, 0, 0,19,19,19,19,19, 0, 0,19,19,19,19,19,19,19, 19, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19, 0,19, 0, 0,19, 0, 0,19, 19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 0,19,19,19,19,19, 0, 0, 0,19,19,19,19,19, 0, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 19, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0, 0, 0, 0,19,19,19,19,19, 0, 0,19,19,19, 0, 0, 0, 0, 0, 0,19,19,19,19,19, 0, 0, 0, 0,19,19,19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19, 19,19,19,19,19,19,19,19 ); implementation {$R *.dfm} procedure TR09.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 + 32; BackBmap.Height := DTate + 32; for Y:=0 to (Tate -1) do for X:=0 to (Yoko -1) do PatDi(15,X*16+16,Y*16 +16,BackBmap); // 繪製SPR00 圖案 SbanDi( Spr00,66,96,BackBmap); //製作用點陣圖，塗黑 MakeBmap := TBitmap.Create; MakeBmap.Width := BackBmap.Width; MakeBmap.Height := BackBmap.Height; MakeBmap.Canvas.Brush.Color := clBlack; RectM := Rect(0,0,MakeBmap.Width,MakeBmap.Height); MakeBmap.Canvas.FillRect(RectM); //圓形模板 點陣圖 SpotBmap := TBitmap.Create; SpotBmap.Width := DYoko +32; // 神奇的地方，此點陣圖 高度 為Dyoko 寬度 ,否則最大圓 放 不下 SpotBmap.Height := DYoko +32; SpotR := 16 *6; // 畫圓 MakeSpot; //圖形初始座標 SpotX := DYoko div 2; SpotY := DTate div 2; end; procedure TR09.MakeSpot; begin //在圓形模板點陣圖上 製作圓形 //塗黑 SpotBmap.Canvas.Brush.Color := clBlack; RectS := Rect(0,0,SpotR *2 + 32, SpotR *2 +32); SpotBmap.Canvas.FillRect(RectS); //畫圓 SpotBmap.Canvas.Pen.Color := clWhite; SpotBmap.Canvas.Brush.Color := clWhite; SpotBmap.Canvas.Ellipse(16,16,SpotR *2 +16,SpotR * 2 +16); end; procedure TR09.SbanDi(Sary:array of Byte; X1,Y1:Integer;Bmap:TBitmap); var X,Y : Byte; begin n := 2; for Y :=0 to (Sary[1]-1) do for X := 0 to (Sary[0] -1 ) do begin if (X1 + X *16 >=0) and ( X1 + X *16<= DYoko + 16) and (Y1 + Y*16 >= 0) and (Y1 + Y*16 <= DTate +16) then PatDi(Sary[n],X1 + X *16,Y1 + Y*16,Bmap); n := n+ 1; end; end; procedure TR09.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 TR09.tmr1Timer(Sender: TObject); var Spx1,Spy1,Spx2,Spy2,Sbx1,Sbx2,Sby1,Sby2 :Integer; begin //移動，座標 越界判斷 if MoveS =1 then begin SpotX := SpotX + Xadd; SpotY := SpotY + Yadd; if SpotX <= 0 then begin SpotX :=0 ; Xadd := - Xadd; end else if SpotX >= DYoko then begin SpotX :=DYoko; Xadd := - Xadd; end; if SpotY <=0 then begin SpotY :=0 ; Yadd := - Yadd ; end else if SpotY >= Dtate then begin SpotY := DTate; Yadd := - Yadd ; end; end; //改變半徑 if Radd <> 0 then begin SpotR := SpotR + Radd; if (SpotR >=1 ) and (SpotR <= (SpotBmap.Width -32)div 2) then MakeSpot else begin SpotR := SpotR - Radd; //這裡為什麼要計算一下？ 最小和最大恢復一下？ 然後停止半徑改變？ Radd :=0; end; end; //圓形模板內的背景複製到繪製點陣圖 Spx1 := SpotX - SpotR ; Spy1 := SpotY - SpotR ; Spx2 := SpotX + SpotR ; Spy2 := SpotY + SpotR ; //越界裁剪 if Spx1 <0 then Spx1 := 0 ; if Spy1 < 0 then Spy1 :=0; // MakeBmap.Width = BackBmap.Width = DYoko + 32 if Spx2 >(MakeBmap.Width -32) then Spx2 := MakeBmap.Width -32; if Spy2 > (MakeBmap.Height - 32 ) then Spy2 := MakeBmap.Height-32 ; RectB := Rect(Spx1 + 16,Spy1 + 16,Spx2 + 16,Spy2 + 16); RectM := Rect(Spx1 + 16,Spy1 + 16,Spx2 + 16,Spy2 + 16); MakeBmap.Canvas.CopyMode := cmSrcCopy; MakeBmap.Canvas.CopyRect(RectM,BackBmap.Canvas ,RectB ); //將圓形模板圖樣複製 到繪製點陣圖 Sbx1 := 0 ; Sby1 := 0 ; Sbx2 := SpotR *2 + 32; Sby2 := SpotR *2 + 32; //圓形越界只用裁剪部分 ，相對論？ 裁剪的 圓形模板 if (SpotX - SpotR ) <0 then Sbx1 := -(SpotX - SpotR ) ; if (SpotY - SpotR )< 0 then Sby1 := -(SpotY - SpotR ); if (SpotX + SpotR )> (MakeBmap.Width -32) then Sbx2 := Sbx2 - (SpotX + SpotR -(MakeBmap.Width -32)); if (SpotY + SpotR ) > (MakeBmap.Height -32) then Sby2 := Sby2 - (SpotY + SpotR - (MakeBmap.Height -32 )); MakeBmap.Canvas.CopyMode := cmSrcAnd; RectS := Rect(Sbx1 ,Sby1,Sbx2,Sby2 ); RectM := Rect(Spx1 ,Spy1,Spx2 + 32,Spy2 + 32); MakeBmap.Canvas.CopyRect(RectM,SpotBmap.Canvas,RectS ); R09.Canvas.CopyMode := cmSrcCopy; RectM := Rect(16,16, DYoko + 16,DTate + 16) ; RectD := Rect(0,0,DYoko,DTate); R09.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM ) ; end; procedure TR09.Button1Click(Sender: TObject); begin Radd := 1; end; procedure TR09.Button2Click(Sender: TObject); begin Radd := -1; end; procedure TR09.Button3Click(Sender: TObject); begin Radd := 0 ; end; procedure TR09.Button4Click(Sender: TObject); begin MoveS := MoveS xor 1; end; procedure TR09.FormClose(Sender: TObject; var Action: TCloseAction); begin LoadBmap.Free; XpatBmap.Free; BackBmap.Free; SpotBmap.Free; MakeBmap.Free; end; end.
patdi ,sbandi 貼圖
makespot 畫圓
在 time1裡面 執行所有的動作。
圓形模板要裁剪
會有一個越界的現象，這個時候需要對 圓形模板進行裁剪
可以拿2張紙來進行 理解，
想象力不行，不能在腦袋裡抽象 的想象。
基本是 對著書敲程式碼的，並沒有自己編寫。
開始圓形模板要設定成