怎样截取图像，和实现图像的翻转(100分)

请教了
如何对TIMAGE中的图象实现任意大小的截取，及任意角度的翻转，有没有此类的空件，
如果哪位手头有这样的控件，恳请给我发一份，不胜感激
EMAIL：WZS4743@SINA.COM

www.vclxx.org

FastLib控件

要不自己写一个

这是我写的一个东东，实现图片的旋转，你可以看看。[]

Delphi中的Image构件可以显示位图，进一步，我们还可以用它完成位图旋转。

把一个点绕原点旋转α角度后，新的坐标位置与原坐标位置的关系是：
X=x*cosα－y*sinα
Y=x*sinα＋y*cosα

例如要把位图顺时针旋转90度，坐标变换公式为：X=－y; Y=x

把这一公式用到Image构件上，显示位图的主要问题是Image构件显示的位图只有一个象限，并且x、y坐标也是互相颠倒的，为了解决这个问题，必须在Image构件上建立一个新的坐标原点。

下面举例说明:

1. 新建一工程project1,在form1上添加image1、image2、image3、image4，其Autosize属性设为True，image1用来显示原图，image2、image3、image4分别用来显示旋转90度、180度和270度后的图像。双击image1，选定一幅bmp图。

2. 添加Button1、Button2、Button3和Button4按钮，其caption属性分别为“原图”、“旋转90度”、“旋转180度”、“旋转270度”。

3. 编写“旋转90度”按钮的OnClick事件。
procedure TForm1.Button2Click(Sender: TObject);
var
i,j: integer;
begin
//确定旋转后位图的大小
image2.Picture.Bitmap.Height:=image1.picture.width;
image2.Picture.Bitmap.Width:=image1.picture.height;
for i:=0 to image1.Height do
for j:=0 to image1.Width do
image2.canvas.Pixels[(－i+image1.Height),j]:=image1.canvas.Pixels[j,i];
end;

4. 编写“旋转180度”按钮的On Click事件。
procedure TForm1.Button3Click(Sender: TObject);
var
i,j: integer;
begin
//确定旋转后位图的大小
image3.Picture.Bitmap.Height:=image1.picture.Height;
image3.Picture.Bitmap.Width:=image1.picture.Width;
for i:=0 to image1.Height do
for j:=0 to image1.Width do
image3.canvas.Pixels[(image1.Width－j),(image1.Height－i)]:=image1.canvas.Pixels[j,i];
end;

5. 编写“旋转270度”按钮的On Click事件。代码和步骤3相似，只需要用image4替换image2，然后用以下的语句替换步骤3中for循环内的原有的语句。
image4.canvas.Pixels[i,(image1.Width－j)]:=image1.canvas.Pixels[j,i];

进一步的，我们可以动态设定旋转角度α，使图形做任意角度的旋转。类似的，根据不同的坐标计算公式，还可以实现图形的翻转等功能。

看下面单元的三个函数：
RotateBitmap
FlipBitmap
MirrorBitmap


unit hhx_RotResize;

interface
uses Classes,Graphics,hhx_basedef;

type TFilterProc = function(Value: Single): Single;

TResampleCallBack = procedure (const Min,Max,Pos:Integer);

TSizeMode= (smUseZoomValue,smOriginal,smFitBoth,smFitWidth,smFitHeight);

PROCEDURE StretchResize(SrcBitmap,DestBitmap:TBitmap;dWidth,dHeight:LongInt;WithBorder:Boolean;BorderColor:TColor;Thumb:Boolean);
PROCEDURE FitResize(SrcBitmap,DestBitmap:TBitmap;dWidth,dHeight:LongInt;WithBorder:Boolean;BorderColor:TColor;Mode:Integer);
PROCEDURE RotateBitmap(SrcBitmap,DestBitmap:TBitmap;Degrees,CenterX,CenterY:Integer;EnlargeCanvas:Boolean;BackGrndColor:TColor;
ResampleCallback:TResampleCallBack);

PROCEDURE FlipBitmap(SrcBitmap,DestBitmap:TBitmap;ResampleCallback:TResampleCallBack);
PROCEDURE MirrorBitmap(SrcBitmap,DestBitmap:TBitmap;ResampleCallback:TResampleCallBack);

