Delphi的图形处理

系统教程480 更新时间：2026-04-07 10:21:09

2024年3月27日发(作者：)

Delphi的图形处理

Delphi的图形处理......................................................................................................- 1 -

第一章图像处理在可视化编程中的作用及其应用价值.................................- 2 -

第二章图像处理函数.......................................................................................- 2 -

2.1 为什么选择- 2 -

2.2 Delphi中用于图形处理的类...............................................................- 2 -

2.3 GDI及Canvas类简介.........................................................................- 4 -

第三章基本图像处理算法.............................................................................- 13 -

3.1柔化和锐化处理.........................................................................................- 13 -

3.2 图像混合(透明度)效果..............................................................................- 19 -

3.3 转为灰度图像............................................................................................- 22 -

3.4 对比度调整和反色处理.............................................................................- 23 -

3.5 亮度的调整................................................................................................- 25 -

3.6 浮雕效果....................................................................................................- 28 -

3.7 马赛克效果................................................................................................- 31 -

- 1 -

第一章图像处理在可视化编程中的作用及其应用价值

图像处理，是可视化编程的基础内容。在Windows操作系统中，一切要输出到屏幕上的东西都是通过图形

处理这部分的内容来实现的。比如一个程序使用了标签控件，它看起来似乎并没有用到什么图形处理，但实际

上标签控件就是通过使用GDI库中的图形处理函数来实现的。可见图形处理在编程中的重要性。

图像处理在实际的应用中也极具价值。平面制作、动画制作等都离不开它。这一部分的内容十分繁多。我

本次研究的内容，只是其中最基础的、最重要一部分。

第二章图像处理函数

2.1 为什么选择Delphi

所有的可视化编程语言都能够进行图像处理。但由于这些语言的定位不同，它们在进行图形处理的效率和

便捷程度上也各不相同。实际上，Visual C 的图像处理效率是最高的，这是由于GDI类库本身就是用C++写的。

但是使用VC来编程并不是一件方便的事，因为这个语言本身就较为繁杂难懂，所以我没有选择它。Visual Basic

（VB）也是一个常用的语言，但它在图形处理方面能力较差。首先是它的坐标系统是以twip为单位的浮点坐标

系统，在调用GDI类库时，必须对坐标系统进行转换，浪费了大量的资源，编程起来较为麻烦。在多方面因素

的影响下，我觉得Delphi是一个理想的语言。Delphi已经把绝大多数GDI绘图函数都封装成可直接调用的类，

使用它进行图形处理操作十分方便，而且Delphi 是Pascal演变而来的，Pascal具有严谨易读的特点，因此很

容易上手。

2.2 Delphi中用于图形处理的类

Delphi为我们提供了许多图形图像方面的类，合理地使用这些类，我们可以方便地开发出各种图形处理程

序。这些类有TPicture、TBitmap、TGraphic、TIcon、TJPEGImage和TCanvas。其中，TCanvas类用于绘图，

TPicture、TBitmap、TIcon和TJPEGImage是专门用来处理图片的类，TGraphic是一个抽象类，一般不直接使

用。TPicture类可以载入所有支持的图片，而TBitmap、TIcon、TJPEGImage分别用于处理各种类型的图片。

在实际应用中，我们一般用这些具体类型的类载入图片，再将图片转为Bitmap格式来处理。TPicture、TIcon、

TJPEGImage类一般只用于输入和输出。例如，下面的代码可以载入一幅任意支持格式的图片(Delphi所支持的

格式为bmp、jpg、dib、wmf和emf)。

Var Pic:TPicture;

Begin

Pic := ;

omFile(FileName);

End;

用TPicture类来载入图片时，该类会根据文件名的扩展名来决定用何等方式来打开图片。这就出现了一个

问题，如果这个图片的扩展名被用户非法修改，程序就会把这个图片视为无效图片。在真正编程中，我们要用

TPicture、TBitmap、TJPEGImage、TIcon依次尝试去打开图片。

另外，Delphi本身是不支持GIF文件格式的。我们可以借用一个第三方的类——GIFImage来让Delphi支

持它。这个类在附带的光盘中可以找到。最终我们用下面的代码来完成载入图片的操作。

Procedure ReadPicture(FileName: String; Bitmap: p);

var pic:TPicture;Bit:p;jpgPic:TJPEGImage;FGifPic:TGIFImage;

icoPic:TIcon;

begin

- 2 -

FGifPic := ;

Pic:=;

bit:=;

jpgPic:=;

icoPic:=;

try

omFile(FileName);

if uppercase(ExtractFileExt(Filename)) = '.ICO' then begin

:=;

(0,0,c);

end

else

(c);

except

try

omFile(FileName);

except

try

omFile(FileName);

(jpgPic);

except

try

omFile(Filename);

;

Bitmap:=;

:=;

(0,0,icoPic);

except

try

omFile(FileName);

();

except

:=ight('8');

:=dth('无效图片');

t(0,0,'无效图片');

end;{try}

end;

end;{try}

;

- 3 -

end;

保存图片的方法跟打开图片的方法类似，我们可以使用不同类型的图片类的SaveToFile方法保存文件。下

面的代码可以根据文件名中扩展名的不同使用不同的类来保存Bitmap。

Procedure SaveBitmap(FileName: String; PicB: TBitmap);

var pic:TPicture; FileExt:String;picJPG:TJPEGImage;picGIF:TGIFImage;

begin

pic:=;

picJPG:=;

picGIF:=;

try

(PicB);

FileExt:= ExtractFileEXT(FileName);

if (Uppercase(FileExt)='.JPG')or(Uppercase(FileExt)='.JPEG')

or(Uppercase(FileExt)='.JPE') then

begin

(PicB);

File(FileName);

