Delphi基本图像处理代码

2023-05-14 02:02•javascript•阅读 2009

Delphi基本图像处理代码

//浮雕

procedure Emboss(SrcBmp,DestBmp:TBitmap;AzimuthChange:integer);overload;

var

i, j, Gray, Azimuthvalue, R, G, B: integer;

SrcRGB, SrcRGB1, SrcRGB2, DestRGB: pRGBTriple;

begin

for i := 0 to SrcBmp.Height - 1 do

begin

SrcRGB := SrcBmp.ScanLine[i];

DestRGB := DestBmp.ScanLine[i];

if (AzimuthChange >= -180) and (AzimuthChange < -135) then

begin

if i > 0 then

SrcRGB1 := SrcBmp.ScanLine[i-1]

else

SrcRGB1 := SrcRGB;

Inc(SrcRGB1);

SrcRGB2 := SrcRGB;

Inc(SrcRGB2);

end

else if (AzimuthChange >= -135) and (AzimuthChange < -90) then

begin

if i > 0 then

SrcRGB1 := SrcBmp.ScanLine[i-1]

else

SrcRGB1 := SrcRGB;

SrcRGB2 := SrcRGB1;

Inc(SrcRGB2);

end

else if (AzimuthChange >= -90) and (AzimuthChange < -45) then

begin

if i > 0 then

SrcRGB1 := SrcBmp.ScanLine[i-1]

else

SrcRGB1 := SrcRGB;

SrcRGB2 := SrcRGB1;

end

else if (AzimuthChange >= -45) and (AzimuthChange < 0) then

begin

SrcRGB1 := SrcRGB;

if i > 0 then

SrcRGB2 := SrcBmp.ScanLine[i-1]

else

SrcRGB2 := SrcRGB;

end

else if (AzimuthChange >= 0) and (AzimuthChange < 45) then

begin

SrcRGB2 := SrcRGB;

if (i < SrcBmp.Height - 1) then

SrcRGB1 := SrcBmp.ScanLine[i+1]

else

SrcRGB1 := SrcRGB;

end

else if (AzimuthChange >= 45) and (AzimuthChange < 90) then

begin

if (i < SrcBmp.Height - 1) then

SrcRGB1 := SrcBmp.ScanLine[i+1]

else

SrcRGB1 := SrcRGB;

SrcRGB2 := SrcRGB1;

end

else if (AzimuthChange >= 90) and (AzimuthChange < 135) then

begin

if (i < SrcBmp.Height - 1) then

SrcRGB1 := SrcBmp.ScanLine[i+1]

else

SrcRGB1 := SrcRGB;

SrcRGB2 := SrcRGB1;

Inc(SrcRGB1);

end

else if (AzimuthChange >= 135) and (AzimuthChange <= 180) then

begin

if (i < SrcBmp.Height - 1) then

SrcRGB2 := SrcBmp.ScanLine[i+1]

else

SrcRGB2 := SrcRGB;

Inc(SrcRGB2);

SrcRGB1 := SrcRGB;

Inc(SrcRGB1);

end;

for j := 0 to SrcBmp.Width - 1 do

begin

if (AzimuthChange >= -180) and (AzimuthChange < -135) then

begin

Azimuthvalue := AzimuthChange + 180;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= -135) and (AzimuthChange < -90) then

begin

Azimuthvalue := AzimuthChange + 135;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= -90) and (AzimuthChange < -45) then

begin

if j=1 then Inc(SrcRGB1,-1);

Azimuthvalue := AzimuthChange + 90;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= -45) and (AzimuthChange < 0) then

begin

if j=1 then

begin

Inc(SrcRGB1,-1);

Inc(SrcRGB2,-1);

end;

Azimuthvalue := AzimuthChange + 45;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= 0) and (AzimuthChange < 45) then

begin

if j=1 then

begin

Inc(SrcRGB1,-1);

Inc(SrcRGB2,-1);

end;

Azimuthvalue := AzimuthChange;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= 45) and (AzimuthChange < 90) then

begin

if j=1 then Inc(SrcRGB2,-1);

Azimuthvalue := AzimuthChange - 45;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= 90) and (AzimuthChange < 135) then

begin

Azimuthvalue := AzimuthChange - 90;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end

else if (AzimuthChange >= 135) and (AzimuthChange <= 180) then

begin

Azimuthvalue := AzimuthChange - 135;

R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;

G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;

B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;

end;

R:=Min(R,255);

R:=Max(R,0);

G:=Min(G,255);

G:=Max(G,0);

B:=Min(B,255);

B:=Max(B,0);

Gray := (R shr 2) + (R shr 4) + (G shr 1) + (G shr 4) + (B shr 3);

DestRGB.rgbtRed:=Gray;

DestRGB.rgbtGreen:=Gray;

DestRGB.rgbtBlue:=Gray;

if (j=-180) and (AzimuthChange<-135)) or ((AzimuthChange>=90) and (AzimuthChange<=180))) then

begin

Inc(SrcRGB1);

end;

if (j=135) and (AzimuthChange<180)) or ((AzimuthChange>=-180) and (AzimuthChange<=-90))) then

begin

Inc(SrcRGB2);

end;

Inc(SrcRGB);

Inc(DestRGB);

end;

procedure Emboss(Bmp:TBitmap;AzimuthChange:integer;ElevationChange:integer;WeightChange:integer);overload;

var

DestBmp:TBitmap;

begin

　　DestBmp:=TBitmap.Create;

　　DestBmp.Assign(Bmp);

　　Emboss(Bmp,DestBmp,AzimuthChange,ElevationChange,WeightChange);

　　Bmp.Assign(DestBmp);

end;

//反色

procedure Negative(Bmp:TBitmap);

var

i, j: Integer;

PRGB: pRGBTriple;

begin

Bmp.PixelFormat:=pf24Bit;

for i := 0 to Bmp.Height - 1 do

begin

PRGB := Bmp.ScanLine[i];

for j := 0 to Bmp.Width - 1 do

begin

PRGB^.rgbtRed :=not PRGB^.rgbtRed ;

PRGB^.rgbtGreen :=not PRGB^.rgbtGreen;