procedure Resample(SrcBitmap, DstBitmap: TBitmap;NewWidth,NewHeight:LongInt;Filter: TFilterProc; fwidth: single;
ResampleCallback:TResampleCallBack);

// Sample filters for use with Resample()
function SplineFilter(Value: Single): Single;
function BellFilter(Value: Single): Single;
function TriangleFilter(Value: Single): Single;
function BoxFilter(Value: Single): Single;
function HermiteFilter(Value: Single): Single;
function Lanczos3Filter(Value: Single): Single;
function MitchellFilter(Value: Single): Single;

implementation

// -----------------------------------------------------------------------------
//
// Stretchresize Bitmap
//
// -----------------------------------------------------------------------------

PROCEDURE StretchResize(SrcBitmap,DestBitmap:TBitmap;dWidth,dHeight:LongInt;WithBorder:Boolean;BorderColor:TColor;Thumb:Boolean);
var aWidth,aHeight,dx,dy,mWidth,mHeight:LongInt;
x:Extended;
begin

aWidth:=SrcBitmap.Width;
aHeight:=SrcBitmap.Height;
mWidth:=dWidth;
mHeight:=dHeight;
if (aWidth>=mWidth) or (aHeight>=mHeight) then
begin
if aWidth> aHeight then
begin
x:=aWidth/mWidth;
aWidth:=mWidth;
if x <> 0 then aHeight:=round(aHeight*(1/x));
if aHeight=0 then aHeight:=1;
end
else begin
x:=aHeight/mHeight;
aHeight:=mHeight;
if x <> 0 then aWidth:=round(aWidth*(1/x));
if aWidth=0 then aWidth:=1;
end;
if Assigned(DestBitmap) then with DestBitmap do
begin
PixelFormat:=SrcBitmap.PixelFormat;
dx:=0;
dy:=0;
if WithBorder then
begin
dx:=Round((mWidth-aWidth)/2);
dy:=Round((mHeight-aHeight)/2);
end;
Width:=mWidth;
Height:=mHeight;
Canvas.Brush.Color:=BorderColor;
Canvas.FillRect(Rect(0,0,mWidth,mHeight));
Canvas.Brush.Color:=clNone;
Canvas.CopyMode:=cmSrcCopy;
Canvas.StretchDraw(Rect(dx,dy,dx+aWidth,dy+aHeight),SrcBitmap)
end;
end
else
if (aWidth<mWidth) and (aHeight<mHeight) then
begin
// if picture should be shown as thumb, then use the original imagedimensions
if Thumb then
begin
if Assigned(DestBitmap) then with DestBitmap do
begin
Width:=mWidth;
Height:=mHeight;
Canvas.Brush.Color:=BorderColor;
Canvas.FillRect(Rect(0,0,mWidth,mHeight));
Canvas.Brush.Color:=clNone;
Canvas.CopyMode:=cmSrcCopy;
Canvas.Draw((mwidth-aWidth )div 2,(mHeight-aHeight )div 2,SrcBitmap);
end;
end else
// otherwise, make result larger than original
begin
if aWidth> aHeight then
begin
x:=mWidth/aWidth;
aWidth:=mWidth;
if x <> 0 then aHeight:=round(aHeight*x);
end
else begin
x:=mHeight/aHeight;
aHeight:=mHeight;
if x <> 0 then aWidth:=round(aWidth*x);
end;

if Assigned(DestBitmap) then with DestBitmap do
begin
dx:=0;
dy:=0;
if WithBorder then
begin
dx:=Round((mWidth-aWidth)/2);
dy:=Round((mHeight-aHeight)/2);
end;

Width:=mWidth;
Height:=mHeight;
Canvas.Brush.Color:=BorderColor;
Canvas.FillRect(Rect(0,0,mWidth,mHeight));
Canvas.Brush.Color:=clNone;
Canvas.CopyMode:=cmSrcCopy;
Canvas.StretchDraw(Rect(dx,dy,dx+aWidth,dy+aHeight),SrcBitmap)
end;
end;
end;
end;

// -----------------------------------------------------------------------------
//
// Stretchresize Bitmap
//
// -----------------------------------------------------------------------------

PROCEDURE FitResize(SrcBitmap,DestBitmap:TBitmap;dWidth,dHeight:LongInt;WithBorder:Boolean;BorderColor:TColor;Mode:Integer);
var aWidth,aHeight,dx,dy,mWidth,mHeight:LongInt;
x:Extended;
begin

if Mode=0 then
begin
// change nothing
DestBitmap.Assign(SrcBitmap);
Exit;
end;

aWidth:=SrcBitmap.Width;
aHeight:=SrcBitmap.Height;
mWidth:=dWidth;
mHeight:=dHeight;

// if (aWidth>=mWidth) or (aHeight>=mHeight) then
begin
x:=1;

case Mode of
1:begin
// fit both
if aWidth> aHeight then
begin
if aWidth>mWidth then
begin
x:=aWidth/mWidth;
aWidth:=mWidth;
if x <> 0 then aHeight:=round(aHeight*(1/x));
mHeight:=aHeight;
end else
begin
x:=mWidth/aWidth;
if x <> 0 then aHeight:=round(aHeight*(x));
mHeight:=aHeight;
end;
end
else
begin
if aHeight>mHeight then
begin
x:=aHeight/mHeight;
aHeight:=mHeight;
if x <> 0 then aWidth:=round(aWidth*(1/x));
mWidth:=aWidth;
end else
begin
x:=mHeight/aHeight;
if x <> 0 then aWidth:=round(aWidth*(x));
mWidth:=aWidth;
end;
end;
end;
2:begin
//fit width
if aWidth>mWidth then
begin
x:=aWidth/mWidth;
aWidth:=mWidth;
if x <> 0 then aHeight:=round(aHeight*(1/x));
mHeight:=aHeight;
end else
begin
mHeight:=aHeight;
mWidth:=aWidth;

// x:=mWidth/aWidth;
// if x <> 0 then aHeight:=round(aHeight*(x));
end;
end;
3:begin
//fit height
if aHeight>mHeight then
begin
x:=aHeight/mHeight;
aHeight:=mHeight;
if x <> 0 then aWidth:=round(aWidth*(1/x));
mWidth:=aWidth;
end else
begin
mHeight:=aHeight;
mWidth:=aWidth;
end;
end;
end;

if Assigned(DestBitmap) then with DestBitmap do
begin
PixelFormat:=SrcBitmap.PixelFormat;
dx:=0;
dy:=0;
if WithBorder then
begin
dx:=Round((mWidth-aWidth)/2);
if dx<0 then dx:=0;
dy:=Round((mHeight-aHeight)/2);
if dy<0 then dy:=0;
end;
Width:=mWidth;
Height:=mHeight;
Canvas.Brush.Color:=BorderColor;
Canvas.FillRect(Rect(0,0,mWidth,mHeight));
Canvas.Brush.Color:=clNone;
Canvas.CopyMode:=cmSrcCopy;
Canvas.StretchDraw(Rect(dx,dy,dx+aWidth,dy+aHeight),SrcBitmap)
end;
end
end;

// -----------------------------------------------------------------------------
//
// Rotate Bitmap
//
// -----------------------------------------------------------------------------

PROCEDURE RotateBitmap(SrcBitmap,DestBitmap:TBitmap;Degrees,CenterX,CenterY:Integer;EnlargeCanvas:Boolean;BackGrndColor:TColor;
ResampleCallback:TResampleCallBack);
VAR
cosTheta,sinTheta,Theta : DOUBLE;
Delta : INTEGER;
ecX1,ecY1: Integer;
ecX2,ecY2: Integer;
ecX3,ecY3: Integer;
ecX4,ecY4: Integer;
xDiff,yDiff: Integer;
minX,maxX:Integer;
minY,maxY:Integer;
i,j : INTEGER;
iSrc,jSrc : INTEGER;
iSrcPrime,iDestPrime : INTEGER;
jSrcPrime,jDestPrime : INTEGER;
SrcRow,DestRow : pRGBArray;
function GetRotatedY(OrgX,OrgY:Integer;SinTheta,CosThetaouble):Integer;
begin
Result:=(ROUND((2*(OrgX) + 1) * sinTheta + (2*(OrgY) + 1) * cosTheta) - 1) div 2;
end;
function GetRotatedX(OrgX,OrgY:Integer;SinTheta,CosThetaouble):Integer;
begin
Result:=(ROUND((2*(OrgX) + 1) * CosTheta - (2*(OrgY) + 1) * sinTheta) - 1) div 2;
end;

