Delphi 经典游戏程序设计40例 的学习 例14 各种画面改变的化妆法

 

 

unit R14;

interface

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

type
  Trei14 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure DiBack0;
    procedure DiBack1;
    procedure FmDip;
    procedure DiBox(X1,Y1,X2,Y2:Word);
    procedure ChrDi(Xsiz,Ysiz:Byte;Dpon : Word;X1,Y1:Integer;Bmap:TBitmap);
    procedure PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);
    { Public declarations }
  end;

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

var
  rei14: Trei14;
  LoadBmap,XpatBmap,BpatBmap,Back0Bmap,Back1Bmap,MakeBmap:TBitmap;
  P,PX,PY,nX,nY:Byte;
  Backs:Byte = 0;
  Chan : Byte = 255;
  m,Sc : Word;
  RectL,RectM,RectB,RectS,RectD : TRect;

  Spsiz : array[0..(MaxSp * 2 - 1)] of Byte = (2,2, 31,17, 2,2, 31,21);
  SpPon : array[0..(MaxSp - 1)] of Word;
  SpDat : array[0..(8 + 31 * 38 - 1)] of Byte = (
  28,29,30,31,
    19,19,19,19,19,19,19,19,19,19,19,19,19,19, 0, 0,
      0,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,12,12,12,12,12, 0, 0, 0,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12, 0, 0,12,12,12,12,12,12, 0,
    12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0,12,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12, 0,
      12, 0, 0, 0, 0, 0,12, 0,12, 0, 0, 0, 0, 0,12,
    0,12,12,12,12,12, 0, 0, 0,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12, 0, 0,12,12,12,12,12,12, 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,
    32,33,48,49,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
    12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,12, 0, 0,
      0,12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,12,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12, 0, 0,
      0,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
    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, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      0,19,19,19,19,19, 0, 0,19, 0, 0, 0, 0, 0,19,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,19, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0,19, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19,19, 0, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0,19, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19, 0,
      19, 0, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0,19, 0,
    19,19,19,19,19,19,19, 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, 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,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
      12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
    12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
      2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,12,
    12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,
      12,12,12,12,12,12,12,12,12,12,12,12,12,12,12);




implementation

{$R *.dfm}

procedure Trei14.FormCreate(Sender: TObject);
var
  n : Word;
begin
  rei14.Canvas.CopyMode := cmSrcCopy;
  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);

  BpatBmap := TBitmap.Create;
  BpatBmap.Width := 8;
  BpatBmap.Height := 8;

  Sc := 0;
  for n := 0 to (MaxSp - 1) do
  begin
    SpPon[n] := Sc;
    Sc := Sc + Spsiz[n * 2] * SpSiz[n * 2 + 1];
  end;

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

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

  DiBack0;
  DiBack1;

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


end;

procedure Trei14.DiBack0;
var
  x,y : Byte;
begin
  for y := 0 to (Tate - 1) do
    for x := 0 to (Yoko - 1) do
      PatDi(7,x * 16,y * 16,Back0Bmap);
    ChrDi(SpSiz[0],SpSiz[1],SpPon[0],282,72,Back0Bmap);
    ChrDi(SpSiz[2],SpSiz[3],SpPon[1],50,80,Back0Bmap);
end;


//将原有图案2复制至BACK1BMAP
procedure Trei14.DiBack1;
var
  x,y :Byte;
begin
  for y := 0 to (Tate - 1) do
    for x := 0 to (Yoko - 1) do
      PatDi(15,x * 16,y * 16,Back1Bmap);
    ChrDi(SpSiz[4],SpSiz[5],SpPon[2],282,56,Back1Bmap);
    ChrDi(SpSiz[6],SpSiz[7],SpPon[3],50,48,Back1Bmap);
end;

//描绘至绘制点阵图上并显示在画面
procedure Trei14.FmDip;
begin
  Chan := 0 ;
  MakeBmap.Canvas.CopyMode := cmSrcCopy;
  RectM := Rect(16,16,DYoko + 16,DTate + 16);
  RectS := Rect(0,0,DYoko,DTate);
  if Backs = 0 then
    begin
      MakeBmap.Canvas.CopyRect(RectM,Back0Bmap.Canvas,RectS);
      rei14.Canvas.Draw(0,0,Back0Bmap);
    end
  else begin
    MakeBmap.Canvas.CopyRect(RectM,Back1Bmap.Canvas,RectS);
    rei14.Canvas.Draw(0,0,Back1Bmap);
  end;
end;

