【图像处理高级编程】-图像特效-优快云博客

本文链接：https://blog.youkuaiyun.com/reson100/article/details/138780167

本文档详细介绍了使用Delphi进行图像处理的各种特效实现，包括自上而下、自下而上的卷帘式显示，左右卷帘、百叶窗、散射、马赛克等图像特效。通过核心源码展示了如何实现这些视觉效果，涉及图像的像素级操作和动画效果的处理。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

文章目录

- 图像特效
- 核心源码

图像特效

提示：这里可以添加技术概要
请添加图片描述

核心源码

procedure TForm1.N25Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
OriginalBMP.Assign(image1.Picture.Bitmap);
Image1.Top := self.Height div 2 -
Image1.Picture.Bitmap.Height div 2;
Image1.Left := self.Width div 2 -
Image1.Picture.Bitmap.Width div 2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.Image1.AutoSize := True;
self.Image1.Stretch := True;
InBmp := TBitmap.Create;
OriginalBmp := TBitmap.Create;
end;

procedure TForm1.UpToDownClick(Sender: TObject);
var
newbmp: TBitmap;
i, bmpWidth, bmpHeight: integer;
begin
newbmp := TBitmap.Create;
newbmp.Width := image1.Width;
newbmp.Height := image1.Height;
bmpWidth := image1.Width;
bmpHeight := image1.Height;
for i := 0 to bmpHeight - 1 do
begin
newbmp.canvas.CopyRect(Rect(0, i, bmpwidth, i + 1),
image1.canvas, Rect(0, i, bmpwidth, i + 1));
self.Canvas.draw(image1.Left, image1.Top, newbmp);
sleep(5);
application.ProcessMessages;
end;
newbmp.Free;
end; //实现自上而下卷帘式显示

procedure TForm1.DownToUpClick(Sender: TObject);
var
newbmp: TBitmap;
i, bmpWidth, bmpHeight: integer;
begin
newbmp := TBitmap.Create;
newbmp.Width := image1.Width;
newbmp.Height := image1.Height;
bmpWidth := image1.Width;
bmpHeight := image1.Height;
image1.Visible := false;
for i := 0 to bmpheight - 1 do
begin
newbmp.Canvas.CopyRect(rect(0, bmpheight - 1 - i, bmpWidth, bmpheight -
i),
image1.canvas, rect(0, bmpheight - 1 - i, bmpWidth, bmpheight - i));
self.Canvas.draw(image1.Left, image1.Top, newbmp);
sleep(5);
application.ProcessMessages;
end;
newbmp.Free;
image1.Visible := true;
end; //自下而上卷帘式显示图片

procedure TForm1.LeftToRightClick(Sender: TObject);
var
newbmp: TBitmap;
i, bmpWidth, bmpHeight: integer;
begin
newbmp := TBitmap.Create;
newbmp.Width := image1.Width;
newbmp.Height := image1.Height;
bmpWidth := image1.Width;
bmpHeight := image1.Height;
for i := 0 to bmpWidth - 1 do
begin
newbmp.Canvas.Copyrect(rect(i, 0, i + 1, bmpheight), image1.canvas,
rect(i, 0, i + 1, bmpheight));
self.Canvas.Draw(image1.Left, image1.Top, newbmp);
sleep(2);
application.ProcessMessages;
end;
newbmp.Free;
end; //从左到右卷帘式显示图片

procedure TForm1.RightToLeftClick(Sender: TObject);
var
newbmp: TBitmap;
i, bmpWidth, bmpHeight: integer;
begin
newbmp := TBitmap.Create;
newbmp.Width := image1.Width;
newbmp.Height := image1.Height;
bmpWidth := image1.Width;
bmpHeight := image1.Height;
for i := 0 to bmpWidth - 1 do
begin
newbmp.Canvas.Copyrect(rect(bmpWidth - 1 - i, 0, bmpWidth - i,
bmpheight), image1.canvas,
rect(bmpWidth - 1 - i, 0, bmpWidth - i, bmpheight));
self.Canvas.draw(image1.Left, image1.top, newbmp);
end;
sleep(2);
newbmp.Free;
end; //从右到左卷帘式显示图片

procedure TForm1.FadeInClick(Sender: TObject);
var
newbmp: TBitmap;
x, y, k: integer;
T: pByteArray;
const
step = 250;
begin
newbmp := TBitmap.Create;
newbmp.Width := image1.Width;
newbmp.Height := image1.Height;
newbmp.Assign(image1.Picture.Bitmap);
newbmp.PixelFormat := pf24bit;
for k := 0 to step do
begin
for x := 0 to newbmp.height - 1 do
begin
T := newbmp.ScanLine[x];
for y := 0 to newbmp.Width - 1 do
begin
T[3 * y + 2] := max(0, min(255, T[3 * y + 2] - 1));
T[3 * y + 1] := max(0, min(255, T[3 * y + 1] - 1));
T[3 * y] := max(0, min(255, T[3 * y] - 1));
end;
end;
self.Canvas.draw(image1.left, image1.top, newbmp);
sleep(5);
end;
InBMP.Assign(newbmp);
newbmp.Free;
messagedlg(‘请选择淡出操作!’, mtconfirmation, [mbok], 0);
end;

procedure TForm1.FadeoutClick(Sender: TObject);
var
newbmp, bitmap: TBitmap;
x, y, k: integer;
T, P: pByteArray;
const
step = 250;
begin
newbmp := TBitmap.Create;
bitmap := TBitmap.Create;
bitmap.Width := image1.Width;
bitmap.Height := image