begin
SrcBitmap.PixelFormat := pf24bit;
DestBitmap.PixelFormat := pf24bit;
Theta := -Degrees * PI / 180;
sinTheta := SIN(Theta);
cosTheta := COS(Theta);
if EnlargeCanvas then
begin
ecX1 := GetRotatedX(0,0,SinTheta,CosTheta);
ecY1 := GetRotatedY(0,0,SinTheta,CosTheta);
ecX2 := GetRotatedX(SrcBitmap.Width,0,SinTheta,CosTheta);
ecY2 := GetRotatedY(SrcBitmap.Width,0,SinTheta,CosTheta);
ecX3 := GetRotatedX(SrcBitmap.Width,SrcBitmap.Height,SinTheta,CosTheta);
ecY3 := GetRotatedY(SrcBitmap.Width,SrcBitmap.Height,SinTheta,CosTheta);
ecX4 := GetRotatedX(0,SrcBitmap.Height,SinTheta,CosTheta);
ecY4 := GetRotatedY(0,SrcBitmap.Height,SinTheta,CosTheta);
if ecX1>=ecX2 then begin maxX:=ecX1;minX:=ecX2;end else begin maxX:=ecX2;minX:=ecX1; end;
if ecY1>=ecY2 then begin maxY:=ecY1;minY:=ecY2;end else begin maxY:=ecY2;minY:=ecY1; end;
if ecX3>=maxX then maxX:=ecX3 else if ecX3<=minX then minX:=ecX3;
if ecY3>=maxY then maxY:=ecY3 else if ecY3<=minY then minY:=ecY3;
if ecX4>=maxX then maxX:=ecX4 else if ecX4<=minX then minX:=ecX4;
if ecY4>=maxY then maxY:=ecY4 else if ecY4<=minY then minY:=ecY4;
DestBitmap.Width:=Abs(MaxX-MinX);
DestBitmap.Height:=Abs(MaxY-MinY);
XDiff :=(DestBitmap.Width-SrcBitmap.Width) div 2;
YDiff :=(DestBitmap.height-SrcBitmap.Height) div 2;

end else
begin
DestBitmap.Width := SrcBitmap.Width;
DestBitmap.Height := SrcBitmap.Height;
yDiff:=0;
xDiff:=0;
end;
FOR j := DestBitmap.Height-1 DOWNTO 0 DO
BEGIN
DestRow := DestBitmap.Scanline[j];
jSrcPrime := 2*(j - (YDiff+CenterY)) + 1;

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round(((DestBitmap.Height-j)/DestBitmap.Height)*100));

FOR i := DestBitmap.Width-1 DOWNTO 0 DO
BEGIN
iSrcPrime := 2*(i - (XDiff+CenterX)) + 1;
iDestPrime := ROUND(iSrcPrime * CosTheta - jSrcPrime * sinTheta);
jDestPrime := ROUND(iSrcPrime * sinTheta + jSrcPrime * cosTheta);
iSrc := (iDestPrime - 1) div 2 + CenterX;
jSrc := (jDestPrime - 1) div 2 + CenterY;

IF (iSrc >= 0) AND (iSrc <= SrcBitmap.Width-1) AND
(jSrc >= 0) AND (jSrc <= SrcBitmap.Height-1)
THEN BEGIN
SrcRow := SrcBitmap.Scanline[jSrc];
DestRow := SrcRow[iSrc]
END
ELSE WITH DestRow DO BEGIN
rgbtBlue := (BackgrndColor and $00ff0000) shr 16;
rgbtGreen := (BackgrndColor and $0000ff00) shr 8;
rgbtRed := (BackgrndColor and $000000ff);
END
END
END;
END;

