⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rei_15.pas

📁 delhpi经典游戏程序设计40例,大家不防下载看看.源码全在项目文件里!
💻 PAS
字号:
unit Rei_15;

interface

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

type
  TRei40_15 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
    procedure ShiftX(MX: Byte; Y1: Word);
    procedure ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; X1, Y1: Integer;
      Bmap: TBitmap);
    procedure PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
  public
    { Public 定义 }
  end;

const
  Yoko = 37;           //显示的横向图样数
  Tate = 27;           //显示的纵向图样数
  DYoko = Yoko * 16;   //显示的横向点数
  DTate = Tate * 16;   //显示的纵向点数
  PtFull = 16;         //全面显示(不要重叠显示)的图样数
  MaxSp = 2;           //本次使用的复合图样总数
  WaveY = 3;           //摇动的纵深单位(点数)
  Tmax =  4;           //最大摇动幅度(点数)

var
  Rei40_15: TRei40_15;
  //  定义背景用、载入用、去除模版用与绘制用的点阵图
  Back_Bmap: TBitmap;
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量(Byte类型、Word类型、ShortInt类型、TRect类型)
  PX, PY, CDX, CDY, TopX, SFX: Byte;
  Sc, SFY: Word;
  TopWX, WX: ShortInt;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  //  复合图样数组
  SpSiz: array[0..(MaxSp * 2 - 1)] of Byte = (2,2, 2,3);
  SpPon: array[0..(MaxSp - 1)] of Word;
  SpDat: array[0..9] of Byte = (
    74, 75, 90, 91,
    64, 65, 80, 81, 96, 97
  );

implementation

{$R *.DFM}

procedure TRei40_15.FormCreate(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
  n: Word;
begin
  //  设定Form属性
  Rei40_15.Height := 480;
  Rei40_15.Width := 640;
  //  载入图样
  Load_Bmap := TBitmap.Create;
  Load_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Pat_Sample.bmp');
  //  储存去除用点阵图
  Xpat_Bmap := TBitmap.Create;
  Xpat_Bmap.Width := 256;
  Xpat_Bmap.Height := 256;
  //  制作去除用点阵图
  Rect_L := Rect(0, 0, 256, 256);
  Xpat_Bmap.Canvas.CopyMode := cmSrcCopy;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  Xpat_Bmap.Canvas.Brush.Color := clBlack;
  Xpat_Bmap.Canvas.BrushCopy(Rect_L, Load_Bmap, Rect_L, clWhite);
  Xpat_Bmap.Canvas.CopyMode := cmMergePaint;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  //  零件贴图指标数组的初始设定
  Sc := 0;
  for n := 0 to (MaxSp - 1) do
  begin
    SpPon[n] := Sc;
    Sc := Sc + SpSiz[n * 2] * SpSiz[n * 2 + 1];
  end;
  //  储存背景点阵图并绘制图样
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := DYoko;
  Back_Bmap.Height := DTate;
  for Y := 0 to (Tate div 2 - 1) do
    for X := 0 to (Yoko div 2 - 1) do
      ChrDi(SpSiz[0], SpSiz[1], SpPon[0], X * 32, Y * 32, Back_Bmap);
  ChrDi(SpSiz[2], SpSiz[3], SpPon[1], 146, 180, Back_Bmap);
  ChrDi(SpSiz[2], SpSiz[3], SpPon[1], 414, 180, Back_Bmap);
  //  储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
  //  变量的初始设定
  TopWX := 1;
end;

procedure TRei40_15.Timer1Timer(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
begin
  //  摇动背景画面并绘制至Make_Bmap上
  TopX := TopX + TopWX;
  if (TopX = 0) or (TopX = Tmax) then
    TopWX := -TopWX;
  SFX := TopX;
  SFY := 0;
  WX := TopWX;
  repeat
    ShiftX(SFX, SFY);
    SFX := SFX + WX;
    if (SFX = 0) or (SFX = Tmax) then
      WX := -WX;
    SFY := SFY + WaveY;
  until SFY > DTate;
  //  绘制固定不动的部分
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
      if (Y = 0) or (Y = Tate - 1) or (X = 0) or (X = Yoko - 1) then
        PatDi(12, X * 16 + 16, Y * 16 + 16, Make_Bmap);
  ChrDi(SpSiz[2], SpSiz[3], SpPon[1], 280 + 16, 180 + 16, Make_Bmap);
  //  将绘制点阵图显示至Form上
  Rei40_15.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_15.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_15.ShiftX(MX: Byte; Y1: Word);
begin
  //  将背景按指定点数做回圈处理并绘制至Make_Bmap上
  Rect_B := Rect(0, Y1, DYoko - MX, Y1 + WaveY);
  Rect_D := Rect(MX + 16, Y1 + 16, DYoko + 16, Y1 + WaveY + 16);
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
  if MX <> 0 then
  begin
    Rect_B := Rect(DYoko - MX, Y1, DYoko, Y1 + WaveY);
    Rect_D := Rect(16, Y1 + 16, MX + 16, Y1 + WaveY + 16);
    Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
  end;
end;

procedure TRei40_15.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 TRei40_15.PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  将指定的角色绘制至指定点阵图的指定位置上(重叠显示适用)
  PX := (Pnum and $F) * 16;
  PY := Pnum and $F0;
  Rect_L := Rect(PX, PY, PX + 16, PY + 16);
  Rect_D := Rect(X1, Y1, X1 + 16, Y1 + 16);
  if Pnum <> 0 then
    if Pnum >= PtFull then
    begin
      Bmap.Canvas.CopyMode := cmSrcPaint;
      Bmap.Canvas.CopyRect(Rect_D, Xpat_Bmap.Canvas, Rect_L);
      Bmap.Canvas.CopyMode := cmSrcAnd;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end
    else begin
      Bmap.Canvas.CopyMode := cmSrcCopy;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end;
end;

procedure TRei40_15.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、背景用、绘图用的点阵图释放掉
  Back_Bmap.Free;
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Make_Bmap.Free;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -