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;
end;
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;
end;
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;
end;
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;
end;
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;
end;
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;
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;
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;
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
0:
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;
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;
end;
end;
end;
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;
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;
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;
end;
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;
end;
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;
end;
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;
end;
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;
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;
end;
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;
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 程序运行结果
放大图像是一个优秀的看图软件必备的功能,本实例提供了一种非常简便易行的方法,不但代码数量少,而且执行效率高。
- 浏览: 145553 次
- 性别:
- 来自: 洛阳
最新评论
-
zenmshuo:
很详细,要是包含FlexChart的用法就更好了
Delphi中Chart组件,Chart控件用法 -
Draps:
输入 00123 判定为数字输入 100.123判定为非数字 ...
Delphi 判断一个字符串是否为数字 -
ylilike:
GDGZWQZ 写道下列办法可实现对话框自动定时关闭:在程序中 ...
delphi中SendMessage使用说明 -
GDGZWQZ:
下列办法可实现对话框自动定时关闭:在程序中插入一个定时器,设置 ...
delphi中SendMessage使用说明 -
think3t:
写的很详细~
delphi中SendMessage使用说明
发表评论
-
删除cookies及上网历史记录(DELPHI代码完整版本)
2012-12-29 14:39 3332//前面要加几个pas单元 uses Registry, ... -
Delphi DateTime,Date,Time TDateTimePicker
2012-12-22 17:38 4850一、DateTime,Date,Time存 ... -
关于delphiwebbrowser二次点击来路问题
2012-12-08 15:56 2959webbrowser二次点击webb可以实现二次点击但是二次点 ... -
delphi返回一个汉字的Unicode编码
2012-11-30 16:00 1734//机内码 -> 汉字Function MacCode2 ... -
Delphi 从外部拖拽文件
2012-10-22 19:36 5245unit Unit1; interface u ... -
Delphi汉字简繁体转换代码
2012-07-02 15:53 2119unit ChineseCharactersConvert;i ... -
对当前焦点发送文字
2012-07-02 07:46 1346var clp: TClipboard;begin clp ... -
Delphi中destroy, free, freeAndNil, release用法和区别
2012-06-23 07:14 1494经过这段时间对delphi中free 和 release 的仔 ... -
解决delphi indy10下 utf8码转换的问题
2012-06-15 09:59 9276用delphi2010调试一个以前的程序,因为以前的程序是 ... -
Delphi EmbeddedWB组件遍历Frames并执行子frame的js
2012-06-14 18:13 2678var wDoc:IHTMLDocument2; ... -
(POS打印机LPT1口)卡密打印工具<by Only↗Me>介绍
2012-06-13 17:08 2319前两年写“(POS打印机LPT1口)卡密打印工具”,现在还有人 ... -
Delphi 判断一个字符串是否为数字
2012-06-13 16:32 7194//函 数 名: IsDigit //返 回 值: bool ... -
解决EmbeddedWB弹出页面错误框的问题
2012-06-07 13:34 1637使用EmbeddedWB控件的时候,发现有一些错误完全无法用t ... -
Delphi中WebBrowser控件打开部分网站报"Invalid floating point operation”解决
2012-06-07 13:29 2931最近用EmbeddedWB控件做浏览器相关应用的时候,发现有些 ... -
Delphi中Memo显示行号列号
2012-06-04 10:43 8733实例说明 本例是个光标应用的简单技巧,希望通过这个例子 ... -
Delphi中Chart组件,Chart控件用法
2012-05-18 11:06 29372本文主要讲解Delphi 中Chart ,TeeChart ... -
delphi中URL的汉字编码
2012-05-07 08:20 2043show.asp?sort=全部&sortlevel= ... -
邮件(短信)天气预报MailWeather
2012-01-01 20:03 3619记不得啥时间了,移动推出了免费邮件短信提醒服务,使用我们这些穷 ... -
delphi中SendMessage使用说明
2011-11-28 16:49 31754SendMessage基础知识 函数 ...
相关推荐
内容包括图像的基本概念、图像的点运算、图像的几何变换、图像的颜色系统、图像的增强、图像代数与分隔、图像的特效、图像处理综合实例,前面7章比较详细地介绍了图像处理的内容,同时提供了非常详细的程序代码,第8...
Delphi中的基本图象处理代码
内容包括图像的基本概念、图像的点运算、图像的几何变换、图像的颜色系统、图像的增强、图像代数与分隔、图像的特效、图像处理综合实例,前面7章比较详细地介绍了图像处理的内容,同时提供了非常详细的程序代码,第8...
。。。
。。。
《Delphi7编程100例》代码目录:---------------------------------------------ToolBar工具栏控件的使用动态建立主菜单选项窗口界面的动态分隔条动态设置选项卡页面在标题栏中自定义按钮窗体开合窗帘效果Windows XP...
资料目录.bat 源代码 第一章Delphi基础知识 第七章异常处理和程序调试技术 第三章Delphi面向对象编程思想 第九章对话框 第二章Delphi语法基础 第五章VCL组件应用 第八章VCL组件应用续2 ...第四章Delphi基本组件编程1
第6章 Delphi与Object Pascal程序的基本概念 6-1 Object Pascal Program程序结构与Delphi项目结构的关系 6-1-1 标头(Heading) 6-1-2 Uses子句 6-1-3 编译指令(Compiler directive) 6-1-4 源代码区(begin end) ...
XsImageEffectversion: 1.00.321Author: HarryUse in D4,D5,D6,D7,D2005----------简要介绍:提供强大的图像处理功能,完全源代码公开,包括旋转,放大,缩小,自动校正,选择范围,裁剪,自动去除黑边,镜像等等...
使读者能够掌握图形图像处理、多媒体、数据库、网络通信、报表打印、硬件开发等各领域的相关技术,为从事项目开发的人员提供相关解决方案。本书附有配套光盘。光盘提供了书中所有案例的全部源代码,所有源代码都经过...
8.1 TImage:Delphi的图像显示 167 8.2 存储图像 168 8.3 使用TCanvas的属性 169 8.3.1 画笔 170 8.3.2 使用TCanvas.Pixels属性 175 8.3.3 使用刷子 175 8.3.4 使用字体 180 8.3.5 使用CopyMode属性 181 8.3.6 其他...
ToolBar工具栏控件的使用 动态建立主菜单选项 窗口界面的动态分隔...图像的淡入淡出显示 多媒体播放器 播放AVI文件 根据客户端IP地址获取计算机名 实现多线程IP和DomainName相互转换 Windows2000...
2.1.4 多IP情况的处理 2.1.5 关于IP地址和实际的地址的区别 2.2 获取子网掩码 2.2.1 Windows NT系统中获取子网掩码 2.2.2 Window 9x系统中获取子网掩码 2.3 获取计算机名 2.3.1 获取和设置本机主机名 2.3.2 ...
内容索引:Delphi源码,图形处理,图像编辑插件,图形处理 这是一个DELPHI处理图形时候要用的一个插件,有了它你可以快速在多个图像目录下选择你需要的图像,还可以对图片进行简单处理。也可将一些常用的图像收藏到收藏...
全部实例代码。目录如下: ToolBar工具栏控件的使用 动态建立主菜单选项 窗口界面的动态分隔条 动态设置选项卡页面 在标题栏中自定义按钮 窗体开合窗帘效果 Windows XP界面效果 实现OutLook滚动工具栏效果 在下拉...
该书精选了100多个经典的实例从易到难、由浅入深、由简单到综合地进行讲解,内容涉及面也很广泛,基本上涵盖了用Delphi进行应用程序设计的方方面面,凝聚了作者多年的Delphi编程经验,相信对启发读者的思想并提高...
使读者能够掌握图形图像处理、多媒体、数据库、网络通信、报表打印、硬件开发等各领域的相关技术,为从事项目开发的人员提供相关解决方案。本书附有配套光盘。光盘提供了书中所有案例的全部源代码,所有源代码都经过...
使读者能够掌握图形图像处理、多媒体、数据库、网络通信、报表打印、硬件开发等各领域的相关技术,为从事项目开发的人员提供相关解决方案。本书附有配套光盘。光盘提供了书中所有案例的全部源代码,所有源代码都经过...