// -----------------------------------------------------------------------------
//
// Flip Bitmap
//
// -----------------------------------------------------------------------------

PROCEDURE FlipBitmap(SrcBitmap,DestBitmap:TBitmap;ResampleCallback:TResampleCallBack);
var i,j :Integer;
SrcRow,DestRow RGBArray;
begin
SetBitmapsEql(SrcBitmap,DestBitmap);
for i:=DestBitmap.Height-1 downto 0 do
begin
SrcRow:=SrcBitmap.ScanLine[DestBitmap.Height-i-1];
DestRow:=DestBitmap.ScanLine;

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round((i/SrcBitmap.Height)*100));

for j:=0 to DestBitmap.Width-1 do begin
DestRow[j].rgbtBlue:=SrcRow[j].rgbtBlue;
DestRow[j].rgbtGreen:=SrcRow[j].rgbtGreen;
DestRow[j].rgbtRed:=SrcRow[j].rgbtRed;
end;
end;
end;

// -----------------------------------------------------------------------------
//
// Mirror Bitmap
//
// -----------------------------------------------------------------------------

PROCEDURE MirrorBitmap(SrcBitmap,DestBitmap:TBitmap;ResampleCallback:TResampleCallBack);
var i,j :Integer;
SrcRow,DestRow RGBArray;
begin
SetBitmapsEql(SrcBitmap,DestBitmap);
for i:=DestBitmap.Height-1 downto 0 do
begin
SrcRow:=SrcBitmap.ScanLine;
DestRow:=DestBitmap.ScanLine;

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round((i/SrcBitmap.Height)*100));

for j:=0 to DestBitmap.Width-1 do begin
DestRow[j].rgbtBlue:=SrcRow[SrcBitmap.Width-j-1].rgbtBlue;
DestRow[j].rgbtGreen:=SrcRow[SrcBitmap.Width-j-1].rgbtGreen;
DestRow[j].rgbtRed:=SrcRow[SrcBitmap.Width-j-1].rgbtRed;
end;
end;
end;

{
RESAMPLE PART
}
// -----------------------------------------------------------------------------
//
// Filter functions
// -----------------------------------------------------------------------------

// Hermite filter
function HermiteFilter(Value: Single): Single;
begin
// f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1
if (Value < 0.0) then
Value := -Value;
if (Value < 1.0) then
Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0
else
Result := 0.0;
end;

// Box filter
// a.k.a. "Nearest Neighbour" filter
// anme: I have not been able to get acceptable
// results with this filter for subsampling.
function BoxFilter(Value: Single): Single;
begin
if (Value > -0.5) and (Value <= 0.5) then
Result := 1.0
else
Result := 0.0;
end;

// Triangle filter
function TriangleFilter(Value: Single): Single;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 1.0) then
Result := 1.0 - Value
else
Result := 0.0;
end;

// Bell filter
function BellFilter(Value: Single): Single;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 0.5) then
Result := 0.75 - Sqr(Value)
else if (Value < 1.5) then
begin
Value := Value - 1.5;
Result := 0.5 * Sqr(Value);
end else
Result := 0.0;
end;

// B-spline filter
function SplineFilter(Value: Single): Single;
var
tt : single;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 1.0) then
begin
tt := Sqr(Value);
Result := 0.5*tt*Value - tt + 2.0 / 3.0;
end else if (Value < 2.0) then
begin
Value := 2.0 - Value;
Result := 1.0/6.0 * Sqr(Value) * Value;
end else
Result := 0.0;
end;

// Lanczos3 filter
function Lanczos3Filter(Value: Single): Single;
function SinC(Value: Single): Single;
begin
if (Value <> 0.0) then
begin
Value := Value * Pi;
Result := sin(Value) / Value
end else
Result := 1.0;
end;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 3.0) then
Result := SinC(Value) * SinC(Value / 3.0)
else
Result := 0.0;
end;