PRGB^.rgbtBlue :=not PRGB^.rgbtBlue;

Inc(PRGB);

end;

//曝光

procedure Exposure(Bmp:TBitmap);

var

i, j: integer;

PRGB: pRGBTriple;

begin

Bmp.PixelFormat:=pf24Bit;

for i := 0 to Bmp.Height - 1 do

begin

PRGB := Bmp.ScanLine[i];

for j := 0 to Bmp.Width - 1 do

begin

if PRGB^.rgbtRed<128 then

PRGB^.rgbtRed :=not PRGB^.rgbtRed ;

if PRGB^.rgbtGreen<128 then

PRGB^.rgbtGreen :=not PRGB^.rgbtGreen;

if PRGB^.rgbtBlue<128 then

PRGB^.rgbtBlue :=not PRGB^.rgbtBlue;

Inc(PRGB);

end;

//模糊

procedure Blur(SrcBmp:TBitmap);

var

i, j:Integer;

SrcRGB:pRGBTriple;

SrcNextRGB:pRGBTriple;

SrcPreRGB:pRGBTriple;

Value:Integer;

procedure IncRGB;

begin

Inc(SrcPreRGB);

Inc(SrcRGB);

Inc(SrcNextRGB);

end;

procedure DecRGB;

begin

Inc(SrcPreRGB,-1);

Inc(SrcRGB,-1);

Inc(SrcNextRGB,-1);

end;

begin

SrcBmp.PixelFormat:=pf24Bit;

for i := 0 to SrcBmp.Height - 1 do

begin

if i > 0 then

SrcPreRGB:=SrcBmp.ScanLine[i-1]

else

SrcPreRGB := SrcBmp.ScanLine[i];

SrcRGB := SrcBmp.ScanLine[i];

if i < SrcBmp.Height - 1 then

SrcNextRGB:=SrcBmp.ScanLine[i+1]

else

SrcNextRGB:=SrcBmp.ScanLine[i];

for j := 0 to SrcBmp.Width - 1 do

begin

if j > 0 then DecRGB;

Value:=SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed;

if j > 0 then IncRGB;

Value:=Value+SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed;

if j < SrcBmp.Width - 1 then IncRGB;

Value:=(Value+SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed) div 9;

DecRGB;

SrcRGB.rgbtRed:=value;

if j > 0 then DecRGB;

Value:=SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen;

if j > 0 then IncRGB;

Value:=Value+SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen;

if j < SrcBmp.Width - 1 then IncRGB;

Value:=(Value+SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen) div 9;

DecRGB;

SrcRGB.rgbtGreen:=value;

if j > 0 then DecRGB;

Value:=SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue;

if j > 0 then IncRGB;

Value:=Value+SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue;

if j < SrcBmp.Width - 1 then IncRGB;

Value:=(Value+SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue) div 9;

DecRGB;

SrcRGB.rgbtBlue:=value;

IncRGB;

end;

//锐化

procedure Sharpen(SrcBmp:TBitmap);

var

i, j: integer;

SrcRGB: pRGBTriple;

SrcPreRGB: pRGBTriple;

Value: integer;

begin

SrcBmp.PixelFormat:=pf24Bit;

for i := 0 to SrcBmp.Height - 1 do

begin

SrcRGB := SrcBmp.ScanLine[i];

if i > 0 then

SrcPreRGB:=SrcBmp.ScanLine[i-1]

else

SrcPreRGB:=SrcBmp.ScanLine[i];

for j := 0 to SrcBmp.Width - 1 do

begin

if j = 1 then Dec(SrcPreRGB);

Value:=SrcRGB.rgbtRed+(SrcRGB.rgbtRed-SrcPreRGB.rgbtRed) div 2;

Value:=Max(0,Value);

Value:=Min(255,Value);

SrcRGB.rgbtRed:=value;

Value:=SrcRGB.rgbtGreen+(SrcRGB.rgbtGreen-SrcPreRGB.rgbtGreen) div 2;

Value:=Max(0,Value);

Value:=Min(255,Value);

SrcRGB.rgbtGreen:=value;

Value:=SrcRGB.rgbtBlue+(SrcRGB.rgbtBlue-SrcPreRGB.rgbtBlue) div 2;

Value:=Max(0,Value);

Value:=Min(255,Value);

SrcRGB.rgbtBlue:=value;

Inc(SrcRGB);

Inc(SrcPreRGB);

end;

[图像的旋转和翻转]

以下代码用ScanLine配合指针移动实现，用于24位色！

//旋转90度

procedure Rotate90(const Bitmap:TBitmap);

var

i,j:Integer;

rowIn,rowOut:pRGBTriple;

Bmp:TBitmap;

Width,Height:Integer;

begin

Bmp:=TBitmap.Create;

Bmp.Width := Bitmap.Height;

Bmp.Height := Bitmap.Width;

Bmp.PixelFormat := pf24bit;

Width:=Bitmap.Width-1;

Height:=Bitmap.Height-1;

for j := 0 to Height do

begin

rowIn := Bitmap.ScanLine[j];

for i := 0 to Width do

begin

rowOut := Bmp.ScanLine[i];

Inc(rowOut,Height - j);

rowOut^ := rowIn^;

Inc(rowIn);

end;

Bitmap.Assign(Bmp);

end;

//旋转180度

procedure Rotate180(const Bitmap:TBitmap);

var

i,j:Integer;

rowIn,rowOut:pRGBTriple;

Bmp:TBitmap;

Width,Height:Integer;

begin

Bmp:=TBitmap.Create;

Bmp.Width := Bitmap.Width;

Bmp.Height := Bitmap.Height;

Bmp.PixelFormat := pf24bit;

Width:=Bitmap.Width-1;

Height:=Bitmap.Height-1;

for j := 0 to Height do

begin

rowIn := Bitmap.ScanLine[j];

for i := 0 to Width do

begin

rowOut := Bmp.ScanLine[Height - j];

Inc(rowOut,Width - i);

rowOut^ := rowIn^;

Inc(rowIn);

end;

Bitmap.Assign(Bmp);

end;

//旋转270度

