Delphi GDI+ 图形处理（3）

现在的位置: 首页 > 综合 > 正文

RSS

Delphi GDI+ 图形处理（3）

2018年05月27日 ⁄ 综合 ⁄ 共 19196字 ⁄ 字号小中大 ⁄ 评论关闭

探究Delphi的图形处理之七 -- 柔化和锐化处理　

　第三章基本图像处理算法

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 TForm1.FormCreate(Sender: TObject);

begin

Bits:=TBitmap.Create;

Bits.LoadFromFile(‘Test.Bmp‘);

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

begin

PaintBox1.Canvas.StretchDraw(Rect(0,0,400,300),Bits);

end;

procedure TForm1.SmoothPicture(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 Bit.Width-1 do begin

ip:= i + nDivRs;

im := i ;

if im < 0 then im := 0;

if ip > Bit.Width -1 then ip := Bit.Width-1;

For j := 0 to Bit.Height -1 do

begin

R:=0;

G:=0;

B:=0;

jP := j + nDivRs;

jM := j - nDivRs;

if Jp > bit.Height-1 then

jp := Bit.Height-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);

end;

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

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

begin

SetLength(tPix,Pic.Width,Pic.Height);

Pic.PixelFormat := pf24bit;

Pic.HandleType:=bmDIB;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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

pic.PixelFormat := pf24bit;

pic.HandleType:=bmDIB;

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

Pic.Width:= High(tPix)+1;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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 TForm1.btnExeClick(Sender: TObject);

var n :Integer;

begin

n := StrToInt(txtN.Text);

Bits.LoadFromFile(‘Test.bmp‘);

SmoothPicture(Bits,n);

PaintBox1.Refresh;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Bits.Free;

end;

end.

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


原图	柔化系数=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);

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 TfrmMain.FormCreate(Sender: TObject);

begin

Bits := TBitmap.Create;

Bits.LoadFromFile(‘Test.bmp‘);

end;

procedure TfrmMain.FormDestroy(Sender: TObject);

begin

Bits.Free;

end;

procedure TfrmMain.btnExecuteClick(Sender: TObject);

var n : Single;c : Integer;

begin

Bits.LoadFromFile(‘Test.BMP‘);

Val(txtS.Text,n,c);

SharpPic(Bits,n);

PaintBox1.Refresh;

end;

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

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

begin

SetLength(tPix,Pic.Width,Pic.Height);

Pic.PixelFormat := pf24bit;

Pic.HandleType:=bmDIB;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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

pic.PixelFormat := pf24bit;

pic.HandleType:=bmDIB;

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

