15,848,264 members
See more:
I wish to project with delphi
I can't do it,,,
thanks be for,,,
Posted
Steve Maier 14-Mar-12 17:22pm
What have you tried so far? Can you edit your question with some code that you are trying so that we can help you?

## Solution 1

Delphi
```Const PixelMax = 32768;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;

SourceBitmap : TBitmap;
out DestBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
RotatedRow : pPixelArray;
begin
DestBitmap.Width := SourceBitmap.Width;
DestBitmap.Height := SourceBitmap.Height;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
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]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;```

Sample :

Delphi
```Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
Image.Picture.Bitmap,
Bitmap,
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;
end;```

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Top Experts
Last 24hrsThis month
 Richard Deeming 135 Richard MacCutchan 60 Graeme_Grant 50 #realJSOP 40 Dave Kreskowiak 35
 OriginalGriff 2,233 Richard Deeming 1,010 Dave Kreskowiak 676 Graeme_Grant 639 Richard MacCutchan 570

CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900