procedure Rotate270(const Bitmap:TBitmap);

var

i,j:Integer;

rowIn,rowOut:pRGBTriple;

Bmp:TBitmap;

Width,Height:Integer;

begin

Bmp:=TBitmap.Create;

Bmp.Width := Bitmap.Height;

Bmp.Height := Bitmap.Width;

Bmp.PixelFormat := pf24bit;

Width:=Bitmap.Width-1;

Height:=Bitmap.Height-1;

for j := 0 to Height do

begin

rowIn := Bitmap.ScanLine[j];

for i := 0 to Width do

begin

rowOut := Bmp.ScanLine[Width - i];

Inc(rowOut,j);

rowOut^ := rowIn^;

Inc(rowIn);

end;

Bitmap.Assign(Bmp);

end;

//任意角度

function RotateBitmap(Bitmap:TBitmap;Angle:Integer;BackColor:TColor):TBitmap;

var

i,j,iOriginal,jOriginal,CosPoint,SinPoint : integer;

RowOriginal,RowRotated : pRGBTriple;

SinTheta,CosTheta : Extended;

AngleAdd : integer;

begin

Result:=TBitmap.Create;

Result.PixelFormat := pf24bit;

Result.Canvas.Brush.Color:=BackColor;

Angle:=Angle Mod 360;

if Angle<0 then Angle:=360-Abs(Angle);

if Angle=0 then

Result.Assign(Bitmap)

else if Angle=90 then

begin

Result.Assign(Bitmap);

Rotate90(Result);//如果是旋转90度，直接调用上面的代码

end

else if (Angle>90) and (Angle<180) then

begin

AngleAdd:=90;

Angle:=Angle-AngleAdd;

end

else if Angle=180 then

begin

Result.Assign(Bitmap);

Rotate180(Result);//如果是旋转180度，直接调用上面的过程

end

else if (Angle>180) and (Angle<270) then

begin

AngleAdd:=180;

Angle:=Angle-AngleAdd;

end

else if Angle=270 then

begin

Result.Assign(Bitmap);

Rotate270(Result);//如果是旋转270度，直接调用上面的过程

end

else if (Angle>270) and (Angle<360) then

begin

AngleAdd:=270;

Angle:=Angle-AngleAdd;

end

else

AngleAdd:=0;

if (Angle>0) and (Angle<90) then

begin

SinCos((Angle + AngleAdd) * Pi / 180, SinTheta, CosTheta);

if (SinTheta * CosTheta) < 0 then

begin

Result.Width := Round(Abs(Bitmap.Width * CosTheta - Bitmap.Height * SinTheta));

Result.Height := Round(Abs(Bitmap.Width * SinTheta - Bitmap.Height * CosTheta));

end

else

begin

Result.Width := Round(Abs(Bitmap.Width * CosTheta + Bitmap.Height * SinTheta));

Result.Height := Round(Abs(Bitmap.Width * SinTheta + Bitmap.Height * CosTheta));

end;

CosTheta:=Abs(CosTheta);

SinTheta:=Abs(SinTheta);

if (AngleAdd=0) or (AngleAdd=180) then

begin

CosPoint:=Round(Bitmap.Height*CosTheta);

SinPoint:=Round(Bitmap.Height*SinTheta);

end

else

begin

SinPoint:=Round(Bitmap.Width*CosTheta);

CosPoint:=Round(Bitmap.Width*SinTheta);

end;

for j := 0 to Result.Height-1 do

begin

RowRotated := Result.Scanline[j];

for i := 0 to Result.Width-1 do

begin

Case AngleAdd of

begin

jOriginal := Round((j+1)*CosTheta-(i+1-SinPoint)*SinTheta)-1;

iOriginal := Round((i+1)*CosTheta-(CosPoint-j-1)*SinTheta)-1;

end;

90:

begin

iOriginal := Round((j+1)*SinTheta-(i+1-SinPoint)*CosTheta)-1;

jOriginal := Bitmap.Height-Round((i+1)*SinTheta-(CosPoint-j-1)*CosTheta);

end;

180:

begin

jOriginal := Bitmap.Height-Round((j+1)*CosTheta-(i+1-SinPoint)*SinTheta);

iOriginal := Bitmap.Width-Round((i+1)*CosTheta-(CosPoint-j-1)*SinTheta);

end;

270:

begin

iOriginal := Bitmap.Width-Round((j+1)*SinTheta-(i+1-SinPoint)*CosTheta);

jOriginal := Round((i+1)*SinTheta-(CosPoint-j-1)*CosTheta)-1;

end;

if (iOriginal >= 0) and (iOriginal <= Bitmap.Width-1)and

(jOriginal >= 0) and (jOriginal <= Bitmap.Height-1)

then

begin

RowOriginal := Bitmap.Scanline[jOriginal];

Inc(RowOriginal,iOriginal);

RowRotated^ := RowOriginal^;

Inc(RowRotated);

end

else

begin

Inc(RowRotated);

end;

//水平翻转

procedure FlipHorz(const Bitmap:TBitmap);

var

i,j:Integer;

rowIn,rowOut:pRGBTriple;

Bmp:TBitmap;

Width,Height:Integer;

begin

Bmp:=TBitmap.Create;

Bmp.Width := Bitmap.Width;

Bmp.Height := Bitmap.Height;

Bmp.PixelFormat := pf24bit;

Width:=Bitmap.Width-1;

Height:=Bitmap.Height-1;

for j := 0 to Height do

begin

rowIn := Bitmap.ScanLine[j];

for i := 0 to Width do

begin

rowOut := Bmp.ScanLine[j];

Inc(rowOut,Width - i);

rowOut^ := rowIn^;

Inc(rowIn);

end;

Bitmap.Assign(Bmp);

end;

//垂直翻转

procedure FlipVert(const Bitmap:TBitmap);

var

i,j:Integer;

rowIn,rowOut:pRGBTriple;

Bmp:TBitmap;

Width,Height:Integer;

begin

Bmp:=TBitmap.Create;

Bmp.Width := Bitmap.Height;

Bmp.Height := Bitmap.Width;

Bmp.PixelFormat := pf24bit;