Pic.Width:= High(tPix)+1;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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 TfrmMain.SharpPic(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 Bit.Width-1 do begin

im := i-1;

For j := 1 to Bit.Height-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 TfrmMain.PaintBox1Paint(Sender: TObject);

begin

PaintBox1.Canvas.StretchDraw(Rect(0,0,400,300),Bits);

end;

end.

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


原图	锐化系数 = 0.95

探究Delphi的图形处理之八 -- 图像混合(透明度)效果　

　图像混合(透明度)效果

这种效果经常用在动画的转场过度上。这是一个由图像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

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 TForm1.FormCreate(Sender: TObject);

begin

BitA := TBitmap.create;

BitB := TBitmap.Create;

Bits := TBitmap.Create;

BitA.LoadFromFile(‘PicA.bmp‘);

BitB.LoadFromFile(‘PicB.bmp‘);

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

Bits.PixelFormat := pf24Bit;

ReadPixel(BitA,PixA);

ReadPixel(BitB,PixB);

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

begin

PaintBox1.Canvas.Draw(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:=PicR.Width-1;

for i := 0 to picR.Height -1 do begin

PixPtrR := picR.ScanLine[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,Pic.Width,Pic.Height);

Pic.PixelFormat := pf24bit;

Pic.HandleType:=bmDIB;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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

pic.PixelFormat := pf24bit;

pic.HandleType:=bmDIB;

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

Pic.Width:= High(tPix)+1;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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 TForm1.FormDestroy(Sender: TObject);

begin

BitB.Free;

BitA.Free;

BitS.Free;

end;

procedure TForm1.scAChange(Sender: TObject);

begin

GraphicFading(PixA,PixB,Bits,scA.Position);

paintBox1.Canvas.Draw(0,0,Bits);

lblPos.Caption := IntToStr(scA.Position) + ‘ %‘;

lblPos.Refresh;

end;

end.

探究Delphi的图形处理之九 -- 转为灰度图像　

作者:何咏发布日期:(2005-4-12 20:56:06

　转为灰度图像

将图像转为灰度的算法非常简单，把图像中每一个像素的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

Function GraphicToGray(const Pic: Tbitmap): Integer;

var

i,j : integer;

pixPtr : PRGBTriple;

picH : integer;

picW : Integer;

GrayVal : Byte;

Begin

Pic.PixelFormat := pf24Bit;

Pic.HandleType := bmDIB;

picH := pic.Height;

picW := pic.Width;

for i := 0 to picH -1 do begin

pixPtr := pic.ScanLine[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;

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


原图	处理后

探究Delphi的图形处理之十 -- 对比度调整和反色处理　

　对比度调整和反色处理

图像对比度是指图像颜色值与中间颜色值的距离大小。在图形处理中，我们定义颜色RGB(127,127,127)为中间颜色值。增大或减小某一个像素值与这个值的差距就可以提高和降低图像的颜色值。如果我们记对比度调整前每一颜色通道（即像素颜色值的R、G、B分值）的值为x，修改后的值为y，那么有下图所示的线性关系：

从图中我们可以看出，对于未调整的图像，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 Pic.Width-1 do begin

For j := 0 to Pic.Height-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;

end;

WritePixel(pic,tPix);

end;

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


原图	对比度系数k = 1.5	对比度系数 k = -1

探究Delphi的图形处理之十一 -- 亮度的调整　

作者:何咏

　亮度的调整

我们知道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);

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,Pic.Width,Pic.Height);

Pic.PixelFormat := pf24bit;

Pic.HandleType:=bmDIB;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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

pic.PixelFormat := pf24bit;

pic.HandleType:=bmDIB;

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

Pic.Width:= High(tPix)+1;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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 TForm1.BrightnessChange(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 TForm1.FormCreate(Sender: TObject);

var i,j :Integer;

begin

Bits := TBitmap.Create;

Bits.LoadFromFile(‘Test.bmp‘);

ReadPixel(Bits,Pix);

SetLength(PixA,Bits.Width,Bits.Height);

For i := 0 to Bits.Width-1 do begin

For j := 0 to Bits.Height-1 do begin

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

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Bits.Free;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

begin

PaintBox1.Canvas.Draw(0,0,Bits);

end;

procedure TForm1.scBChange(Sender: TObject);

var i,j : Integer;

begin

Caption := IntToStr(scB.Position) + ‘%‘;

For i := 0 to Bits.Width-1 do begin

For j := 0 to Bits.Height-1 do begin

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

end;

BrightnessChange(Pix,scB.Position);

WritePixel(Bits,Pix);

PaintBox1.Canvas.Draw(0,0,Bits);

end;

end.

程序的运行结果如下。


亮度-50	原图	亮度+50

探究Delphi的图形处理之十二 -- 浮雕效果　

　浮雕效果

浮雕效果的原理是将图像的每一个像素的颜色值与该像素斜下方的像素值的差的绝对值加上一个常数。这个常数决定了浮雕效果的亮度。程序3.7给出了浮雕效果的源代码。

程序3.7

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);

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,Pic.Width,Pic.Height);

Pic.PixelFormat := pf24bit;

Pic.HandleType:=bmDIB;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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

pic.PixelFormat := pf24bit;

pic.HandleType:=bmDIB;

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

Pic.Width:= High(tPix)+1;

For i :=0 to pic.Height-1 do begin

PixPtr:=Pic.ScanLine[i];

for j:= 0 to pic.Width-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 TFrmMain.Emboss(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 TfrmMain.FormCreate(Sender: TObject);

var i,j:Integer;

begin

Bits := TBitmap.Create;

Bits.LoadFromFile(‘Test.bmp‘);

ReadPixel(Bits,Pix);

SetLength(PixA,Bits.Width,Bits.Height);

For i := 0 to Bits.Width-1 do begin

For j := 0 to Bits.Height-1 do begin

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

end;

procedure TfrmMain.FormDestroy(Sender: TObject);

begin

Bits.Free;

end;

procedure TfrmMain.scSChange(Sender: TObject);

var i,j:Integer;

begin

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

Caption := IntToStr(scS.Position);

{先将像素值复原}

For i := 0 to Bits.Width-1 do begin

For j := 0 to Bits.Height-1 do begin

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

end;

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

WritePixel(Bits,Pix);

PaintBox1.Canvas.Draw(0,0,Bits); //显示结果。

end;

procedure TfrmMain.PaintBox1Paint(Sender: TObject);

begin

PaintBox1.Canvas.Draw(0,0,Bits);

end;

procedure TfrmMain.PaintBox1Click(Sender: TObject);

begin

WritePixel(Bits,PixA);

PaintBox1.Canvas.Draw(0,0,Bits);

end;

end.

下图是程序的运行结果。


原图	浮雕亮度 = 127

探究Delphi的图形处理之十三 -- 马赛克效果　

　马赛克效果

马赛克效果的原理是，把图象分割成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<= Bit.Width-1 do begin

ip:= i + nDivRs;

im := i ;

if im < 0 then im := 0;

if ip > Bit.Width -1 then ip := Bit.Width-1;

j := 0;

While j <= Bit.Height-1 do begin

R:=0;

G:=0;

B:=0;

jP := j + nDivRs;

jM := j - nDivRs;

if Jp > bit.Height-1 then

jp := Bit.Height-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

【上篇】Delphi 钩子（1）
【下篇】Delphi Windows消息 2

作者: kobold

该日志由 kobold 于6年前发表在综合分类下，最后更新于 2018年05月27日.
转载请注明: Delphi GDI+ 图形处理（3） | 学步园 +复制链接

抱歉!评论已关闭.

学步园

Delphi GDI+ 图形处理（3）

作者: kobold

书签

最新文章New

本站推荐

返回首页