Delphi 经典游戏程序设计40例 的学习 例40 动画检查器

unit R40;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, Clipbrd, ExtCtrls;
                                                    //Clipbrd 剪切板控件
type
  TRei40 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    ScrollBar1: TScrollBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Image1: TImage;
    Image2: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Rei40: TRei40;
  PatBmap: TBitmap;      //用来存储剪切板的点阵图

  Size, St, NowP, Fd: Byte;
  Pval: Word;
  x, y: Integer;

  RectP, RectD: TRect;

implementation

{$R *.dfm}

procedure TRei40.FormCreate(Sender: TObject);
begin
  PatBmap := TBitmap.Create;
  PatBmap.Width := 32 * 4;   // 点阵图设置大小
  PatBmap.Height := 32;
  Size := 32;
  Pval := 4;
  St := 2;
  Fd := 0;

end;

procedure TRei40.Button1Click(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_BITMAP) then      //判断剪切板有点阵图
  begin
    PatBmap.Assign(Clipboard);   //这个算是重新构建了PatBmap点阵图吗？
    St := 0 ;
    if PatBmap.Height < PatBmap.Width then
    begin                                   //高小于宽
      Size := (PatBmap.Height div 8) * 8;   // 取8像素的倍数
      Pval := PatBmap.Width div Size;       //取帧数
    end
    else begin
      Size := (PatBmap.Width div 8) * 8;
      Pval := PatBmap.Height div Size;
    end;
    St := 2;

  end;
end;

procedure TRei40.Button2Click(Sender: TObject);
begin
  St := St xor 1;                        //播放
  NowP := 0;
end;

procedure TRei40.Button3Click(Sender: TObject);
begin
  Fd := Fd xor 1;                //缩放
  Image2.Canvas.Brush.Color := clBlack;
  RectD := Rect(0, 0, Image2.Width, Image2.Height);
  Image2.Canvas.FillRect(RectD);
end;

procedure TRei40.BitBtn1Click(Sender: TObject);
begin
  if Size > 8 then            //Size  减小
  begin
    Size := Size - 8;
    Image2.Canvas.Brush.Color := clBlack;
    RectD := Rect(0, 0, Image2.Width, Image2.Height);
    Image2.Canvas.FillRect(RectD);
    Edit1.Text := ' ' + IntToStr(Size);
  end;
end;

procedure TRei40.BitBtn2Click(Sender: TObject);
begin
  if (Size + 8 <= PatBmap.Width) and (Size + 8 <= PatBmap.Height) then
  begin
    Size := Size + 8;        //Size 增大
    Edit1.Text := ' ' + IntToStr(Size);
    if Pval > (PatBmap.Width div Size) * (PatBmap.Height div Size) then
    begin                    //帧数同步变化
      Pval := (PatBmap.Width div Size) * (PatBmap.Height div Size);
      Edit2.Text := ' ' + IntToStr(Pval);
    end;
  end;
end;

procedure TRei40.BitBtn3Click(Sender: TObject);
begin
  if Pval > 1 then         //帧数减少
  begin
    Pval := Pval - 1;
    Edit2.Text := ' ' + IntToStr(Pval);
  end;
end;

procedure TRei40.BitBtn4Click(Sender: TObject);
begin
  if Pval < (PatBmap.Width div Size) * (PatBmap.Height div Size) then
  begin
    Pval := Pval + 1;          //帧数增加
    Edit2.Text := ' ' + IntToStr(Pval);
  end;
end;

procedure TRei40.ScrollBar1Change(Sender: TObject);
begin
  Timer1.Interval := ScrollBar1.Position;    //计时器变化
  Edit3.Text := ' ' + IntToStr(Timer1.Interval);
end;

procedure TRei40.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  PatBmap.Free;
end;

procedure TRei40.Timer1Timer(Sender: TObject);
begin
  if St = 0 then   //St 指示没有动画时？
  begin
    x := 0 ;
    y := 0 ;
    RectP := Rect(0, 0, Size, Size);
    RectD := Rect(0, 0, Size, Size);
    if Fd = 1 then
      RectD := Rect(0, 0, Image2.Width, Image2.Height);
    Image2.Canvas.CopyMode := cmSrcCopy;
    Image2.Canvas.CopyRect(RectD, PatBmap.Canvas, RectP);

    Edit1.Text := IntToStr(Size);   //大小
    Edit2.Text := IntToStr(Pval);   //动画数目
    Edit3.Text := IntToStr(Timer1.Interval);  //计时器
  end
  else if St = 1 then   //有动画处理?
  begin
    x := (NowP * Size) mod PatBmap.Width;    //取得当前X在整个图像中的位置
    y := (NowP * Size div PatBmap.Width) * Size;
    if x + Size > PatBmap.Width then
    begin
      x := 0;
      y := y + Size;
    end;
    if y + Size > PatBmap.Height then
      y := 0;
    RectP := Rect(x, y, x + Size, y + Size);
    RectD := Rect(0, 0, Size, Size);
    if Fd = 1 then     //放大显示？
      RectD := Rect(0, 0, Image2.Width, Image2.Height);
    Image2.Canvas.CopyMode := cmSrcCopy;
    Image2.Canvas.CopyRect(RectD, PatBmap.Canvas, RectP);
    NowP := NowP + 1;
    if NowP >= Pval then
      NowP := 0;
  end
  else begin
    Image1.Canvas.Brush.Color := clBlack;
    RectD := Rect(0, 0, Image1.Width, Image1.Height);
    Image1.Canvas.FillRect(RectD);
    Image1.Canvas.CopyMode := cmSrcCopy;
    RectP := Rect(0, 0, PatBmap.Width, PatBmap.Height);
    Image1.Canvas.CopyRect(RectP, PatBmap.Canvas, RectP);
    Image2.Canvas.Brush.Color := clBlack;
    RectD := Rect(0, 0, Image2.Width, Image2.Height);
    Image2.Canvas.FillRect(RectD);
    St := 0;
  end;

end;

end.