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.