function RotImage(source:TBitmap; angle:Extended; cx,cy:integer; BGColor:TColor):TBitmap;
var
FPoint: TPoint;
highest,lowest,mostleft,mostright: TPoint;
topoverh,leftoverh: integer;
x,y,newx,newy: integer;
begin
FPoint:=Point(cx,cy);
Result:=TBitmap.Create;
while angle>=(2*pi) do
begin
angle:=angle-(2*pi);
end;
if (angle<=(pi/2)) then
begin
highest := Point(0,0); //OL
Lowest := Point(source.Width, source.Height); //UR
mostleft := Point(0, source.Height); //UL
mostright := Point(source.Width, 0); //OR
end
else if (angle<=pi) then
begin
highest := Point(0, source.Height);
Lowest := Point(source.Width, 0);
mostleft := Point(source.Width, source.Height);
mostright := Point(0,0);
end
else if (angle<=(pi*3/2)) then
begin
highest := Point(source.Width, source.Height);
Lowest := Point(0,0);
mostleft := Point(source.Width, 0);
mostright := Point(0,source.Height);
end
else
begin
highest := Point(source.Width, 0);
Lowest := Point(0,source.Height);
mostleft := Point(0,0);
mostright := Point(source.Width, source.Height);
end;
topoverh:=yComp(Vec(Point(cx,cy), highest), angle);
leftoverh:=xComp(Vec(FPoint, mostleft), angle);
Result.Height:=Abs(yComp(Vec(FPoint, lowest), angle)) Abs(topOverh);
Result.Width:=Abs(xComp(Vec(FPoint, mostright), angle)) Abs(leftoverh);
Topoverh:=TopOverh FPoint.y;
Leftoverh:=LeftOverh FPoint.x;
Result.Canvas.Brush.Color:=BGColor;
Result.Canvas.pen.Color:=BGColor;
Result.Canvas.Fillrect(Rect(0,0, Result.Width, Result.Height));
for y := 0 to source.Height - 1 do
begin
for x := 0 to source.Width - 1 do
begin
newX := xComp(Vec(FPoint, Point(x, y)), angle);
newY := yComp(Vec(FPoint, Point(x, y)), angle);
newX := FPoint.x newx - leftoverh;
newy := FPoint.y newy - topoverh;
// Move beacause of new size
Result.Canvas.Pixels[newx, newy] := source.Canvas.Pixels[x, y];
// also fil lthe pixel beside to prevent empty pixels
if ((angle<(pi/2))or((angle>pi)and(angle<(pi*3/2)))) then
begin
Result.Canvas.Pixels[newx, newy 1] := source.Canvas.Pixels[x, y];
end
else
begin
Result.Canvas.Pixels[newx 1,newy] := source.Canvas.Pixels[x, y];
end;
end;
end;
end;
procedure TForm1.N8Click(Sender: TObject);
var
tmpBmp : TBitmap;
begin
tmpBmp := TBitmap.Create;
try
if assigned(image1.Picture.Bitmap) then
begin
tmpBmp := RotImage(image1.Picture.Bitmap, {Source}
DegToRad(12), {90 degree to rotate}
Point(image1.Picture.Bitmap.Width div 2, {x point for center rotate}
image1.Picture.Bitmap.Height div 2), {y point for center rotate}
clBlack); {background Color for rotated image}
Image2.Picture.Assign(tmpBmp);
end;
finally
tmpBmp.Free;
end;
end;
最後顯示 Incompatible types: 'Integer' and 'TPoint'
我不知道如果去改？？

您好,
我沒很仔細看您的程式, 單從語法來看

您 function 的定義 cx, cy 是 integer
呼叫時為何要用 point去轉型 ?

Point(image1.Picture.Bitmap.Width div 2, {x point for center rotate}
image1.Picture.Bitmap.Height div 2), {y point for center rotate}

不能直接用 image1.Picture.Bitmap.Width div 2, image1.Picture.Bitmap.Height div 2 嗎?

------
IS IT WHAT IT IS
我是 李慕白 請倒著唸.
又想把老話拿出來說, 請用台語發音 : 專家專家全是ROBOT CAR (滷肉腳啦);
都已接手這麼久了, 績效還是那麼爛, 講話還那麼大聲.

嗯嗯 謝謝 原來是多加了！！