Delphi 經典遊戲程式設計40例 的學習 例10 自動滾動功能與簡易零件貼圖
阿新 • • 發佈：2022-02-05
unit rei10; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type // 定義精靈 記錄型別 TpatDt = record Used : Byte; Sban : Byte; Xpos : Integer; Ypos : Integer; Smov : Byte; Sadd : Byte; end; TR10 = class(TForm) tmr1: TTimer; procedure FormCreate(Sender: TObject); procedure tmr1Timer(Sender: TObject); procedure FormClose(Sender: TObject;var Action: TCloseAction); private { Private declarations } procedure YScroll; procedure ChrDi(Sban:Byte;X1,Y1:Integer;Bmap:TBitmap); 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; Dtate = Tate *16; PtFull = 16; //全面顯示 圖案數， MaxMap = 370; //圖案最大數 ScDot = 2; // 滾動點數 var R10: TR10; // 定義 載入用，去除模板用，背景用，繪製用 點陣圖， LoadBmap,XpatBmap,BackBmap,MakeBmap: TBitmap; P,PX,PY,n :Byte; RectL,RectB,RectM,RectD :TRect; ChPon :array[0..9] of TpatDt; Yplus :array[0..20] of Byte = ( 0,10,19,27,34,40,45,49,52,54,55, 55,54,52,49,45,40,34,27,19,10); Smap :array[0..(Yoko -1),0..(MaxMap -1)] of Byte; // 圖案點，滾動點，繪製點 的定義，初始 設定 Mpoint : Word = 0; Spoint : Integer = 16; Ypoint : Integer = 0; //複合圖案 陣列 Spr00 : array[0..5] of Byte =(2,2,24,25,26,27); Spr01 : array[0..5] of Byte = (2,2,28,29,30,31); Spr02 : array[0..5] of Byte = (2,2,32,33,48,49); implementation {$R *.dfm} procedure TR10.YScroll; //影象滾動 var X : Byte; begin MakeBmap.Canvas.CopyMode := cmSrcCopy; if Spoint <= 16 then begin RectB := Rect(0,Spoint,DYoko,Dtate + Spoint); RectD := Rect(16,16,DYoko + 16,Dtate + 16); MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB); end else begin RectB := Rect(0,Spoint,DYoko,Dtate + 16); RectD := Rect(16,16,Dyoko + 16,Dtate + 32- Spoint); MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB); RectB := Rect(0,0,DYoko,Spoint - 16); RectD := Rect(16,Dtate + 32 - Spoint,DYoko + 16,Dtate + 16); MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB); end; //ScDot:=2,單次滾動點數 ，Spoint 累計 滾動點數 Spoint := Spoint - ScDot; Ypoint := Ypoint - ScDot; if Spoint < 0 then Spoint := Dtate + 16 - ScDot; if Ypoint < 0 then Ypoint := Dtate + 16 - ScDot; //累計滾動過16點，繪製一行 if (Spoint and 15 ) = 0 then begin for X := 0 to (Yoko -1 ) do PatDi(Smap[X, Mpoint],X * 16,Ypoint,BackBmap ); Mpoint := Mpoint + 1; // 最大 繪製 ，歸零 if Mpoint = MaxMap then Mpoint := 0 ; end; end; procedure TR10.ChrDi(Sban:Byte;X1,Y1:Integer;Bmap:TBitmap); begin case Sban of 0: SbanDi(Spr00,X1 + 16,Y1+ 16,Bmap); 1: SbanDi(Spr01,X1 + 16,Y1 + 16,Bmap); 2: SbanDi(Spr02, X1 + 16,Y1 + 16,Bmap); end; end; procedure TR10.SbanDi(Sary:array of Byte;X1,Y1:Integer;Bmap:TBitmap ); var X :Byte; Y :Word; 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 <= Date + 16) then PatDi(Sary[n],X1 + X * 16, Y1 + Y *16,Bmap); n := n +1; end; end; procedure TR10.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 TR10.FormCreate(Sender: TObject); var X,Cn :Byte; Y :Word; begin R10.Height := 480; R10.Width := 640; 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 ); //設定背景圖案 for Y := 0 to (MaxMap -1) do for X := 0 to (Yoko -1 ) do begin if(X>(Y mod Yoko)) and ((X+ (Y mod Yoko)+1)< Yoko) then P := 15 else if (X < ( Y mod Yoko ))and ((X + (Y mod Yoko )+1) > Yoko) then P := 15 else if Y < Yoko then P := 12 else if Y < Yoko *2 then P := 13 else if Y < Yoko *3 then P := 14 else if Y < Yoko * 4 then P:= 2 else if Y < Yoko * 5 then P:= 14 else if Y < Yoko *6 then P := 13 else if Y < Yoko * 7 then P:= 12 else if Y < Yoko * 8 then P:= 13 else if Y < Yoko * 9 then P:= 14 else P := 15; Smap[X,Y ] := P; end; BackBmap := TBitmap.Create; BackBmap.Width:= DYoko; BackBmap.Height:= Dtate + 16; for Y := 0 to Tate do begin for X := 0 to ( Yoko -1 ) do PatDi(Smap[X,Y ],X * 16,(Tate - Y )* 16,BackBmap); Mpoint := Mpoint + 1; end; MakeBmap := TBitmap.Create; MakeBmap.Width := DYoko + 32; MakeBmap.Height := Dtate + 32; //設定精靈 for Cn := 0 to 4 do begin ChPon[Cn *2 ].Used := 1; ChPon[Cn * 2].Sban := 0 ; ChPon[Cn * 2].Xpos := Cn *90 + 100; ChPon[Cn *2 ].Ypos := (Cn and 1 )* 100 + 200; ChPon[Cn *2 ].Smov := 0; ChPon[Cn *2 ].Sadd := 0; ChPon[Cn *2 + 1].Used := 1; ChPon[Cn * 2+1 ].Sban := (Cn and 1 ) +1 ; ChPon[Cn * 2+1 ].Xpos := Cn *90 + 100; ChPon[Cn *2 +1 ].Ypos := 0; ChPon[Cn *2 +1 ].Smov := 1; ChPon[Cn *2 +1 ].Sadd := Random(21); end; end; procedure TR10.tmr1Timer(Sender: TObject); var Cn : Byte; begin // 計算精靈的位置 for Cn := 0 to 4 do if (ChPon[Cn *2 +1].Used = 1) and (ChPon[Cn *2 +1 ].Smov =1) then begin ChPon[Cn *2 + 1 ].Ypos := ChPon[Cn *2].Ypos - Yplus[ChPon[Cn *2 +1].Sadd]; ChPon[Cn *2 +1 ].Sadd := ChPon[Cn *2 +1].Sadd +1; if ChPon[Cn *2+1].Sadd > 20 then ChPon[Cn *2 +1].Sadd := 0; end; YScroll; // 繪製精靈 for Cn := 0 to 9 do if ChPon[Cn].Used = 1 then ChrDi(ChPon[Cn].Sban,ChPon[Cn].Xpos, ChPon[Cn].Ypos,MakeBmap); R10.Canvas.CopyMode := cmSrcCopy; RectM := Rect(16,16, DYoko + 16,DTate + 16); RectD := Rect(0,0,DYoko,DTate); R10.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM); end; procedure TR10.FormClose(Sender: TObject; var Action: TCloseAction); begin LoadBmap.Free; XpatBmap.Free; BackBmap.Free; MakeBmap.Free; end; end.