09.04.2009, 23:17
|
|
Активный
|
|
Регистрация: 22.09.2007
Адрес: SPb
Сообщения: 228
Версия Delphi: 7, 2009, XE2
Репутация: 70
|
|
Код:
const
PixelMax = 32768;
type
pPixelArray = ^TPixelArray;
TPixelArray = array [0..PixelMax-1] of TRGBTriple;
var
Angle: integer;
procedure RotateBitmap_ads(SourceBitmap: TBitmap;
out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DestBitmap.Width := SourceBitmap.Width*3;
DestBitmap.Height := SourceBitmap.Height*3;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians);
cosRadians := Cos(Radians);
for inX := DestBitmap.Height-1 downto 0 do
begin
RotatedRow := DestBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
for inY := DestBitmap.Width-1 downto 0 do
begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
inYOriginal := (inYPrimeRotated - 1) div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) div 2 + Center.y;
if (inYOriginal >= 0) and (inYOriginal <= SourceBitmap.Width-1) and
(inXOriginal >= 0) and (inXOriginal <= SourceBitmap.Height-1) then
begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal];
{ RotatedRow[inY].rgbtBlue:= 255-RotatedRow[inY].rgbtBlue;
RotatedRow[inY].rgbtGreen:= 255-RotatedRow[inY].rgbtGreen;
RotatedRow[inY].rgbtRed:= 255-RotatedRow[inY].rgbtRed; }
end
else
begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
try
Center.y := (Image1.Height div 2)+20;
Center.x := (Image1.Width div 2)+0;
RotateBitmap_ads(
Image1.Picture.Bitmap,
Bitmap,
Center,
Angle);
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap);
finally
Bitmap.Free;
end;
end;
__________________
Начинающий программист уверен, что в 1 килобайте 1000 байт.
Законченный программист уверен, что в 1 километре 1024 метра.
|