function MitchellFilter(Value: Single): Single;
const
B = (1.0 / 3.0);
C = (1.0 / 3.0);
var
tt : single;
begin
if (Value < 0.0) then
Value := -Value;
tt := Sqr(Value);
if (Value < 1.0) then
begin
Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt))
+ ((-18.0 + 12.0 * B + 6.0 * C) * tt)
+ (6.0 - 2 * B));
Result := Value / 6.0;
end else
if (Value < 2.0) then
begin
Value := (((-1.0 * B - 6.0 * C) * (Value * tt))
+ ((6.0 * B + 30.0 * C) * tt)
+ ((-12.0 * B - 48.0 * C) * Value)
+ (8.0 * B + 24 * C));
Result := Value / 6.0;
end else
Result := 0.0;
end;


procedure Resample(SrcBitmap, DstBitmap: TBitmap;NewWidth,NewHeight:LongInt;Filter: TFilterProc; fwidth: single;
ResampleCallback:TResampleCallBack);
// -----------------------------------------------------------------------------
//
// Interpolator
// -----------------------------------------------------------------------------
type
// Contributor for a pixel
TContributor = record
pixel: integer; // Source pixel
weight: single; // Pixel weight
end;

TContributorList = array[0..0] of TContributor;
PContributorList = ^TContributorList;

// List of source pixels contributing to a destination pixel
TCList = record
n : integer;
p : PContributorList;
end;

TCListList = array[0..0] of TCList;
PCListList = ^TCListList;

TRGB = packed record
r, g, b : single;
end;
// Physical bitmap scanline (row)
TRGBList = packed array[0..0] of TColorRGB;
PRGBList = ^TRGBList;
var
xscale, yscale : single; // Zoom scale factors
i, j, k : integer; // Loop variables
center : single; // Filter calculation variables
width, fscale, weight : single; // Filter calculation variables
left, right : integer; // Filter calculation variables
n : integer; // Pixel number
Work : TBitmap; // Temporary Bitmap
contrib : PCListList; // Contributor pointer
rgb : TRGB; // RGBTriple
color : TColorRGB; // COlorRGBTriple
SourceLine ,
DestLine : PRGBList;
SourcePixel ,
DestPixel : PColorRGB;
Delta ,
DestDelta : integer;
SrcWidth ,
SrcHeight ,
DstWidth ,
DstHeight : integer;
sMode : Boolean;
begin
DstWidth := NewWidth;
DstHeight := NewHeight;
DstBitmap.Width:=NewWidth;
DstBitmap.Height:=NewHeight;
SrcWidth := SrcBitmap.Width;
SrcHeight := SrcBitmap.Height;
if (SrcWidth < 1) or (SrcHeight < 1) then exit;

Work := TBitmap.Create;
try
Work.Height := SrcHeight;
Work.Width := DstWidth;
if (SrcWidth = 1) then
xscale:= DstWidth / SrcWidth
else
xscale:= (DstWidth - 1) / (SrcWidth - 1);
if (SrcHeight = 1) then
yscale:= DstHeight / SrcHeight
else
yscale:= (DstHeight - 1) / (SrcHeight - 1);

SrcBitmap.PixelFormat := pf24bit;
DstBitmap.PixelFormat := SrcBitmap.PixelFormat;
Work.PixelFormat := SrcBitmap.PixelFormat;

//-----------------------------------------------------------
//
// HORIZONTAL PART
//
//
//-----------------------------------------------------------

// --------------------------------------------
// Pre-calculate filter contributions for a row
// -----------------------------------------------
GetMem(contrib, DstWidth* sizeof(TCList));
// Horizontal sub-/supersampling

// set different modes depending on scaling factor
sMode:=xscale < 1.0;
if sMode then width := fwidth / xscale else width:=fWidth;
if sMode then fscale := 1.0 / xscale else fScale:=1;

for i := 0 to DstWidth-1 do
begin

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round((i/DstWidth)*100));