//将非显示的原有图案的一部分描绘至绘制点阵图
procedure Trei14.DiBox(X1,Y1,X2,Y2:Word);
begin
  MakeBmap.Canvas.CopyMode := cmSrcCopy;
  RectS := Rect(X1,Y1,X2,Y2);
  RectM := Rect(X1 + 16,Y1 + 16,X2 + 16,Y2 + 16);
  if Backs = 0 then
    MakeBmap.Canvas.CopyRect(RectM,Back0Bmap.Canvas,RectS)
  else
    MakeBmap.Canvas.CopyRect(RectM,Back1Bmap.Canvas,RectS);
end;

procedure Trei14.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 Trei14.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 Trei14.FormPaint(Sender: TObject);
begin
  RectM := Rect(16,16,DYoko + 16,DTate + 16);
  RectD := rect(0,0,DYoko,DTate);
  rei14.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM);
end;

procedure Trei14.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoadBmap.Free;
  XpatBmap.Free;
  BpatBmap.Free;
  Back0Bmap.Free;
  Back1Bmap.Free;
  MakeBmap.Free;

end;

procedure Trei14.Button1Click(Sender: TObject);
begin
  if Chan = 0 then
    Chan :=1;
end;

procedure Trei14.Button2Click(Sender: TObject);
begin
  if Chan =0 then
    Chan := 2;
end;

procedure Trei14.Button3Click(Sender: TObject);
begin
  if Chan = 0 then
    Chan := 1;
end;

procedure Trei14.Button4Click(Sender: TObject);
begin
  if Chan = 0 then
    Chan := 1;
end;

procedure Trei14.Button5Click(Sender: TObject);
begin
  if Chan = 0 then
    begin
      FmDip;
      Backs := Backs xor 1;
    end;
end;

procedure Trei14.Timer1Timer(Sender: TObject);
var
  x,y : Byte;
  n : Word;
begin
  case Chan of
    1..4 : begin
      Chan := Chan + 10;
      m := 0;
      nX := 0;
      nY := 0;
    end;

    11: begin
      if Yoko > Tate then
      begin
        x := DYoko div 2 - (Yoko - Tate + m + 1) * 8;
        y := DTate div 2 - (m + 1) * 8;
      end
      else begin
        x := DYoko div 2 - (m + 1) * 8;
        y := DTate div 2 - (Tate - Yoko + m + 1) * 8;
      end;

      Dibox(x,y,DYoko - x,DTate -y);
      m := m + 1;
      if (m >= Yoko) or (m >= Tate) then
      begin
        Chan := 0;
        Backs := Backs xor 1;
      end;

      RectM := Rect(16,16,DYoko + 16,DTate + 16);
      RectD := Rect(0,0,DYoko,DTate);
      rei14.Canvas.CopyRect(RectD,MakeBmap.Canvas,  RectM);


    end;

    12:begin
      x := nX;
      y := nY;
      if m >0 then
      begin
        for n:= 0 to (Yoko -1) do
        begin
          x := (x + 36) mod Yoko;
          y := (y + 26) mod Tate;
          DiBox(x*16,y*16,x*16+16,y*16+16);
        end;
        nX := x;
        nY := y;
      end;

      if m < Tate then
      begin
        MakeBmap.Canvas.CopyMode := cmSrcPaint;
        for n := 0 to (Yoko -1 ) do
        begin
          x := (x + 36 ) mod Yoko;
          y := (y + 26) mod Tate;
          RectS := Rect(x * 16,y * 16,x * 16 + 16,y * 16 + 16);
          RectM := Rect(x * 16 + 16,y * 16 + 16,x * 16 + 32,y * 16 + 32);

          if Backs = 0 then
            MakeBmap.Canvas.CopyRect(RectM,Back0Bmap.Canvas, RectS)
          else
            MakeBmap.Canvas.CopyRect(RectM,Back1Bmap.Canvas,RectS);
          MakeBmap.Canvas.CopyRect(RectM,MakeBmap.Canvas,RectM);
        end;
      end; 

      m := m+ 1;
      if m = Tate + 1 then
      begin
        Chan := 0;
        Backs := Backs xor 1;
      end;

      RectM := Rect(16,16,DYoko + 16,DTate + 16);
      RectD := Rect(0,0,DYoko,DTate);
      rei14.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM);

    end;

    255 :begin
      FmDip;
      Backs := Backs xor 1;
    end;

    end;
end;

end.

例14 是 例12，例13 的延伸

 

整个程序的结构类似

依旧是PATDI 处理单个图案

CHRDI 处理复合图案

diback0,1 处理2个背景图案

DIBOX则用来 在DIBACK0,1里面 挖补图案

FMDIP 则用来2个背景图案的交替显示

用SpSiz,sppon,spdat 这种复合图案 的数据结构 的优势终于表现出了，可以存放大量的复合图案数据

好像传奇的图案就是这种类似的结构。

 

只做了效果1，2，后面的3，4没有做了，感觉那个是对算法的体现