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

📄 rei_16.pas

📁 Delphi经典游戏程序设计40例.pdf 中国铁道出版社出版 含源码
💻 PAS
字号:
unit Rei_16;

interface

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

type
  TRei40_16 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
    procedure MosMake(X1, Y1: Word);
  public
    { Public 定义 }
  end;

const
  Yoko = 37;           //显示的横向图案数
  Tate = 27;           //显示的纵向图案数
  DYoko = Yoko * 16;   //显示的横向点数
  DTate = Tate * 16;   //显示的纵向点数
  MsSize = 8;          //1小块马赛克的大小(点数)
  MsYoko = 8;          //马赛克的横向数目
  MsTate = 8;          //马赛克的纵向数目

var
  Rei40_16: TRei40_16;
  //  定义原有图像用与绘制用的点阵图
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量(Byte类型、Integer类型、ShortInt类型、TRect类型)
  Mpon: Byte;
  Mc: Byte = 1;
  MX: Integer = 312 - 48;
  MY: Integer = 224 - 48;
  Xadd, Yadd: ShortInt;
  Rect_B, Rect_D, Rect_M: TRect;

implementation

{$R *.DFM}

procedure TRei40_16.FormCreate(Sender: TObject);
begin
  //  设定Form属性
  Rei40_16.Height := 480;
  Rei40_16.Width := 640;
  Button1.Height := 25;
  Button1.Left := 603;
  Button1.Top := 16;
  Button1.Width := 25;
  Button2.Height := 25;
  Button2.Left := 603;
  Button2.Top := 56;
  Button2.Width := 25;
  Button3.Height := 25;
  Button3.Left := 603;
  Button3.Top := 96;
  Button3.Width := 25;
  Button4.Height := 25;
  Button4.Left := 603;
  Button4.Top := 136;
  Button4.Width := 25;
  Button5.Height := 25;
  Button5.Left := 603;
  Button5.Top := 192;
  Button5.Width := 25;
  //  储存背景用点阵图并载入原有图像
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := DYoko;
  Back_Bmap.Height := DTate;
  Back_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Bunny.bmp');
  //  储存绘制点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
  Make_Bmap.Palette := Back_Bmap.Palette;
end;

procedure TRei40_16.Timer1Timer(Sender: TObject);
begin
  //  修改马赛克的座标
  MX := MX + Xadd;
  MY := MY + Yadd;
  if MX < 0 then
    MX := 0;
  if MX > DYoko - MsYoko * MsSize then
    MX := DYoko - MsYoko * MsSize;
  if MY < 0 then
    MY := 0;
  if MY > DTate - MsTate * MsSize then
    MY := DTate - MsTate * MsSize;
  //  将打上马赛克的原有图像绘制至绘制点阵图上
  Mpon := (Mpon + Mc) and 63;
  MosMake(MX, MY);
  //  将绘制点阵图显示在Form上
  Rei40_16.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_16.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_16.MosMake(X1, Y1: Word);
var
  //  定义局部变量
  X, Y: Byte;
begin
  //  将原有图像复制至Make_Bmap上,并打上马赛克
  Rect_B := Rect(48, 24, 640, 480 - 24);
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Make_Bmap.Canvas.CopyRect(Rect_M, Back_Bmap.Canvas, Rect_B);
  for X := 0 to (MsYoko - 1) do
    for Y := 0 to (MsTate - 1) do
      begin
        Rect_M := Rect(X1 + X * MsSize + 16, Y1 + Y * MsSize + 16,
          X1 + X * MsSize + 16 + MsSize, Y1 + Y * MsSize + 16 + MsSize);
        Make_Bmap.Canvas.Brush.Color :=
          Make_Bmap.Canvas.Pixels[X1 + X * MsSize + 16 + Mpon mod 8,
            Y1 + Y * MsSize + 16 + Mpon div 8];
        Make_Bmap.Canvas.FillRect(Rect_M);
      end;
end;

procedure TRei40_16.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  设定马赛克的上移动量
  Yadd := -MsSize;
end;

procedure TRei40_16.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  设定马赛克的下移动量
  Yadd := MsSize;
end;

procedure TRei40_16.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  设定马赛克的左移动量
  Xadd := -MsSize;
end;

procedure TRei40_16.Button4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  设定马赛克的右移动量
  Xadd := MsSize;
end;

procedure TRei40_16.Button5MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  马赛克颜色更改/固定的切换
  Mc := Mc xor 1;
end;

procedure TRei40_16.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  马赛克的停止移动
  Yadd := 0;
end;

procedure TRei40_16.Button2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  马赛克的停止移动
  Yadd := 0;
end;

procedure TRei40_16.Button3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  马赛克的停止移动
  Xadd := 0;
end;

procedure TRei40_16.Button4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  马赛克的停止移动
  Xadd := 0;
end;

procedure TRei40_16.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将背景用、绘制用的点阵图释放掉
  Back_Bmap.Free;
  Make_Bmap.Free;
end;

end.

⌨️ 快捷键说明

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