contrib^.n := 0;
GetMem(contrib^.p, trunc(width * 2.0 + 1) * sizeof(TContributor));
center := i / xscale;
left := xFloor(center - width);
right := xCeil(center + width);
for j := left to right do
begin
weight := filter((center - j) / fscale) / fscale;
if (weight = 0.0) then
continue;
if (j < 0) then
n := -j
else if (j >= SrcWidth) then
n := SrcWidth - j + SrcWidth - 1
else
n := j;
k := contrib^.n;
contrib^.n := contrib^.n + 1;
contrib^.p^[k].pixel := n;
contrib^.p^[k].weight := weight;
end;
end;
// ----------------------------------------------------
// Apply filter to sample horizontally from Src to Work
// ----------------------------------------------------
for k := 0 to SrcHeight-1 do
begin

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round((k/SrcHeight)*100));

SourceLine := SrcBitmap.ScanLine[k];
DestPixel := Work.ScanLine[k];
for i := 0 to DstWidth-1 do
begin
rgb.r := 0.0;
rgb.g := 0.0;
rgb.b := 0.0;
for j := 0 to contrib^.n-1 do
begin
color := SourceLine^[contrib^.p^[j].pixel];
weight := contrib^.p^[j].weight;
if (weight = 0.0) then
continue;
rgb.r := rgb.r + color.r * weight;
rgb.g := rgb.g + color.g * weight;
rgb.b := rgb.b + color.b * weight;
end;
color.r:=TrimReal(0,255,RGB.r);
color.g:=TrimReal(0,255,RGB.g);
color.b:=TrimReal(0,255,RGB.b);
// Set new pixel value
DestPixel^ := color;
// Move on to next column
inc(DestPixel);
end;
end;

// Free the memory (horizontal filter weights)
for i := 0 to DstWidth-1 do
FreeMem(contrib^.p);

FreeMem(contrib);

//-----------------------------------------------------------
//
// VERTICAL PART
//
//
//-----------------------------------------------------------
// -----------------------------------------------
// Pre-calculate filter contributions for a column
// -----------------------------------------------
GetMem(contrib, DstHeight* sizeof(TCList));
// Vertical sub-/supersampling

sMode:=yscale < 1.0;
if sMode then width := fwidth / yscale else width:=fWidth;
if sMode then fscale := 1.0 / yscale else fScale:=1;
for i := 0 to DstHeight-1 do
begin

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round((i/DstHeight)*100));

contrib^.n := 0;
GetMem(contrib^.p, trunc(width * 2.0 + 1) * sizeof(TContributor));
center := i / yscale;
left := xFloor(center - width);
right := xCeil(center + width);
for j := left to right do
begin
weight := filter((center - j) / fscale) / fscale;
if (weight = 0.0) then
continue;
if (j < 0) then
n := -j
else if (j >= SrcHeight) then
n := SrcHeight - j + SrcHeight - 1
else
n := j;
k := contrib^.n;
contrib^.n := contrib^.n + 1;
contrib^.p^[k].pixel := n;
contrib^.p^[k].weight := weight;
end;
end;

// --------------------------------------------------
// Apply filter to sample vertically from Work to Dst
// --------------------------------------------------
SourceLine := Work.ScanLine[0];
Delta := integer(Work.ScanLine[1]) - integer(SourceLine);
DestLine := DstBitmap.ScanLine[0];
DestDelta := integer(DstBitmap.ScanLine[1]) - integer(DestLine);
for k := 0 to DstWidth-1 do
begin

if Assigned(ResampleCallBack) then ResampleCallBack(0,100,Round((k/DstWidth)*100));

DestPixel := pointer(DestLine);
for i := 0 to DstHeight-1 do
begin
rgb.r := 0;
rgb.g := 0;
rgb.b := 0;
for j := 0 to contrib^.n-1 do
begin
color := PColorRGB(integer(SourceLine)+contrib^.p^[j].pixel*Delta)^;
weight := contrib^.p^[j].weight;
if (weight = 0.0) then
continue;
rgb.r := rgb.r + color.r * weight;
rgb.g := rgb.g + color.g * weight;
rgb.b := rgb.b + color.b * weight;
end;
color.r:=TrimReal(0,255,RGB.r);
color.g:=TrimReal(0,255,RGB.g);
color.b:=TrimReal(0,255,RGB.b);
DestPixel^ := color;
inc(integer(DestPixel), DestDelta);
end;
Inc(SourceLine, 1);
Inc(DestLine, 1);
end;