Width:=Bitmap.Width-1;

Height:=Bitmap.Height-1;

for j := 0 to Height do

begin

rowIn := Bitmap.ScanLine[j];

for i := 0 to Width do

begin

rowOut := Bmp.ScanLine[Height - j];

Inc(rowOut,i);

rowOut^ := rowIn^;

Inc(rowIn);

end;

Bitmap.Assign(Bmp);

end;

[亮度、对比度、饱和度的调整]

以下代码用ScanLine配合指针移动实现！

function Min(a, b: integer): integer;

begin

if a < b then

result := a

else

result := b;

end;

function Max(a, b: integer): integer;

begin

if a > b then

result := a

else

result := b;

end;

//亮度调整

procedure BrightnessChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer);

var

i, j: integer;

SrcRGB, DestRGB: pRGBTriple;

begin

for i := 0 to SrcBmp.Height - 1 do

begin

SrcRGB := SrcBmp.ScanLine[i];

DestRGB := DestBmp.ScanLine[i];

for j := 0 to SrcBmp.Width - 1 do

begin

if ValueChange > 0 then

begin

DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + ValueChange);

DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + ValueChange);

DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + ValueChange);

end else begin

DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed + ValueChange);

DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen + ValueChange);

DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue + ValueChange);

end;

Inc(SrcRGB);

Inc(DestRGB);

end;

//对比度调整

procedure ContrastChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer);

var

i, j: integer;

SrcRGB, DestRGB: pRGBTriple;

begin

for i := 0 to SrcBmp.Height - 1 do

begin

SrcRGB := SrcBmp.ScanLine[i];

DestRGB := DestBmp.ScanLine[i];

for j := 0 to SrcBmp.Width - 1 do

begin

if ValueChange>=0 then

begin

if SrcRGB.rgbtRed >= 128 then

DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + ValueChange)

else

DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed - ValueChange);

if SrcRGB.rgbtGreen >= 128 then

DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + ValueChange)

else

DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen - ValueChange);

if SrcRGB.rgbtBlue >= 128 then

DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + ValueChange)

else

DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue - ValueChange);

end

else

begin

if SrcRGB.rgbtRed >= 128 then

DestRGB.rgbtRed := Max(128, SrcRGB.rgbtRed + ValueChange)

else

DestRGB.rgbtRed := Min(128, SrcRGB.rgbtRed - ValueChange);

if SrcRGB.rgbtGreen >= 128 then

DestRGB.rgbtGreen := Max(128, SrcRGB.rgbtGreen + ValueChange)

else

DestRGB.rgbtGreen := Min(128, SrcRGB.rgbtGreen - ValueChange);

if SrcRGB.rgbtBlue >= 128 then

DestRGB.rgbtBlue := Max(128, SrcRGB.rgbtBlue + ValueChange)

else

DestRGB.rgbtBlue := Min(128, SrcRGB.rgbtBlue - ValueChange);

end;

Inc(SrcRGB);

Inc(DestRGB);

end;

//饱和度调整

procedure SaturationChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer);

var

Grays: array[0..767] of Integer;

Alpha: array[0..255] of Word;

Gray, x, y: Integer;

SrcRGB,DestRGB: pRGBTriple;

i: Byte;

begin

ValueChange:=ValueChange+255;

for i := 0 to 255 do

Alpha[i] := (i * ValueChange) Shr 8;

x := 0;

for i := 0 to 255 do

begin

Gray := i - Alpha[i];

Grays[x] := Gray;

Inc(x);

Grays[x] := Gray;

Inc(x);

Grays[x] := Gray;

Inc(x);

end;

for y := 0 to SrcBmp.Height - 1 do

begin

SrcRGB := SrcBmp.ScanLine[Y];

DestRGB := DestBmp.ScanLine[Y];

for x := 0 to SrcBmp.Width - 1 do

begin

Gray := Grays[SrcRGB.rgbtRed + SrcRGB.rgbtGreen + SrcRGB.rgbtBlue];

if Gray + Alpha[SrcRGB.rgbtRed]>0 then

DestRGB.rgbtRed := Min(255,Gray + Alpha[SrcRGB.rgbtRed])

else

DestRGB.rgbtRed := 0;

if Gray + Alpha[SrcRGB.rgbtGreen]>0 then

DestRGB.rgbtGreen := Min(255,Gray + Alpha[SrcRGB.rgbtGreen])

else

DestRGB.rgbtGreen := 0;

if Gray + Alpha[SrcRGB.rgbtBlue]>0 then

DestRGB.rgbtBlue := Min(255,Gray + Alpha[SrcRGB.rgbtBlue])

else

DestRGB.rgbtBlue := 0;

Inc(SrcRGB);

Inc(DestRGB);

end;

//RGB调整

procedure RGBChange(SrcBmp,DestBmp:TBitmap;RedChange,GreenChange,BlueChange:integer);

var

SrcRGB, DestRGB: pRGBTriple;

i,j:integer;

begin

for i := 0 to SrcBmp.Height- 1 do

begin

SrcRGB := SrcBmp.ScanLine[i];

DestRGB :=DestBmp.ScanLine[i];

for j := 0 to SrcBmp.Width - 1 do

begin

if RedChange> 0 then

DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + RedChange)

else

DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed + RedChange);

if GreenChange> 0 then

DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + GreenChange)

else

DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen + GreenChange);

if BlueChange> 0 then

DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + BlueChange)

else

DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue + BlueChange);

Inc(SrcRGB);

Inc(DestRGB);

end;

[颜色调整]

//RGB<=>BGR

procedure RGB2BGR(const Bitmap:TBitmap);

var

X: Integer;

Y: Integer;

PRGB: pRGBTriple;

Color: Byte;

begin

for Y := 0 to (Bitmap.Height - 1) do

begin

for X := 0 to (Bitmap.Width - 1) do

begin

Color := PRGB^.rgbtRed;

PRGB^.rgbtRed := PRGB^.rgbtBlue;

PRGB^.rgbtBlue := Color;

Inc(PRGB);

end;

end

end;