end

else If (UpperCase(FileExt)='.BMP')OR(UpperCase(FileExt)='.DIB')THEN

Begin

File(FileName);

end

else if (UpperCase(FileExt)='.GIF') then begin

(PicB);

File(FileName);

end

else

File(FileName);

{End If}

ShowPicture(PictureIndex,False,TPicture(PicB));

Finally

;

end;

2.3 GDI及Canvas类简介

GDI(Graphics Device Interface,图形设备接口)是Windows为我们提供的一个专门用于图形绘制和屏幕输

出的类库。这个类库提供了许多绘图函数，使用这些函数，我们几乎可以开发出所有的平面绘制、平面处理的

程序。它同时也是Windows系统的核心，Windows系统中所有的绘图任务都由这个库来完成。在任何语言中，

我们都可以调用这个库来完成绘图任务。

在Delphi中，我们已经有了一个已经封装了绝大多数GDI函数的类。使用这个类我们可以方便的完成各种

图像处理任务。这就是我们要研究的Canvas类。

Canvas类中的基本绘图方法

- 4 -

Canvas就是“画布”的意思，使用Canvas类中的绘图方法，我们可以在这块画布上绘制各种图形。我们也

可以通过设置每一个象素的颜色值来完成对图像的处理。下面列出了Canvas类中的一些常用绘图方法。

CopyRect(Dest:TRect;Canvas:TCanvas;Source:TRect);

此方法用于把Canvas所指定的画布的一部分（由Source指定）复制到当前画布中。Dest参数指定了复制

后的图像在当前画布中的位置。例如下面的语句：

ct(Rect(5,5,20,20),SourceCanvas,Rect(10,10,25,25));

可以把SourceCanvas中的(10,10,25,25)这一区域复制到ThisCanvas中的(5,5,20,20)区域中。

值得注意的是，TRect是一个Record类型的变量，用Rect的构造函数可以创建一个Rect变量。Rect类型

所指定的区域是一个长方形，由（x1,y1,x2,y2）两个点来确定。例如，Rect(10,10,25,25)所确定的就是下图

所示的区域：

Draw(x,y:Integer;Graphic:TGraphic);

此方法可以在当前画布中，以(x,y)为绘图原点绘制由Graphic所指定的图形或图片。

Ellips(x1,y1,x2,y2:Integer);

此方法可以在当前画布中，以（x1,y1）,(x2,y2)两点所指定的矩形范围内绘制一个椭圆。并用画笔中所指

定的颜色作为线条颜色，笔刷的颜色作为填充颜色。

MoveTo(x,y:Integer);

把画笔的位置移动到点(x,y)。

LineTo(x,y:Integer);

从画笔当前的位置绘制一条直线到点(x,y),并把画笔的位置移动到(x,y);

Polygon(Points:array of TPoint);

以Points中的点为顶点绘制一个多边形。并用画笔中所指定的颜色作为线条颜色，笔刷的颜色作为填充颜

色。

StretchDraw(Const Rect:TRect;Graphic : TGraphic);

此方法可以在由Rect所指定的区域中绘制图片，图片会根据Rect的大小自动缩放。

Rectangle(x1,y1,x2,y2);

绘制由(x1,y1),(x2,y2)所确定的矩形。并用画笔中所指定的颜色作为线条颜色，笔刷的颜色作为填充颜色。

TextOut(x,y:Integer;Text:String);

以(x,y)为原点绘制参数Text所指定的文字。

TextHeight(Text:String);

返回在当前字体设置下，Text所指定的字符串的高度。

TextWidth(Text:String);

返回在当前字体设置下，Text所指定的字符串的宽高度。

除了这些基本绘图方法外，Canvas类中还有一些重要的属性，它们是：

Pen(画笔)

这个属性包含很多项目，其中Color指定了画笔的颜色，Weight指定了画笔的宽度,PenMode指定了画笔绘图的

方式。

Brush(笔刷)

- 5 -

这个属性主要决定了图形的填充方式。Color指定了填充颜色，BrushStyle决定了填充方式。

Font(字体)

它决定了在Canvas中，使用TestOut命令画出的文字的字体和字号。

Pixels(象素数组)

这个数组包含了Canvas中每一个象素的颜色值。

在一般的编程中，我们在需要进行象素级的图像调整时，一般不使用Pixels属性。在Bitmap(位图)类中

提供了一个ScanLine属性，使用它我们可以快速地进行象素读取和设置。这在后面的章节中有详细的说明。

Canvas类中所提供的绘图方法远远不止上面提到的这些，本文档所罗列的只是我认为最常用的方法，更多

的信息可以参考Delphi的帮助系统。

我们知道，在Canvas类中可以完成各种绘图操作。仔细观察，会发现在Delphi提供的许多组件中，都有

Canvas类。这是因为这些组件都继承自TGraphicControl基类，这个基类就提供了Canvas类。但我们并不满

足于直接使用它们的Canvas来绘图，这是没有效率的。因为TGraphicControl是一个可视化控件，当我们在

这些控件上绘图时，绘制的图形会即时地翻印到前台（即用户的屏幕）上，而很多时候，我们希望在绘图结束

后才将图像翻到前台，这样可以大大提高工作效率。这里就使用到了一个缓冲的思想。即在内存中开一块空间，

在这块空间上绘图，绘图完后，再将这块空间中的图像翻印到前台。

这里，我们可以使用Delphi为我们提供的TBitmap（位图）类。这个类也提供了Canvas类，我们同样可

以在这个Canvas类上绘图。绘制完后，我们用控件名.(0,0,Bitmap)把这个位图翻到前台。

下面的例子可以在PaintBox上绘制一个渐变颜色的矩形。

程序2.1

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TfrmMain = class(TForm)

