Bitmap rotation is a graphic effect that Delphi does not natively offer. This
article shows how to rotate a given image in 90-degree increments. It allows you to
rotate any image 0, 90, 180 or 270 degrees. With a little work, the code can be
modified to rotate to any angle, but that is beyond the scope of this article.
1 procedure RotateBitmap(var hBitmapDC : Longint; var lWidth : Longint;
2 var lHeight : Longint; lRadians : real);
3 var
4 I : Longint; // loop counter
5 J : Longint; // loop counter
6 hNewBitmapDC : Longint; // DC of the new bitmap
7 hNewBitmap : Longint; // handle to the new bitmap
8 lSine : extended; // sine used in rotation
9 lCosine : extended; // cosine used in rotation
10 X1 : Longint; // used in calculating new
11 // bitmap dimensions
12 X2 : Longint; // used in calculating new
13 // bitmap dimensions
14 X3 : Longint; // used in calculating new
15 // bitmap dimensions
16 Y1 : Longint; // used in calculating new
17 // bitmap dimensions
18 Y2 : Longint; // used in calculating new
19 // bitmap dimensions
20 Y3 : Longint; // used in calculating new
21 // bitmap dimensions
22 lMinX : Longint; // used in calculating new
23 // bitmap dimensions
24 lMaxX : Longint; // used in calculating new
25 // bitmap dimensions
26 lMinY : Longint; // used in calculating new
27 // bitmap dimensions
28 lMaxY : Longint; // used in calculating new
29 // bitmap dimensions
30 lNewWidth : Longint; // width of new bitmap
31 lNewHeight : Longint; // height of new bitmap
32 lSourceX : Longint; // x pixel coord we are blitting
33 // from the source image
34 lSourceY : Longint; // y pixel coord we are blitting
35 // from the source image
36
37 begin
38 // create a compatible DC from the one just brought
39 // into this function
40 hNewBitmapDC := CreateCompatibleDC(hBitmapDC);
41
42 // compute the sine/cosinse of the radians used to
43 // rotate this image
44 lSine := Sin(lRadians);
45 lCosine := Cos(lRadians);
46
47 // compute the size of the new bitmap being created
48 X1 := Round(-lHeight * lSine);
49 Y1 := Round(lHeight * lCosine);
50 X2 := Round(lWidth * lCosine - lHeight * lSine);
51 Y2 := Round(lHeight * lCosine + lWidth * lSine);
52 X3 := Round(lWidth * lCosine);
53 Y3 := Round(lWidth * lSine);
54
55 // figure out the max/min size of the new bitmap
56 lMinX := Min(0, Min(X1, Min(X2, X3)));
57 lMinY := Min(0, Min(Y1, Min(Y2, Y3)));
58 lMaxX := Max(X1, Max(X2, X3));
59 lMaxY := Max(Y1, Max(Y2, Y3));
60
61 // set the new bitmap width/height
62 lNewWidth := lMaxX - lMinX;
63 lNewHeight := lMaxY - lMinY;
64
65 // create a new bitmap based upon the new width/height of the
66 // rotated bitmap
67 hNewBitmap := CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight);
68
69 //attach the new bitmap to the new device context created
70 //above before constructing the rotated bitmap
71 SelectObject(hNewBitmapDC, hNewBitmap);
72
73 // loop through and translate each pixel to its new location.
74 // this is using a standard rotation algorithm
75 for I := 0 to lNewHeight do begin
76 for J := 0 to lNewWidth do begin
77 lSourceX := Round((J + lMinX) * lCosine + (I + lMinY) * lSine);
78 lSourceY := Round((I + lMinY) * lCosine - (J + lMinX) * lSine);
79 if (lSourceX >= 0) and (lSourceX <= lWidth) and
80 (lSourceY >= 0) and (lSourceY <= lHeight) then
81 BitBlt(hNewBitmapDC, J, I, 1, 1, hBitmapDC,
82 lSourceX, lSourceY, SRCCOPY);
83 end;
84 end;
85
86 // reset the new bitmap width and height
87 lWidth := lNewWidth;
88 lHeight := lNewHeight;
89
90 // return the DC to the new bitmap
91 hBitmapDC := hNewBitmapDC;
92
93 // destroy the bitmap created
94 DeleteObject(hNewBitmap);
95
96 end;
97
98 //The following is an example of how the RotateBitmap function might be called:
99
100 procedure TForm1.RotateTest(Sender: TObject);
101 var
102 lRadians : real;
103 DC : longint;
104 H, W : integer;
105 Degrees : integer;
106 begin
107 Degrees := 45;
108 lRadians := PI * Degrees / 180;
109 DC := Image1.Picture.Bitmap.Canvas.Handle;
110 H := Image1.Picture.Bitmap.Height;
111 W := Image1.Picture.Bitmap.Width;
112 RotateBitmap(DC, W, H, lRadians);
113 Image1.Width := W;
114 Image1.Height := H;
115 Image1.Picture.Bitmap.Width := W;
116 Image1.Picture.Bitmap.Height := H;
117 BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, W, H, DC, 0, 0, SRCCopy);
118 Image1.Refresh;
119 end;
|