//灰度化(加权)

procedure Grayscale(const Bitmap:TBitmap);

var

X: Integer;

Y: Integer;

PRGB: pRGBTriple;

Gray: Byte;

begin

for Y := 0 to (Bitmap.Height - 1) do

begin

PRGB := Bitmap.ScanLine[Y];

for X := 0 to (Bitmap.Width - 1) do

begin

Gray := (77 * Red + 151 * Green + 28 * Blue) shr 8;

PRGB^.rgbtRed:=Gray;

PRGB^.rgbtGreen:=Gray;

PRGB^.rgbtBlue:=Gray;

Inc(PRGB);

end;

理论篇：

关键词：

绘图区－即窗口显示图像的区域，亦可为全屏幕（在全屏幕下绘图的效果比一般窗口下好）

中心点－即要绘图区显示的中心点在原始图像的坐标（声明：这个概念特别重要）

　　先说说图像的放大，要放大一张图片，我们一般的做法是直接放大图像，但本文介绍的方法仅放大我们能够看到的部分，放大分两种情况，一种是放大后比绘图区还要小，这种情况没什么好说，当然是显示全部的图像；第二种是放大后的图像比绘图区大，这才是我们今天要讨论的重点话题，这种情况下我们先要确定图像放大后的大小，然后根据“中心点”计算在原始图像的位置和大小，最后把截取的图像放大到绘图区。

　　再说说图像的漫游，当显示的图像超过绘图区时，我们需要对图像进行漫游，以便看到全部的图像。原理是：当鼠标在绘图区进行单击时，这时开始漫游，先记录鼠标的单击位置，然后检测鼠标的移动，根据鼠标和上次的位移计算出“中心点”（需要将屏幕坐标转换为原始图像坐标），根据在上面放大的原理到原始图像中取出要显示的部分，放大显示到绘图区。

算法实现篇：

1.图像放大

变量定义：

PZoom:放大率(整数:100时为100%，根据需要可以将 100 该为 10000 或者更大些，但不推荐使用浮点数)

a,b:中心点

w,h:要截取原始图像的宽和高

x,y:要截取的位置(左上角)

sw,sh:原始图像的宽和高

p1,p2:放大比例

aw,ah:放大后图像的大小

pw,ph:绘图区大小

vx,vy:在绘图区显示的位置（左上角）

vw,vh:在绘图区显示的大小

ptx,pty:临时变量

已知的变量：PZoom,(a,b),(sw,sh),(p1,p2),(aw,ah),(pw,ph)

要计算的变量：(x,y),(w,h),(vx,vy),(vw,vh)

开始计算：

aw=Round(PZoom*sw/100);

ah=Round(PZoom*sh/100);

p1=aw/pw

p2=ah/ph

// 注：Round 用于取整，如其他语言的Int(),Fix()等

if p1>1 then w=Round(sw/p1) else w=sw

if p2>1 then h=Round(sh/p2) else h=sh

// 注：shr 为右移运算符，可以使用“>>1”、“div 2”、“\2”或“Round(w/2)”代替

x=a-w shr 1

y=b-h shr 1

// 注：div 为整除运算符

ptx=(w*PZoom) div 100

pty=(h*PZoom) div 100

// 以下计算在绘图区显示的图像大小和位置

变量

Pencent:double; // 缩放比

wx:double; // 宽缩放比

hx:double; // 高缩放比

// 获得缩放比

wx:=pw/ptx

hx:=ph/pty

if wx>hx then Pencent:=hx

else Pencent:=wx;

// 获得图片最后的大小

vw:=Round(Pencent*ptx);

vh:=Round(Pencent*pty);

// 计算出图片的位置

vx:=(pw-vw) div 2;

vy:=(ph-vh) div 2;

// ------------------------------------

好了，两个重要的任务完成(x,y),(w,h),(vx,vy),(vw,vh)已经全部计算得出，下面的工作就是显示了，我们选择 Windows API 进行操作

// 以下显示图像 -----------------------

变量

sDC 为原始图片的设备句柄(DC)

tDC 为临时设备句柄

dDC 最终设备句柄

BitBlt(tDC,0,0,w,h,sDC,0,0,SRCCOPY);

SetStretchBltMode(dDC,STRETCH_DELETESCANS);

StretchBlt(dDC,0,0,vw,vh,tDC,0,0,w,h,SRCCOPY);

最后绘制到显示的区域即可：

例如：BitBlt(GetDC(0),vx,vy,vx+vw,xy+vh,dDC,0,0,SRCCOPY);

// ------------------------------------

2.图像漫游

先定义三个全局变量：

FBeginDragPoint :TPoint; // 记录鼠标开始拖动的位置

FBeginDragSBPoint :TPoint; // 记录“中心点”位置

FBeginDrag :boolean; // 是否已经开始“拖动”

a,b :integer; // “中心点”位置

在鼠标左键点击时，记录鼠标的位置和“中心点”的位置，同时设置 FBeginDrag 为真

当鼠标右键弹起时，设置 FBeginDrag 为假

鼠标移动时，判断 FBeginDrag ，如果为假不进行处理，如果为真进行下面处理：

假设 X,Y 为鼠标当前的位置

a=FBeginDragPoint.X-((X-FBeginDragPoint.X)*100) div PZoom

b=FBeginDragPoint.Y-((Y-FBeginDragPoint.Y)*100) div PZoom

最后使用上面介绍的图像放大显示出图像

技巧篇：

1.如果图像较大，使用 delphi 的位图对象会出现内存溢出错误，这时可以进行如下设置：

bitImage:=TBitmap.Create;

bitImage.PixelFormat:=pf24bit;

bitImage.ReleaseHandle;

2.如果要让图像自动适应窗口的大小，参考以下代码：

var

p1,p2 :double;

begin

p1:=pw/sw;

p2:=ph/sw;

if p1>p2 then PZoom:=Round(p2*100)

else PZoom:=Round(p1*100);

if PZoom=0 then PZoom:=100;

end;

Delphi灰度图像像素颜色亮度处理

　　在图像处理中，速度是很重要的。因此，我们得重新处理一下TBitmap,得到TVczhBitmap。这只是因为GetPixels和SetPixels的速度太慢，换一个方法而已。

