探究Delphi的圖形處理 之七 -- 柔化和銳化處理
作者:何詠 發(fā)布日期:(2005-4-12 21:01:21)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
第三章 基本圖像處理算法
3.1柔化和銳化處理
柔化處理的原理是將圖片中每一個(gè)像素都由與其相鄰的n*n個(gè)像素的平均值來(lái)代替。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;
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.
程序的運行結果如下圖所示。
原圖
柔化系數=21
銳化處理的原理是把每一像素的值與該像素斜上方的像素值之差乘以一個(gè)系數再加上該像素原來(lái)的顏色值。如果記圖像中任意一個(gè)像素(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
根據這個(gè)公式，我們的程序如下：
程序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.
程序的運行結果如下圖所示。
原圖
銳化系數 = 0.95
探究Delphi的圖形處理 之八 -- 圖像混合(透明度)效果
作者:何詠 發(fā)布日期:(2005-4-12 20:57:58)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
圖像混合(透明度)效果
這種效果經(jīng)常用在動(dòng)畫(huà)的轉場(chǎng)過(guò)度上。這是一個(gè)由圖像A逐漸變化為圖像B的中間效果。就像向圖像B以變量N為透明度覆蓋在圖像B一樣。下圖展示了這種效果。
透明度 = 100%
透明度 = 50%
透明度 = 0%
圖像過(guò)渡效果的原理是，如果記透明度為A，那么在確保圖像A和圖像B同等大小的情況下，創(chuàng )建一個(gè)與圖像A或B等大的圖像C，對于圖像C中每一個(gè)像素點(diǎn)P(x,y)，它的顏色值為：
R = 圖像A的像素點(diǎn)(x,y).R +(圖像B的像素點(diǎn)(x,y).R-圖像A的像素點(diǎn)(x,y).R)×A
G = 圖像A的像素點(diǎn)(x,y).G +(圖像B的像素點(diǎn)(x,y).G-圖像A的像素點(diǎn)(x,y).G)×A
B = 圖像A的像素點(diǎn)(x,y).B +(圖像B的像素點(diǎn)(x,y).B-圖像A的像素點(diǎn)(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); //這個(gè)語(yǔ)句可以把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的圖形處理 之九 -- 轉為灰度圖像
作者:何詠 發(fā)布日期:(2005-4-12 20:56:06)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
轉為灰度圖像
將圖像轉為灰度的算法非常簡(jiǎn)單，把圖像中每一個(gè)像素的R、G、B分值都設置為該像素R、G、B分值的平均值即可。這是因為，在RGB編碼中，如果一個(gè)像素的R、G、B分值相等，那么這就是一個(gè)灰色的像素。例如RGB(i,i,i) (i∈[0,255])可以表示不同灰度等級的灰色。當i = 255時(shí)，該像素為白色，當 i = 0時(shí)，該像素為白色。下面的程序段給出了灰度圖像的算法。這一次，我們使用PRGBTriple類(lèi)型作為ScanLine的指針類(lèi)型，大家可以參考一下。
程序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的圖形處理 之十 -- 對比度調整和反色處理
作者:何詠 發(fā)布日期:(2005-4-12 20:54:42)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
對比度調整和反色處理
圖像對比度是指圖像顏色值與中間顏色值的距離大小。在圖形處理中，我們定義顏色RGB(127,127,127)為中間顏色值。增大或減小某一個(gè)像素值與這個(gè)值的差距就可以提高和降低圖像的顏色值。如果我們記對比度調整前每一顏色通道（即像素顏色值的R、G、B分值）的值為x，修改后的值為y，那么有下圖所示的線(xiàn)性關(guān)系：
從圖中我們可以看出，對于未調整的圖像，f(x) = x。如果調整了對比度，那么f(x) 的圖像以點(diǎn)(127,127)為原點(diǎn)旋轉。如果我們設f(x)= kx + b，提高對比度的問(wèn)題就轉變?yōu)楦鶕求b，在用k和b求f(x)的值的問(wèn)題（也就是轉換坐標系的問(wèn)題）。其中，k是由用戶(hù)指定的，它決定了是提高對比度還是降低對比度。如果k>1，就提高對比度，反之則降低對比度。如果k<0，那么可以達到反色的效果。
如果我們以點(diǎn)(127,127)為原點(diǎn)作一個(gè)平面直角坐標系，那么在新的坐標系XOY中，我們有Y = kX。把坐標系XOY向左、向下各移動(dòng)127個(gè)單位，此時(shí)XOY與xoy重合，我們得到
Y = k(x-127) + 127
因此，我們得到了下面的公式：
NewRed = k(OldRed - 127) + 127
NewGreen = k(OldGreen - 127) + 127
NewBlue = k(OldBlue - 127) + 127
我們用下面的程序段可以實(shí)現對比度的調整。這里直接調用了第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的圖形處理 之十一 -- 亮度的調整
作者:何詠 發(fā)布日期:(2005-4-12 20:52:53)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
亮度的調整
我們知道RGB(255,255,255)表示白色，而RGB(0,0,0)表示黑色。由此，如果RGB分量的值越接近255，這個(gè)像素越“亮”，如果越接近0，那么像素越“暗”。所以，亮度調整的原理就是對原圖像的每一個(gè)像素的RGB值都加上或減去一個(gè)常量即可。
下面的程序可以調整圖像的亮度。
程序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.
程序的運行結果如下。
亮度-50
原圖
亮度+50
探究Delphi的圖形處理 之十二 -- 浮雕效果
作者:何詠 發(fā)布日期:(2005-4-12 20:50:03)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
浮雕效果
浮雕效果的原理是將圖像的每一個(gè)像素的顏色值與該像素斜下方的像素值的差的絕對值加上一個(gè)常數。這個(gè)常數決定了浮雕效果的亮度。程序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; // 當前像素值與下一個(gè)像素值的差的絕對值+系數n。
{如果像素值超過(guò)范圍，設置像素值為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);//調用浮雕效果處理過(guò)程。
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的圖形處理 之十三 -- 馬賽克效果
作者:何詠 發(fā)布日期:(2005-4-12 20:46:54)
聲明：本文著(zhù)作權屬于何詠,如要轉載請聲明作者及出處。
馬賽克效果
馬賽克效果的原理是，把圖象分割成n*n的小塊，把每一個(gè)區域中的所有像素值變?yōu)檫@個(gè)區域像素值的平均值即可。下面的程序段可以實(shí)現這種效果。這里調用了第二章給出的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
