Delphi根本圖像處置辦法匯總。本站提示廣大學習愛好者：（Delphi根本圖像處置辦法匯總）文章只能為提供參考，不一定能成為您想要的結果。以下是Delphi根本圖像處置辦法匯總正文
本文實例匯總了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，它可以顯示縮小後的圖像。
本例的中心是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鍵運轉順序，順序運轉。
縮小圖像是一個優秀的看圖軟件必備的功用，本實例提供了一種十分簡便易行的辦法，不但代碼數量少，而且執行效率高。
希望本文所述對大家的Delphi順序設計有所協助。