　　unit untBitmapProc;

　　interface

　　uses Graphics, SysUtils;

　　type

　　TVczhBitmap=class(TBitmap)

　　private

　　Data:PByteArray;

　　Line:Integer;

　　procedure SetFormat;

　　function GetBytePointer(X,Y:Integer):PByte;

　　procedure SetBytes(X,Y:Integer;Value:Byte);

　　function GetBytes(X,Y:Integer):Byte;

　　protected

　　published

　　constructor Create;

　　public

　　property Bytes[X,Y:Integer]:Byte read GetBytes write SetBytes;

　　procedure LoadFromFile(FileName:String);

　　procedure ToGray;

　　end;

　　implementation

　　procedure TVczhBitmap.SetFormat;

　　begin

　　HandleType:=bmDIB;

　　PixelFormat:=pf24bit;

　　end;

　　function TVczhBitmap.GetBytePointer(X,Y:Integer):PByte;

　　begin

　　if Line<>Y then

　　begin

　　Line:=Y;

　　Data:=ScanLine[Y];

　　end;

　　Longint(result):=Longint(Data)+X;

　　end;

　　procedure TVczhBitmap.SetBytes(X,Y:Integer;Value:Byte);

　　begin

　　GetBytePointer(X,Y)^:=Value;

　　end;

　　function TVczhBitmap.GetBytes(X,Y:Integer):Byte;

　　begin

　　result:=GetBytePointer(X,Y)^;

　　end;

　　constructor TVczhBitmap.Create;

　　begin

　　inherited Create;

　　SetFormat;

　　Line:=-1;

　　end;

　　procedure TVczhBitmap.LoadFromFile(FileName:String);

　　begin

　　inherited LoadFromFile(FileName);

　　SetFormat;

　　Line:=-1;

　　end;

　　procedure TVczhBitmap.ToGray;

　　var X,Y,R:Integer;

　　B:Byte;

　　begin

　　for Y:=0 to Height-1 do

　　for X:=0 to Width-1 do

　　begin

　　R:=0;

　　for B:=0 to 2 do

　　R:=R+GetBytes(X*3+B,Y);

　　for B:=0 to 2 do

　　SetBytes(X*3+B,Y,R div 3);

　　end;

　　end.

　　此后，我们需要建立几个窗体。第一个用来显示图片，第二个用来处理图片，其他的窗体都继承自第二个窗体，包含实际的处理方法。

　　先看第二个窗口：

　　unit untProc;

　　interface

　　uses

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

　　Dialogs, ExtCtrls, untBitmapProc, StdCtrls, ComCtrls;

　　type

　　TfrmProcessor = class(TForm)

　　pbBar: TPaintBox;

　　gpProc: TGroupBox;

　　Button1: TButton;

　　procedure FormCreate(Sender: TObject);

　　procedure FormDestroy(Sender: TObject);

　　procedure FormShow(Sender: TObject);

　　procedure pbBarPaint(Sender: TObject);

　　procedure Button1Click(Sender: TObject);

　　private

　　{ Private declarations }

　　public

　　{ Public declarations }

　　BarData:array[0..255]of Byte;

　　Bar:TVczhBitmap;

　　procedure DrawBar;

　　end;

　　var

　　frmProcessor: TfrmProcessor;

　　implementation

　　{$R *.dfm}

　　uses untViewer;

　　procedure TfrmProcessor.DrawBar;

　　var I:Integer;

　　begin

　　Bar.Canvas.FillRect(Bar.Canvas.ClipRect);

　　Bar.Canvas.MoveTo(0,255-BarData[0]);

　　for I:=1 to 255 do

　　Bar.Canvas.LineTo(I,255-BarData[I]);

　　end;

　　procedure TfrmProcessor.FormCreate(Sender: TObject);

　　begin

　　Bar:=TVczhBitmap.Create;

　　Bar.Width:=256;

　　Bar.Height:=256;

　　Bar.Canvas.Brush.Color:=clWhite;

　　Bar.Canvas.Brush.Style:=bsSolid;

　　end;

　　procedure TfrmProcessor.FormDestroy(Sender: TObject);

　　begin

　　Bar.Free;

　　end;

　　procedure TfrmProcessor.FormShow(Sender: TObject);

　　var I:Integer;

　　begin

　　for I:=0 to 255 do

　　BarData[I]:=I;

　　DrawBar;

　　end;

　　procedure TfrmProcessor.pbBarPaint(Sender: TObject);

　　begin

　　pbBar.Canvas.Draw(0,0,Bar);

　　end;

　　procedure TfrmProcessor.Button1Click(Sender: TObject);

　　var X,Y:Integer;

　　begin

　　for Y:=0 to Buffer.Height-1 do

　　for X:=0 to Buffer.Width*3-1 do

　　Played.Bytes[X,Y]:=BarData[Buffer.Bytes[X,Y]];

　　frmViewer.FormPaint(frmViewer);

　　end;

　　end.

　　之后，做一个窗口继承自它，则调整BarData[]后，按Apply即可看到结果。

　　现在开始将图像处理。具体效果见示例程序。

　　一、颜色反转。

　　灰度图像的颜色都是从0~255，所以，为了使颜色反转，我们可以用255减去该颜色值以得到反转后的颜色。

　　var I:Integer;

　　begin

　　inherited;

　　for I:=0 to 255 do

　　BarData[I]:=255-I;//用255减去该颜色值

　　DrawBar;

　　pbBarPaint(pbBar);

　　end;

　　二、缩小颜色范围以增强或减弱亮度

　　颜色本来是从0~255的。如果调节它的范围，例如从0~16，则会是图像明显变暗。我们可以把起始值设为a，把终止值设为b，则新的颜色值New=a+(b-1)*Old/255。这样做的话可以改变亮度，并且不会破坏原先颜色的顺序。代码如下

　　var I:Integer;

　　begin

　　for I:=0 to 255 do

　　BarData[I]:=(255-sbMin.Position)+Round((sbMin.Position-sbMax.Position)/255*I);

　　DrawBar;