PaintBox1: TPaintBox;

btnDraw: TButton;

procedure btnDrawClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure wClick(Sender: TObject);

var Bit:TBitmap;

- 6 -

i:Integer;

begin

Bit := ;

try

:= 300;

:= 387;

For i := 0 to 200 do begin

(50,i+50);

:= RGB(0,0,Round((1-(i)/200) * 255));

(350,i+50);

end;

(0,0,Bit);

finally

;

end;

end.

程序的运行结果如下：

现在说明一下上面的程序。首先我们用 Bit:=;语句在内存中创建一个位图对象。然后分别

设置了位图的高度和宽度。接下来使用了一个循环语句一行一行地画出颜色不断加深的线条。最后在PaintBox

的Canvas中把这个位图复制过去。

事实上，这个程序只使用了极少量的绘图方法，并不需要创建位图对象绘图。本程序使用位图只是为了说

明的方便。

使用ScanLine属性进行高效的图像处理

在上一节的例子中，我们使用了Bitmap类。Bitmap是一个处理位图图像的类。这个类允许你载入、创建和

处理位图图像。Delphi的图形处理，都是使用Bitmap类来完成的。当然，用Bitmap类来处理图片并不意味着

Delphi只能处理位图图像，你可以用支持其他图片格式的类将这些图片载入，然后把它们转为Bitmap格式，

再使用Bitmap类进行处理，最后在把Bitmap格式转换为想要输出的格式即可。这在后面的章节中会详细地讲

解。

上一节中，我们提到了Canvas的Pixels属性，该属性可以读取和更改位图中每一像素的颜色值，这一功

能在图形处理非常有用。因为图像处理滤镜就是通过读取每一像素的颜色值决定当前像素新的颜色值，通过改

变这些颜色值来实现各种效果。但是，通过实验我发现，对于一个较大的图像，使用Pixels属性是非常慢的。

处理一幅800*600的图像竟然需要几秒中的时间。这是因为Pixels属性的Read和write过程调用了GetPixel

- 7 -

和SetPixe这两个GDI绘图函数。每次执行SetPixels和GetPixel，都进行了大量的重复运算，这样只要图像

越大，处理时间会成倍增长。使用Pixels属性来处理图片肯定不可行。然而我发现了一种新的东西来取代Pixels

属性，这就是Bitmap类的ScanLine属性。ScanLine属性返回一个位图中一行像素的颜色值。而且ScanLine

属性在读取图片的时候使用了DIB(位)处理方法，这种处理方法比通常的SetPixel和GetPixel快得多。下面

的实验就展示了使用Pixel属性和使用ScanLine属性的速度差异。

这个实验是分别使用Pixel属性和ScanLine属性把一个大小为600*450的图片转为灰度。把图片转为灰度

的算法在后面的章节中有具体的介绍，这里不再解释。以下是使用Pixel属性完成任务的程序。

程序2.2

unit Unit1;

{使用Pixels属性将图像转为灰度}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

PaintBox1: TPaintBox;

btnConvert: TButton;

lblTime: TLabel;

procedure FormCreate(Sender: TObject);

procedure btnConvertClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

private

Procedure DecodeColor(Const Color : TColor; var R,G,B:Byte);

public

{ Public declarations }

end;

var

Form1: TForm1;

Bit: TBitmap;

implementation

{$R *.dfm}

procedure eate(Sender: TObject);

begin

Bit:=;

omFile('');

end;

procedure vertClick(Sender: TObject);

- 8 -

var i , j :Integer;NewColor:Byte; R,G,B:Byte; C:TColor; T:LongInt;

begin

T:=GetTickCount;

For i := 0 to -1 do

begin

for j := 0 to -1 do

begin

C:= [i,j];

DecodeColor(C,R,G,B);

NewColor := (R+G+B) Div 3;

[i,j] := RGB(NewColor,NewColor,NewColor);

end;

T := GetTickCount -t;

n := '用时:' + IntToStr(T) + 'ms';

hDraw(Rect(0,0,320,240),Bit);

end;

procedure Color(const Color: TColor; var R, G, B: Byte);

begin

R := Color mod 256;

G := (color Div 256) mod 256;

B := Color Div 65536;

end;

procedure stroy(Sender: TObject);

begin

;

end;

procedure ox1Paint(Sender: TObject);

begin

hDraw(Rect(0,0,320,240),Bit);

end;

end.

以下是使用ScanLine属性的程序：

程序2.3

unit Unit1;

{使用ScanLine属性完成任务}

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

- 9 -

type

TForm1 = class(TForm)

PaintBox1: TPaintBox;

lblTime: TLabel;

btnConvert: TButton;

