|
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;
end;
Pix[i,j].rgbtBlue := B div opCount;
Pix[i,j].rgbtGreen := G div opCount;
Pix[i,j].rgbtRed := R div opCount;
end;
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;
end;
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;
end;
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.
锐化处理的原理是把每一像素的值与该像素斜上方的像素值之差乘以一个系数再加上该像素原来的颜色值。
如果记图像中任意一个像素(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;
end;
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;
end;
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;
end;
WritePixel(Bit,Pix);
end;
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.StretchDraw(Rect(0,0,400,300),Bits);
end;
end.
|
程序的运行结果如下图所示。
|
探究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;
end;
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;
end;
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;
end;
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;
end;
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;
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;
end;
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;
end;
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;
end;
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;
end;
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;
end;
BrightnessChange(Pix,scB.Position);
WritePixel(Bits,Pix);
PaintBox1.Canvas.Draw(0,0,Bits);
end;
end.
|
程序的运行结果如下。
|
探究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;
end;
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;
end;
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;
end;
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;
end;
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;
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.
|
下图是程序的运行结果。
|
探究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;
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;
end;
j := j + n;
end;
i := i + n;
end;
WritePixel(Bit,Pix);
end;
|
以下是程序的运行结果。
|
|
|
|
原图
|
马赛克大小 = 25
|
Delphi GDI+ 图形处理（3）
|