　　pbBarPaint(pbBar);

　　Button1Click(Button1);

　　end;

　　这里的sbMin.Position和sbMaxPosition都是反转过的。所以使用时要用255去减

　　三、增加某个范围内的颜色范围

　　如果图像本身的颜色范围很小的画，你可以通过这种方法来加大图像的对比度，有利于对图像的分析。具体做法：

　　选取一个值a做为起始值，选取一个值b做为终止值，然后按以下公式变形：

　　|　0 (X<=a)

　　f(X)= |　255/(b-a)*(X-a)

　　|　255(X>=b)

　　var I:Integer;

　　begin

　　for I:=0 to 255 do

　　begin

　　if I<=sbMin.Position then

　　BarData[I]:=0

　　else if I>=sbMax.Position then

　　BarData[I]:=255

　　else

　　BarData[I]:=Round(255/(sbMax.Position-sbMin.Position)*(I-sbMin.Position));

　　end;

　　DrawBar;

　　pbBarPaint(pbBar);

　　Button1Click(Button1);

　　end;

　　四、变为黑白图片

　　在使用第三个功能的时候，你会发现当b<=a时，图像上的颜色除了黑色就是白色。这样操作的好处是不能直接显示出来的。这只要到了比较高级的图像处理如边缘检测等，才有作用。本例可以拿第三种方法的公式再变形，因此不作详细阐述。

　　五、指数级亮度调整

　　我们假设这个图的定义域是[0,1]，值域也是[0,1]。那么，定义函数f(x)=x^c，则f(x)的图像有一段如上图。我们再用鼠标操作时，可以在上面取一点P(a,b)，然后使f(x)通过点P，则c=ln(b)/ln(a)。有了c之后，我们就可以对颜色进行操作了：

　　New=(Old/255)^c*255=exp(ln(old/255)*c)*255

　　var ea,eb,ec:Extended;

　　I:Integer;

　　begin

　　ea:=A/255;

　　eb:=B/255;

　　ec:=Ln(eb)/Ln(ea);

　　for I:=1 to 255 do

　　BarData[I]:=Round(Exp(Ln((I/255))*ec)*255);

　　DrawBar;

　　pbBarPaint(pbBar);

　　Button1Click(Button1);

　　end;

　　这样做可以调节图像的亮度。

Delphi图形显示特效的技巧

　概述

　　----目前在许多学习软件、游戏光盘中，经常会看到各种

　　图形显示技巧，凭着图形的移动、交错、雨滴状、百页窗、积木堆叠等显现方式，使画面变得更为生动活泼，更能吸引观众。本文将探讨如何在delphi中实现各种图形显示技巧。

　　基本原理

　　----在delphi中，实现一副图象的显示是非常简单的，只要在form中定义一个timage组件，设置其picture属性，然后选择任何有效的.ico、.bmp、.emf或.wmf文件，进行load，所选文件就显示在timage组件中了。但这只是直接将图形显示在窗体中，毫无技巧可言。为了使图形显示具有别具一格的效果，可以按下列步骤实现：

　　----定义一个timage组件，把要显示的图形先装入到timage组件中，也就是说，把图形内容从磁盘载入内存中，做为图形缓存。

　　----创建一新的位图对象，其尺寸跟timage组件中的图形一样。

　　----利用画布(canvas)的copyrect功能(将一个画布的矩形区域拷贝到另一个画布的矩形区域)，使用技巧，动态形

　　成位图文件内容，然后在窗体中显示位图。

　　----实现方法

　　下面介绍各种图形显示技巧：

1.推拉效果

　　将要显示的图形由上、下、左、右方向拉进屏幕内显示，同时将屏幕上原来的旧图盖掉，此种效果可分为四

　　种，上拉、下拉、左拉、右拉，但原理都差不多，以上拉效果为例。

原理：首先将放在暂存图形的第一条水平线，搬移至要显示的位图的最后一条，接着再将暂存图形的前两条水平线，依序搬移至要显示位图的最后两条水平线，然后搬移前三条、前四条叄?直到全部图形数据搬完为止。在搬移的过程中即可看到显示的位图由下而上浮起，而达到上拉的效果。

程序算法：

procedure tform1.button1click(sender: tobject);

var

newbmp: tbitmap;

i,bmpheight,bmpwidth:integer;

begin

newbmp:= tbitmap.create;

newbmp.width:=image1.width;

newbmp.height:=image1.height;

bmpheight:=image1.height;

bmpwidth:=image1.width;

for i:=0 to bmpheight do

begin

newbmp.canvas.copyrect(rect

(0,bmpheight-i,bmpwidth,bmpheight),

image1.canvas,

rect(0,0,bmpwidth,i));

form1.canvas.draw(120,100,newbmp);

end;

newbmp.free;

end;

2.垂直交错效果

原理：将要显示的图形拆成两部分，奇数条扫描线由上往下搬移，偶数条扫描线的部分则由下往上搬移，而且两者同时进行。从屏幕上便可看到分别由上下两端出现的较淡图形向屏幕中央移动，直到完全清楚为止。

程序算法：

procedure tform1.button4click(sender: tobject);

var

newbmp:tbitmap;

i,j,bmpheight,bmpwidth:integer;

begin

newbmp:= tbitmap.create;

newbmp.width:=image1.width;

newbmp.height:=image1.height;

bmpheight:=image1.height;

bmpwidth:=image1.width;

i:=0;

while i< =bmpheight do

begin

j:=i;

while j >0 do

begin

newbmp.canvas.copyrect(rect(0,j-1,bmpwidth,j),

image1.canvas,

rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));

newbmp.canvas.copyrect(rect

(0,bmpheight-j,bmpwidth,bmpheight-j+1),

image1.canvas,

rect(0,i-j,bmpwidth,i-j+1));

j:=j-2;

end;

form1.canvas.draw(120,100,newbmp);

i:=i+2;

end;

newbmp.free;

end;

3.水平交错效果

原理：同垂直交错效果原理一样，只是将分成两组后的图形分别由左右两端移进屏幕。

程序算法：

procedure tform1.button5click(sender: tobject);

var

newbmp:tbitmap;