procedure FormCreate(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

procedure btnConvertClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Bit : TBitmap;

implementation

{$R *.dfm}

procedure eate(Sender: TObject);

begin

Bit := ;

omFile('');

ormat := pf24Bit;

Type := bmDIB;

end;

procedure ox1Paint(Sender: TObject);

begin

hDraw(Rect(0,0,320,240),Bit);

end;

procedure vertClick(Sender: TObject);

var CurLine : PByteArray;

NewColor : Byte;

i : Integer;

j : Integer;

m : Integer;

t : LongInt;

begin

t:=GetTickCount;

For i := 0 to -1 do

begin

CurLine := ne[i];

- 10 -

for j := 0 to -1 do begin

m := j *3;

NewColor := (curLine[m]+CurLine[m+1]+CurLine[m+2])Div 3;

CurLine[m] := NewColor;

CurLine[m+1] := NewColor;

CurLine[m+2] := NewColor;

end;

t:=GetTickCount-t;

hDraw(Rect(0,0,320,240),Bit);

n := '用时:'+IntToStr(t) + 'ms';

end;

end.

下面就来比较一下它们的运行结果：

使用Pixels属性的运行结果使用ScanLine属性的运行结果

现在，我们来详细分析ScanLine属性的具体用法。

ScanLine属性是一个只读属性，它返回一个数组指针，存放当前Bitmap第i行的像素颜色值。数组指针的

类型可以是PByteArray(字节数组指针)或者^array of TRGBTriple(像素颜色数组指针)。我觉得使用

PByteArray类型是最直接、最方便的，在本文中，我们都将使用PByteArray类型。PByteArray类型指向一个

Byte类型的一维数组。这个数组的第j*3个值表示当前行第j个像素颜色值的B分值(蓝色分值)，第j*3+1个

值表示当前行第j个像素颜色值的G分值(绿蓝色分值), 第j*3+2个值表示当前行第j个像素颜色值的R分值

(红蓝色分值)。其中j∈[0,图像宽度-1]。

ScanLine[i]表示当前Bitmap第i行的像素值。因此RGB(ScanLine[i][j*3+2]，ScanLine[i][j*3+1],

ScanLine[i][j*3])可以表示图像中点(j,i)的颜色值。不过在程序中，这样写是没有效率的，我们为了获取一

个像素就用了3次ScanLine，浪费了很多时间。下面的代码可以用ScanLine读取整个Bitmap的像素值：

程序2.4

Type TPixels = Array of Array of TRGBTriple;

Procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

- 11 -

Var PixPtr:PbyteArray;i,j,m:Integer;

begin

SetLength(tPix,,);

ormat := pf24bit;

Type:=bmDIB;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

tPix[j,i].rgbtBlue:=PixPtr[m];

tPix[j,i].rgbtGreen := PixPtr[m+1];

tPix[j,i].rgbtRed := PixPtr[m+2];

end;

在此说明一下上面的代码。首先定义TPixels为一个二维动态数组，类型为TRGBTriple。TRGBTriple是

一个记录类型，它可以保存一个像素值的R、G、B分值。下面是TRGBTriple的原形声明：

TRGBTriple = tagRGBTRIPLE;

tagRGBTRIPLE = packed record

rgbtBlue: Byte;

rgbtGreen: Byte;

rgbtRed: Byte;

end;

因此，TPixels类型就可以表示Bitmap中所有像素的值。值得强调的是程序的第二行：

ormat := pf24bit;

这行代码的作用是把这个位图转为24位位图格式。因为只有24位的位图格式才符合上面所说的规则。如

果没有这行代码，当程序碰上非24位位图的文件时就不能正常运行。至于Type := bmDIB;这行代

码是为了强制把当前Bitmap的操作方式转化为DIB方式，这只是为了确保万无一失。

那么，既然ScanLine属性是只读的，我们如何改变这些颜色值呢？我们知道，ScanLine属性返回的是一

个指针。既然是指针，我们就可以改变指针所指向的数据，通过这种方式就可以改变Bitmap中的颜色值了。下

面的程序段演示了如何把一个TPixels变量写到Bitmap中去。

程序2.5

Procedure WritePixel(Pic: TBitmap; tPix: TPixels);

var PixPtr:PByteArray;i,j,m:Integer;

begin

ormat := pf24bit;

Type:=bmDIB;

:= High(tPix[0])+1;

:= High(tPix)+1;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

PixPtr[M] := tPix[j,i].rgbtBlue;

PixPtr[m+1] := tPix[j,i].rgbtGreen;

PixPtr[m+2] := tPix[j,i].rgbtRed;

end;

- 12 -

end;

这样，我们在图形处理时，就可以先用ReadPixel过程把位图读到一个TPixels类型的变量中去，然后处

理这个TPixels变量，处理完后，用WritePixel过程把这个变量写到Bitmap中去，这就完成了修改过程。

第三章基本图像处理算法

3.1柔化和锐化处理

柔化处理的原理是将图片中每一个像素都由与其相邻的n*n个像素的平均值来代替。N的取值决定了其模糊

程度。下面是柔化处理的程序。

程序3.1

unit Unit1;

{柔化处理}

Interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, GraphicProcess, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

PaintBox1: TPaintBox;

btnExe: TButton;

txtN: TEdit;

Label1: TLabel;

procedure FormCreate(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

procedure btnExeClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

Procedure SmoothPicture(const Bit : TBitmap;var n : Integer);

public

{ Public declarations }

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

var

Form1: TForm1;

Bits : TBitmap;

implementation

{$R *.dfm}

procedure eate(Sender: TObject);

begin

Bits:=;

omFile('');

end;

- 13 -

procedure ox1Paint(Sender: TObject);

begin

hDraw(Rect(0,0,400,300),Bits);

end;

procedure Picture(const Bit: TBitmap;var n: Integer);

var R,G,B:Integer;

i,j,k,l : Integer;

Pix : TPixels;

nDiv : Integer;

nDivRs : Integer;

jP,jM,ip,im:Integer;

OpCount : Integer;

begin

ReadPixel(Bit,Pix);

if n mod 2 = 0 then n := n +1;

nDiv := n * n;

nDivRs := n div 2;

For i := 0 to -1 do begin

ip:= i + nDivRs;

im := i ;

if im < 0 then im := 0;

if ip > -1 then ip := -1;

For j := 0 to -1 do

begin

R:=0;

G:=0;

B:=0;

jP := j + nDivRs;

jM := j - nDivRs;

if Jp > -1 then

jp := -1;

if jm <0 then jm :=0;

OpCount := (ip - im+1) *(jp-jm+1);

For k := im to Ip do begin

For l := jm to jp do

begin

R := R + Pix[k,l].rgbtRed;

G := G + Pix[k,l].rgbtGreen;

B := B + Pix[k,l].rgbtBlue;

end;

Pix[i,j].rgbtBlue := B div opCount;

Pix[i,j].rgbtGreen := G div opCount;

Pix[i,j].rgbtRed := R div opCount;

end;

WritePixel(Bit,Pix);

- 14 -

end;

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

Var PixPtr:PbyteArray;i,j,m:Integer;

begin

SetLength(tPix,,);

ormat := pf24bit;

Type:=bmDIB;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

tPix[j,i].rgbtBlue:=PixPtr[m];

tPix[j,i].rgbtGreen := PixPtr[m+1];

tPix[j,i].rgbtRed := PixPtr[m+2];

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

var PixPtr:PByteArray;i,j,m:Integer;

begin

ormat := pf24bit;

Type:=bmDIB;

:= High(tPix[0])+1;

:= High(tPix)+1;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

PixPtr[M] := tPix[j,i].rgbtBlue;

PixPtr[m+1] := tPix[j,i].rgbtGreen;

PixPtr[m+2] := tPix[j,i].rgbtRed;

end;

procedure Click(Sender: TObject);

var n :Integer;

begin

n := StrToInt();

omFile('');

SmoothPicture(Bits,n);

h;

end;

procedure stroy(Sender: TObject);

begin

;

end;

end.

- 15 -

程序的运行结果如下图所示。

原图柔化系数=21

锐化处理的原理是把每一像素的值与该像素斜上方的像素值之差乘以一个系数再加上该像素原来的颜色

值。如果记图像中任意一个像素(x,y) (x∈[1,图像宽度-1],y∈[1,图像高度-1])修改前的RGB分值分别为

OldRed, OldGreen, OldBlue, 修改后的RGB分值分别为NewR,NewG,NewB,有：

newR = (oldR - (x-1,y-1)的Red分值)×待定系数 + OldRed

newG = (oldG - (x-1,y-1)的Green分值)×待定系数 + OldGreen

newB = (oldB - (x-1,y-1)的Blue分值)×待定系数 + OldBlue

根据这个公式，我们的程序如下：

程序3.12

unit Sharp;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TPixels = Array of Array of TRGBTriple;

TfrmMain = class(TForm)

PaintBox1: TPaintBox;

btnExecute: TButton;

lblCap: TLabel;

txtS: TEdit;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure btnExecuteClick(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

private

Procedure SharpPic(Bit : TBitmap; n : Single);

- 16 -

public

{ Public declarations }

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

var

frmMain: TfrmMain;

Bits : TBitmap;

implementation

{$R *.dfm}

procedure eate(Sender: TObject);

begin

Bits := ;

omFile('');

end;

procedure stroy(Sender: TObject);

begin

;

end;

procedure cuteClick(Sender: TObject);

var n : Single;c : Integer;

begin

omFile('');

Val(,n,c);

SharpPic(Bits,n);

h;

end;

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

Var PixPtr:PbyteArray;i,j,m:Integer;

begin

SetLength(tPix,,);

ormat := pf24bit;

Type:=bmDIB;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

tPix[j,i].rgbtBlue:=PixPtr[m];

tPix[j,i].rgbtGreen := PixPtr[m+1];

tPix[j,i].rgbtRed := PixPtr[m+2];

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

var PixPtr:PByteArray;i,j,m:Integer;

begin

- 17 -

ormat := pf24bit;

Type:=bmDIB;

:= High(tPix[0])+1;

:= High(tPix)+1;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

PixPtr[M] := tPix[j,i].rgbtBlue;

PixPtr[m+1] := tPix[j,i].rgbtGreen;

PixPtr[m+2] := tPix[j,i].rgbtRed;

end;

procedure ic(Bit: TBitmap; n: Single);

var R, G, B : Integer;

i,j:Integer;

Pix : TPixels;

im,jm : Integer;

begin

ReadPixel(Bit,Pix);

For i := 1 to -1 do begin

im := i-1;

For j := 1 to -1 do begin

jm := j-1;

R := Pix[i,j].rgbtRed + Round((Pix[i,j].rgbtRed-Pix[im,jm].rgbtRed)*n);

G := Pix[i,j].rgbtGreen + Round((Pix[i,j].rgbtGreen-Pix[im,jm].rgbtGreen)*n);

B := Pix[i,j].rgbtBlue + Round((Pix[i,j].rgbtBlue-Pix[im,jm].rgbtBlue)*n);

if R > 255 then R := 255;

If R <0 then R := 0;

if G > 255 then G := 255;

If G <0 then G := 0;

if B > 255 then B := 255;

If B <0 then B := 0;

Pix[i,j].rgbtRed := R;

Pix[i,j].rgbtGreen := G;

Pix[i,j].rgbtBlue := B;

end;

WritePixel(Bit,Pix);

end;

procedure ox1Paint(Sender: TObject);

begin

hDraw(Rect(0,0,400,300),Bits);

end;

end.

程序的运行结果如下图所示。

- 18 -

原图锐化系数 = 0.95

3.2 图像混合(透明度)效果

这种效果经常用在动画的转场过度上。这是一个由图像A逐渐变化为图像B的中间效果。就像向图像B以

变量N为透明度覆盖在图像B一样。下图展示了这种效果。

透明度 = 100% 透明度 = 50%

透明度 = 0%

图像过渡效果的原理是，如果记透明度为A，那么在确保图像A和图像B同等大小的情况下，创建一个与图

像A或B等大的图像C，对于图像C中每一个像素点P(x,y)，它的颜色值为：

R = 图像A的像素点(x,y).R +(图像B的像素点(x,y).R-图像A的像素点(x,y).R)×A

G = 图像A的像素点(x,y).G +(图像B的像素点(x,y).G-图像A的像素点(x,y).G)×A

B = 图像A的像素点(x,y).B +(图像B的像素点(x,y).B-图像A的像素点(x,y).B)×A

根据公式，有下面的程序：

程序3.2

unit AlphaBlending;

interface

- 19 -

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type

TPixels = Array of array of TRGBTriple;

TForm1 = class(TForm)

PaintBox1: TPaintBox;

Label1: TLabel;

scA: TTrackBar;

lblPos: TLabel;

Bevel1: TBevel;

procedure FormCreate(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure scAChange(Sender: TObject);

private

public

{ Public declarations }

end;

Procedure GraphicFading(PicA, PicB: TPixels;

const PicR: tBitmap; Percent: Byte);

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

var

Form1: TForm1;

BitA,BitB:TBitmap;

Bits: TBitmap;

PixA,PixB:TPixels;

implementation

{$R *.dfm}

procedure eate(Sender: TObject);

begin

BitA := ;

BitB := ;

Bits := ;

omFile('');

(BitA); //这个语句可以把BitA中的内容复制到Bits中

ormat := pf24Bit;

ReadPixel(BitA,PixA);

ReadPixel(BitB,PixB);

end;

- 20 -

procedure ox1Paint(Sender: TObject);

begin

(0,0,Bits);

end;

Procedure GraphicFading(PicA, PicB: TPixels;

const PicR: tBitmap; Percent: Byte);//Make a Fading Picture From

var //PicA to PicB

MidR,MidG,MidB : Byte;

i,j : integer; m:Integer;

pixPtrA,pixPtrB,pixPtrR : PByteArray;

Position : Single;rPos,gPos:Integer;

PicRWidth:Integer;

begin

Position := Percent / 100;

PicRWidth:=-1;

for i := 0 to -1 do begin

PixPtrR := ne[i];

for j := 0 to picRWidth do Begin

m:=j*3;

rPos:=m+2;

gPos:=m+1;

midR :=

PicA[j,i].RGBTRed+Round((PicB[j,i].RGBTRed-PicA[j,i].RGBTRed)*Position);

midG :=

PicA[j,i].RGBTgREEN+Round((PicB[j,i].RGBTgREEN-PicA[j,i].RGBTgREEN)*Position);

midB :=

PicA[j,i].RGBTBlue+Round((PicB[j,i].RGBTBlue-PicA[j,i].RGBTBlue)*Position);

pixPtrR[m] := midB;

pixPtrR[gPos] := midG;

pixPtrR[rPos] := MidR;

end;

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

Var PixPtr:PbyteArray;i,j,m:Integer;

begin

SetLength(tPix,,);

ormat := pf24bit;

Type:=bmDIB;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

tPix[j,i].rgbtBlue:=PixPtr[m];

tPix[j,i].rgbtGreen := PixPtr[m+1];

- 21 -

tPix[j,i].rgbtRed := PixPtr[m+2];

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

var PixPtr:PByteArray;i,j,m:Integer;

begin

ormat := pf24bit;

Type:=bmDIB;

:= High(tPix[0])+1;

:= High(tPix)+1;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

PixPtr[M] := tPix[j,i].rgbtBlue;

PixPtr[m+1] := tPix[j,i].rgbtGreen;

PixPtr[m+2] := tPix[j,i].rgbtRed;

end;

procedure stroy(Sender: TObject);

begin

;

end;

procedure nge(Sender: TObject);

begin

GraphicFading(PixA,PixB,Bits,on);

(0,0,Bits);

n := IntToStr(on) + ' %';

h;

end;

end.

3.3 转为灰度图像

将图像转为灰度的算法非常简单，把图像中每一个像素的R、G、B分值都设置为该像素R、G、B分值的平

均值即可。这是因为，在RGB编码中，如果一个像素的R、G、B分值相等，那么这就是一个灰色的像素。例如

RGB(i,i,i) (i∈[0,255])可以表示不同灰度等级的灰色。当i = 255时，该像素为白色，当 i = 0时，该像

素为白色。下面的程序段给出了灰度图像的算法。这一次，我们使用PRGBTriple类型作为ScanLine的指针类

型，大家可以参考一下。

程序3.3

- 22 -

Function GraphicToGray(const Pic: Tbitmap): Integer;

var

i,j : integer;

pixPtr : PRGBTriple;

picH : integer;

picW : Integer;

GrayVal : Byte;

Begin

ormat := pf24Bit;

Type := bmDIB;

picH := ;

picW := ;

for i := 0 to picH -1 do begin

pixPtr := ne[i];

for j := 0 to picW -1 do begin

GrayVal := Round((pixPtr^.rgbtBlue + pixPtr^.rgbtRed +

pixptr^.rgbtGreen)/3);

pixPtr^.rgbtBlue := grayVal;

pixptr^.rgbtGreen := grayval;

pixptr^.rgbtRed := grayval;

inc(pixPtr);

end;

下面是上一端程序的运行结果：

3.4 对比度调整和反色处理

图像对比度是指图像颜色值与中间颜色值的距离大小。在图形处理中，我们定义颜色RGB(127,127,127)

为中间颜色值。增大或减小某一个像素值与这个值的差距就可以提高和降低图像的颜色值。如果我们记对比度

调整前每一颜色通道（即像素颜色值的R、G、B分值）的值为x，修改后的值为y，那么有下图所示的线性关系：

- 23 -

从图中我们可以看出，对于未调整的图像，f(x) = x。如果调整了对比度，那么f(x) 的图像以点(127,127)

为原点旋转。如果我们设f(x)= kx + b，提高对比度的问题就转变为根据k求b，在用k和b求f(x)的值的问

题（也就是转换坐标系的问题）。其中，k是由用户指定的，它决定了是提高对比度还是降低对比度。如果k>1，

就提高对比度，反之则降低对比度。如果k<0，那么可以达到反色的效果。

如果我们以点(127,127)为原点作一个平面直角坐标系，那么在新的坐标系XOY中，我们有Y = kX。把坐标

系XOY向左、向下各移动127个单位，此时XOY与xoy重合，我们得到

Y = k(x-127) + 127

因此，我们得到了下面的公式：

NewRed = k(OldRed - 127) + 127

NewGreen = k(OldGreen - 127) + 127

NewBlue = k(OldBlue - 127) + 127

我们用下面的程序段可以实现对比度的调整。这里直接调用了第2章给出的ReadPixel和WritePixel方法。

程序3.4

Procedure GraphicContrast(Pic: TBitmap;Const tPix: TPixels;Value:Integer);

var RPos:Double;i,j:Integer;

NewR,newG,NewB:Integer;

OffSetValue:Single;

begin

RPos:=Value/100;

OffSetValue:=RPos*(-127)+127;

For i:=0 to -1 do begin

For j := 0 to -1 do Begin

NewR := Round(tPix[i,j].rgbtRed*RPos+OffSetValue);

NewG := Round(tPix[i,j].rgbtGreen*RPos+OffSetValue);

NewB := Round(tPix[i,j].rgbtBlue*RPos+OffSetValue);

If NewR>255 then

NewR := 255;

if NewG > 255 then

NewG:=255;

If NewB > 255 then

NewB:=255;

if NewR<0 then NewR := 0;

if NewG<0 then NewG := 0;

if NewB<0 then NewB := 0;

tPix[i,j].rgbtBlue := NewB;

tPix[i,j].rgbtGreen := NewG;

tPix[i,j].rgbtRed := NewR;

- 24 -

end;

WritePixel(pic,tPix);

end;

程序的运行结果如下图所示。

原图对比度系数k = 1.5

对比度系数 k = -1

3.5 亮度的调整

我们知道RGB(255,255,255)表示白色，而RGB(0,0,0)表示黑色。由此，如果RGB分量的值越接近255，这

个像素越“亮”，如果越接近0，那么像素越“暗”。所以，亮度调整的原理就是对原图像的每一个像素的RGB

值都加上或减去一个常量即可。

下面的程序可以调整图像的亮度。

程序3.5

unit Brightness;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type

TPixels = Array of array of TRGBTriple;

TForm1 = class(TForm)

PaintBox1: TPaintBox;

Label1: TLabel;

scB: TTrackBar;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

procedure scBChange(Sender: TObject);

private

Procedure BrightnessChange(Bit : TPixels; n : Integer);

- 25 -

public

{ Public declarations }

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

var

Form1: TForm1;

Bits : TBitmap;

PixA : TPixels;

Pix : TPixels;

implementation

{$R *.dfm}

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

Var PixPtr:PbyteArray;i,j,m:Integer;

begin

SetLength(tPix,,);

ormat := pf24bit;

Type:=bmDIB;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

tPix[j,i].rgbtBlue:=PixPtr[m];

tPix[j,i].rgbtGreen := PixPtr[m+1];

tPix[j,i].rgbtRed := PixPtr[m+2];

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

var PixPtr:PByteArray;i,j,m:Integer;

begin

ormat := pf24bit;

Type:=bmDIB;

:= High(tPix[0])+1;

:= High(tPix)+1;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

PixPtr[M] := tPix[j,i].rgbtBlue;

PixPtr[m+1] := tPix[j,i].rgbtGreen;

PixPtr[m+2] := tPix[j,i].rgbtRed;

end;

- 26 -

procedure nessChange(Bit: TPixels; n: Integer);

var i ,j :Integer;

R,G,B:Integer;

begin

For i := 0 to Length(Bit)-1 do begin

for j := 0 to Length(Bit[0])-1 do begin

B:= Bit[i,j].rgbtBlue + n;

G := Bit[i,j].rgbtGreen + n;

R := Bit[i,j].rgbtRed + n;

If B > 255 then B := 255;

If B <0 then B := 0;

If G > 255 then G := 255;

If G <0 then G := 0;

If R > 255 then R := 255;

If R <0 then R := 0;

Bit[i,j].rgbtBlue := B;

Bit[i,j].rgbtGreen := G;

Bit[i,j].rgbtRed := R;

end;

procedure eate(Sender: TObject);

var i,j :Integer;

begin

Bits := ;

omFile('');

ReadPixel(Bits,Pix);

SetLength(PixA,,);

For i := 0 to -1 do begin

For j := 0 to -1 do begin

PixA[i,j] := Pix[i,j];

end;

procedure stroy(Sender: TObject);

begin

;

end;

procedure ox1Paint(Sender: TObject);

begin

(0,0,Bits);

end;

- 27 -

procedure nge(Sender: TObject);

var i,j : Integer;

begin

Caption := IntToStr(on) + '%';

For i := 0 to -1 do begin

For j := 0 to -1 do begin

Pix[i,j] := PixA[i,j];

end;

BrightnessChange(Pix,on);

WritePixel(Bits,Pix);

(0,0,Bits);

end;

end.

程序的运行结果如下。

3.6 浮雕效果

浮雕效果的原理是将图像的每一个像素的颜色值与该像素斜下方的像素值的差的绝对值加上一个常数。

这个常数决定了浮雕效果的亮度。程序3.7给出了浮雕效果的源代码。

程序3.6

unit Emboss;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type

TPixels = Array of array of TRGBTriple;

TfrmMain = class(TForm)

PaintBox1: TPaintBox;

Label1: TLabel;

scS: TTrackBar;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

- 28 -

procedure scSChange(Sender: TObject);

procedure PaintBox1Paint(Sender: TObject);

procedure PaintBox1Click(Sender: TObject);

private

procedure Emboss(Bit: TPixels; n: Integer);

{ Private declarations }

public

{ Public declarations }

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

var

frmMain: TfrmMain;

Bits : TBitmap;

PixA : TPixels;

Pix : TPixels;

implementation

{$R *.dfm}

procedure ReadPixel(Pic: Tbitmap; var tPix: TPixels);

Var PixPtr:PbyteArray;i,j,m:Integer;

begin

SetLength(tPix,,);

ormat := pf24bit;

Type:=bmDIB;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

tPix[j,i].rgbtBlue:=PixPtr[m];

tPix[j,i].rgbtGreen := PixPtr[m+1];

tPix[j,i].rgbtRed := PixPtr[m+2];

end;

procedure WritePixel(Pic: TBitmap; tPix: TPixels);

var PixPtr:PByteArray;i,j,m:Integer;

begin

ormat := pf24bit;

Type:=bmDIB;

:= High(tPix[0])+1;

:= High(tPix)+1;

For i :=0 to -1 do begin

PixPtr:=ne[i];

for j:= 0 to -1 do begin

m := j*3;

PixPtr[M] := tPix[j,i].rgbtBlue;

- 29 -

PixPtr[m+1] := tPix[j,i].rgbtGreen;

PixPtr[m+2] := tPix[j,i].rgbtRed;

end;

procedure (Bit: TPixels; n: Integer);

var i ,j :Integer;

R,G,B:Integer;

begin

For i := 0 to Length(Bit)-2 do begin

for j := 0 to Length(Bit[0])-2 do begin

B:= ABS(Bit[i,j].rgbtBlue-Bit[i+1,j+1].rgbtBlue) + n; // 把当前像素值的

G := ABS(Bit[i,j].rgbtGreen-Bit[i+1,j+1].rgbtGreen) + n; // RGB分量设置为

R := ABS(Bit[i,j].rgbtRed-Bit[i+1,j+1].rgbtRed) + n; // 当前像素值与下

一个像素值的差的绝对值+系数n。

{如果像素值超过范围，设置像素值为0或255}

If B > 255 then B := 255;

If B <0 then B := 0;

If G > 255 then G := 255;

If G <0 then G := 0;

If R > 255 then R := 255;

If R <0 then R := 0;

Bit[i,j].rgbtBlue := B;

Bit[i,j].rgbtGreen := G;

Bit[i,j].rgbtRed := R;

end;

procedure eate(Sender: TObject);

var i,j:Integer;

begin

Bits := ;

omFile('');

ReadPixel(Bits,Pix);

SetLength(PixA,,);

For i := 0 to -1 do begin

For j := 0 to -1 do begin

PixA[i,j] := Pix[i,j];

end;

procedure stroy(Sender: TObject);

begin

;

end;

procedure nge(Sender: TObject);

var i,j:Integer;

- 30 -

begin

{我们在ScrollBar的Change事件中处理浮雕效果}

Caption := IntToStr(on);

{先将像素值复原}

For i := 0 to -1 do begin

For j := 0 to -1 do begin

Pix[i,j] := PixA[i,j];

end;

Emboss(Pix,on);//调用浮雕效果处理过程。

WritePixel(Bits,Pix);

(0,0,Bits); //显示结果。

end;

procedure ox1Paint(Sender: TObject);

begin

(0,0,Bits);

end;

procedure ox1Click(Sender: TObject);

begin

WritePixel(Bits,PixA);

(0,0,Bits);

end;

end.

3.7 马赛克效果

马赛克效果的原理是，把图象分割成n*n的小块，把每一个区域中的所有像素值变为这个区域像素值的平

均值即可。下面的程序段可以实现这种效果。这里调用了第二章给出的ReadPixel和WritePixel方法。

程序3.7

Procedure Mosic(const Bit: TBitmap;var n: Integer);

var R,G,B:Integer;

i,j,k,l : Integer;

Pix : TPixels;

nDiv : Integer;

nDivRs : Integer;

jP,jM,ip,im:Integer;

OpCount : Integer;

begin

ReadPixel(Bit,Pix);

if n mod 2 = 0 then n := n +1;

nDiv := n * n;

nDivRs := n;

I := 0 ;

While I<= -1 do begin

ip:= i + nDivRs;

im := i ;

- 31 -

if im < 0 then im := 0;

if ip > -1 then ip := -1;

j := 0;

While j <= -1 do begin

R:=0;

G:=0;

B:=0;

jP := j + nDivRs;

jM := j - nDivRs;

if Jp > -1 then

jp := -1;

if jm <0 then jm :=0;

OpCount := (ip - im+1) *(jp-jm+1);

For k := im to Ip do begin

For l := jm to jp do

begin

R := R + Pix[k,l].rgbtRed;

G := G + Pix[k,l].rgbtGreen;

B := B + Pix[k,l].rgbtBlue;

end;

For k := im to Ip do begin

For l := jm to jp do

begin

Pix[k,l].rgbtBlue := B div opCount;

Pix[k,l].rgbtGreen := G div opCount;

Pix[k,l].rgbtRed := R div opCount;

end;

j := j + n;

end;

i := i + n;

end;

WritePixel(Bit,Pix);

end;

以下是程序的运行结果。

原图

马赛克大小 = 25

- 32 -

本文发布于:2024-03-27，感谢您对本站的认可！

本文链接:https://www.fzithome.com/xitong/1711553582a386421.html

Delphi的图形处理

发布评论取消回复

最近发表

相关推荐

标签列表

Delphi的图形处理

发布评论 取消回复

最近发表

相关推荐

标签列表

发布评论取消回复