Delphi 经典游戏程序设计40例 的学习 例16 马赛克处理


unit R16;

interface

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

type
  TRei16 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    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 Button5Click(Sender: TObject);
    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 Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure MosMake(X1,Y1:Word);

  public
    { Public declarations }
  end;

const
  Yoko = 37;
  Tate = 27;
  DYoko = Yoko * 16;
  DTate = Tate * 16;
  MsSize = 8;       //一小块马赛克的大小,点数。
  MsYoko = 8;       //马赛克的横向数目
  MsTate = 8;       //马赛克的纵向数目

var
  Rei16: TRei16;
  //背景图像,绘制图像
  BackBmap,MakeBmap :TBitmap;

  Mpon :Byte;
  Mc :Byte   = 1;          // 马赛克是否 闪烁  
  MX : Integer = 312-48;   //马赛克的位置,并初始
  MY : Integer = 224-48;
  Xadd,Yadd : ShortInt;    //移动值
  RectB,RectD,RectM : TRect;



implementation

{$R *.dfm}

procedure Trei16.MosMake(X1,Y1:Word);
var
  x,y :Byte;
begin
  //取背景图的规定范围到制作点阵图
  RectB := Rect(48,24,640,480-24);
  RectM := Rect(16,16,DYoko + 16,DTate + 16);
  MakeBmap.Canvas.CopyRect(RectM,BackBmap.Canvas,RectB);

  for x := 0 to (MsYoko - 1) do
    for y := 0 to (MsTate - 1) do
    begin
      RectM := Rect(X1 + x * MsSize + 16,Y1 + y * MsSize + 16,
        X1 + x * MsSize + 16 + MsSize,Y1 + y * MsSize + 16 + MsSize );
     //设置笔刷颜色,
     MakeBmap.Canvas.Brush.Color :=
       //pixels[X,Y] 取得该点颜色?余为X,商为Y 
        MakeBmap.Canvas.Pixels[X1 + x * MsSize + 16 + Mpon mod 8,
          Y1 + y * MsSize + 16 + Mpon div 8];
      MakeBmap.Canvas.FillRect(RectM);
    end;

end;


procedure TRei16.FormCreate(Sender: TObject);
begin
  BackBmap := TBitmap.Create;
  BackBmap.Width := DYoko;
  BackBmap.Height := DTate;
  BackBmap.LoadFromFile(GetCurrentDir + '\Bunny.bmp');

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

end;

procedure TRei16.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BackBmap.Free;
  MakeBmap.Free;
end;

procedure TRei16.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Yadd := -MsSize;
end;

procedure TRei16.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Yadd := MsSize;
end;

procedure TRei16.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Xadd := -MsSize;
end;

procedure TRei16.Button4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Xadd := MsSize;
end;

procedure TRei16.Button5Click(Sender: TObject);
begin
  Mc := Mc xor 1;
end;

procedure TRei16.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Yadd := 0;
end;

procedure TRei16.Button2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Yadd := 0;
end;

procedure TRei16.Button3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Xadd := 0;
end;

procedure TRei16.Button4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Xadd := 0;
end;

procedure TRei16.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;

  //mc 为0,MPON不变,mc 为1 ,MPON 会不断递增,但限制在63的范围内。
  Mpon := (Mpon + Mc ) and 63;
  MosMake(MX,MY);

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



end;

end.

 1,mosaic 英文单词

2,一个函数

//pixels[X,Y] 取得该点颜色?余为X,商为Y 
        MakeBmap.Canvas.Pixels
3, 鼠标的MouseDown UP
4,程序框架大体一样,也是在TIME中完成绘画