i,j,bmpheight,bmpwidth:integer;

begin

newbmp:= tbitmap.create;

newbmp.width:=image1.width;

newbmp.height:=image1.height;

bmpheight:=image1.height;

bmpwidth:=image1.width;

i:=0;

while i< =bmpwidth do

begin

j:=i;

while j >0 do

begin

newbmp.canvas.copyrect(rect(j-1,0,j,bmpheight),

image1.canvas,

rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));

newbmp.canvas.copyrect(rect

(bmpwidth-j,0,bmpwidth-j+1,bmpheight),

image1.canvas,

rect(i-j,0,i-j+1,bmpheight));

j:=j-2;

end;

form1.canvas.draw(120,100,newbmp);

i:=i+2;

end;

newbmp.free;

end;

4.雨滴效果

原理：将暂存图形的最后一条扫描线，依序搬移到可视位图的第一条到最后一条扫描线，让此条扫描线在屏幕上留下它的轨迹。接着再把暂存图形的倒数第二条扫描线，依序搬移到可视位图的第一条到倒数第二条扫描线。其余的扫描线依此类推。

程序算法：

procedure tform1.button3click(sender: tobject);

var

newbmp:tbitmap;

i,j,bmpheight,bmpwidth:integer;

begin

newbmp:= tbitmap.create;

newbmp.width:=image1.width;

newbmp.height:=image1.height;

bmpheight:=image1.height;

bmpwidth:=image1.width;

for i:=bmpheight downto 1 do

for j:=1 to i do

begin

newbmp.canvas.copyrect(rect(0,j-1,bmpwidth,j),

image1.canvas,

rect(0,i-1,bmpwidth,i));

form1.canvas.draw(120,100,newbmp);

end;

newbmp.free;

end;

5.百叶窗效果

原理：将放在暂存图形的数据分成若干组，然后依次从第一组到最后一组搬移，第一次每组各搬移第一条扫描线到可视位图的相应位置，第二次搬移第二条扫描线，接着搬移第三条、第四条扫描线.

程序算法：

procedure tform1.button6click(sender: tobject);

var

newbmp:tbitmap;

i,j,bmpheight,bmpwidth:integer;

xgroup,xcount:integer;

begin

newbmp:= tbitmap.create;

newbmp.width:=image1.width;

newbmp.height:=image1.height;

bmpheight:=image1.height;

bmpwidth:=image1.width;

xgroup:=16;

xcount:=bmpheight div xgroup;

for i:=0 to xcount do

for j:=0 to xgroup do

begin

newbmp.canvas.copyrect(rect

(0,xcount*j+i-1,bmpwidth,xcount*j+i),

image1.canvas,

rect(0,xcount*j+i-1,bmpwidth,xcount*j+i));

form1.canvas.draw(120,100,newbmp);

end;

newbmp.free;

end;

6.积木效果

原理：是雨滴效果的一种变化，不同之处在于，积木效果每次搬移的是一块图形，而不只是一根扫描线。

程序算法：

procedure tform1.button7click(sender: tobject);

var

newbmp:tbitmap;

i,j,bmpheight,bmpwidth:integer;

begin

newbmp:= tbitmap.create;

newbmp.width:=image1.width;

newbmp.height:=image1.height;

bmpheight:=image1.height;

bmpwidth:=image1.width;

i:=bmpheight;

while i>0 do

begin

for j:=10 to i do

begin

newbmp.canvas.copyrect(rect(0,j-10,bmpwidth,j),

image1.canvas,

rect(0,i-10,bmpwidth,i));

form1.canvas.draw(120,100,newbmp);

end;

i:=i-10;

end;

newbmp.free;

end;

结束语

上述图形显示效果均已上机通过。使用效果很好。

用Delphi实现图像放大镜

　　向窗体上添加两个TImage组件，其中一个TImage组件的Name属性设置为Image1，它充当原图片显示的载体。另一个TImage组件的Name属性设置为Image2，它可以显示放大后的图像。添加组件后的窗体如图1所示。

图1 添加组件后的窗体

　　本例的核心是StretchBlt函数，利用StretchBlt函数实现局部图像放大，响应代码如下：

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

　StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,

　Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY);

　Image2.Refresh;

　Screen.Cursors[1]:=LoadCursorFromFile(’MAGNIFY.CUR’);

　Self.Cursor:=1;

end;

　　程序首先会调用StretchBlt函数，以鼠标当前位置作为中心点，以边长为40选中Image1组件上的局部图像，并放大此局部图像到Image2组件上。然后通过调用Image2组件的Refresh方法以刷新Image2组件的显示。最后设置鼠标指针为新的形状。

　　程序代码如下：

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls;

type

　TForm1 = class(TForm)

　Image1: TImage;

　Image2: TImage;

　procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

　procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

private

　{ Private declarations }

public

　{ Public declarations }

end;

var

　Form1: TForm1;

　implementation

　{$R *.dfm}

　procedure TForm1.Image1MouseMove(Sender:TObject;Shift:TShiftState;X,Y: Integer);

　begin

　　StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY);

　　Image2.Refresh;

　　Screen.Cursors[1]:=LoadCursorFromFile(’MAGNIFY.CUR’);

　　Self.Cursor:=1;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

begin

　Screen.Cursors[1]:=crDefault;

　Self.Cursor:=1;

end;

end.

　　保存文件，然后按F9键运行程序，程序运行结果如图2所示。

图2 程序运行结果

　　放大图像是一个优秀的看图软件必备的功能，本实例提供了一种非常简便易行的方法，不但代码数量少，而且执行效率高。

上一篇 »Matlab与ModelSim图像处理验证
下一篇 »Matlab图像处理常用基本函数

Delphi基本图像处理代码

相关推荐

delphi 图像处理 图像放大缩小

数字图像处理实验一，MatLab编译环境

Delphi基本图像处理方法汇总

matlab处理图像代码

32位图像处理库 delphi简单实现

Matlab摄像头视频基本处理 - Lewiski

图像处理，人脸识别项目

matlab图像处理学习笔记1 - ellisonDon

delphi 图像处理图像放大缩小