// Free the memory (vertical filter weights)
for i := 0 to DstHeight-1 do
FreeMem(contrib^.p);

FreeMem(contrib);

finally
Work.Free;
end;
end;
end.

/////////////////////////////////////////////////////
调用方法：
procedure TFormMain.MiscClick(Sender: TObject);
var
TempBmp,tb:TBitmap;
begin
TempBMP:=TBitmap.Create;
TB:=TBitmap.Create;
try
case (Sender as TMenuItem).Tag of
1:begin
DoSthForUndo('垂直翻转');
FlipBitmap(Image1.Picture.Bitmap,TempBmp,nil);
Image1.Picture.Bitmap.Assign(TempBMP);
end;
2:begin
DoSthForUndo('水平翻转');
MirrorBitmap(Image1.Picture.Bitmap,TempBmp,nil);
Image1.Picture.Bitmap.Assign(TempBMP);
end;
3:
begin
DoSthForUndo('反相');
EffectNegative(Image1.Picture.Bitmap,TempBMP,nil);
Image1.Picture.Bitmap.Assign(TempBMP);
end;
4:begin
DoSthForUndo('彩色变灰度');
EffectGreyScale(Image1.Picture.Bitmap,TempBmp,nil);
Image1.Picture.Bitmap.Assign(TempBMP);
end;
5:begin
DoSthForUndo('翻转');
FlipBitmap(Image1.Picture.Bitmap,Image1.Picture.Bitmap,nil);
end;
6:begin
DoSthForUndo('翻转');
MirrorBitmap(Image1.Picture.Bitmap,Image1.Picture.Bitmap,nil);
end;
7:begin
DoSthForUndo('老照片效果');
EffectGreyScale(Image1.Picture.Bitmap,Image1.Picture.Bitmap,nil);
end;
end;
finally
TempBmp.Free;
TB.Free;
Image1.RePaint;
end;
end;

////////////////////////////////////////
procedure TRotCtrlForm.Button3Click(Sender: TObject);
begin
Screen.Cursor:=crHourGlass;


CreateXPanel(Self,200,100);
XPanel.Caption:='正在旋转...';
try
if not SrcBitmap.Empty then
begin
// FormMain.SaveCurrentBitmap(OldBmp, FormMain.sCurrentFile , '旋转');
// FormMain.MainMenu1.Items.Items[1].Items[0].Caption :='撤消 旋转';
// FormMain.MenuProcess;
FormMain.DoSthForUndo('旋转');
RotateBitmap(SrcBitmap,DestBitmap,StrToInt(DegreeEdit.Text),
StrToInt(RotXEdit.Text), StrToInt(RotYEdit.Text),
EnlCanv.Checked,ColorDialog1.Color,XProgress );
end;
finally
Screen.Cursor:=crDefault;
ReleaseXPanel;
end;
end;

旋转的楼上的都说得差不多了！
那我就拣了图象任意大小截取说说吧！不过我首先需要说说我的理解！
任意大小？是不是指图象缩放？而截取，指的究竟是截取原图的局部？还是缩放以后的整个图呢？

YB_unique
你好，我要做的是对原图实现截取！谢谢！

试试！随手写的！

procedure TForm1.Button1Click(Sender: TObject);
var
Bitmap: TBitmap;
rectd,rects:Trect;
begin
BitMap:=TBitMap.Create;
rectd:=rect(0,0,(selectendx-selectstartx),(selectendy-selectstarty));
rects:=rect(selectstartx,selectstarty,selectendx,selectendy);
BitMap.LoadFromFile('c:/test.bmp');
bitmap.canvas.CopyRect(rectd,bitmap.canvas,rects);
form2.show;
Form2.image1.Picture.Bitmap:=bitmap;
Bitmap.Free;
end;

用scanline翻转。

谢谢各位！
TO YB_unique 如果要截取缩放后得图形又该如何 谢谢

如果要截取缩放后得图形又该如何？

再用一个TempImage就可以了。。。

多人接受答案了。

那如果用scanline，应该咋做呀？？