Вопрос # 1 459: …сперты! Можно ли поворачивать Image на форме?… (Работа с компонентами и библиотеками)

Приветствую, уважаемые эксперты!
Можно ли поворачивать Image на форме?

Здравствуйте, Hi-tek!
Смотрите в Пиролежении несколько примеров по:
1. Алгоритм поворота изображения;
2. Вращение изображения;
3. Вращать Bitmap вокруг точки;
4. Зеркальное преобразование.
А так же смотрите вопрос #1388.

P.S. Могу, в личном порядке, еще подкинуть разные эффекты для картинок.

Приложение:

x = xo + r * cos(alpha + beta)
y = yo + r * sin(alpha + beta)
uses Math;
procedure TForm1.Button1Click(Sender: TObject);
var
bm, bm1: TBitMap;
x, y: integer;
r, a: single;
xo, yo: integer;
s, c: extended;
begin
bm := TBitMap.Create;
bm.LoadFromFile('ex.bmp');
xo := bm.Width div 2;
yo := bm.Height div 2;
bm1 := TBitMap.Create;
bm1.Width := bm.Width;
bm1.Height := bm.Height;
a := 0;
repeat
for y := 0 to bm.Height - 1 do begin
for x := 0 to bm.Width - 1 do begin
r := sqrt(sqr(x - xo) + sqr(y - yo));
SinCos(a + arctan2((y - yo), (x - xo)), s, c);
bm1.Canvas.Pixels[x,y] := bm.Canvas.Pixels[
round(xo + r * c), round(yo + r * s)];
end;
Application.ProcessMessages;
end;
Form1.Canvas.Draw(xo, yo, bm1);
a := a + 0.05;
Application.ProcessMessages;
until Form1.Tag <> 0;
bm.Destroy;
bm1.Destroy;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Tag := 1;
end;
procedure RotateRight(BitMap: tImage);
var
FirstC, LastC, c, r: integer;
procedure FixPixels(c, r: integer);
var
SavePix, SavePix2: tColor;
i, NewC, NewR: integer;
begin
SavePix := Bitmap.Canvas.Pixels[c, r];
for i := 1 to 4 do
begin
newc := BitMap.Height - r + 1;
newr := c;
SavePix2 := BitMap.Canvas.Pixels[newc, newr];
Bitmap.Canvas.Pixels[newc, newr] := SavePix;
SavePix := SavePix2;
c := Newc;
r := NewR;
end;
end;
begin
if BitMap.Width <> BitMap.Height then
exit;
BitMap.Visible := false;
with Bitmap.Canvas do
begin
firstc := 0;
lastc := BitMap.Width;
for r := 0 to BitMap.Height div 2 do
begin
for c := firstc to lastc do
begin
FixPixels(c, r);
end;
inc(FirstC);
Dec(LastC);
end;
end;
BitMap.Visible := true;
end;
// Vector from FromP to ToP
function TForm1.Vektor(FromP, Top: TPoint): TPoint;
begin
Result.x := Top.x - FromP.x;
Result.y := Top.y - FromP.y;
end;
// neue x Komponente des Verktors
// new x-component of the vector
function TForm1.xComp(Vektor: TPoint; Angle: Extended): Integer;
begin
Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
end;
// neue Y-Komponente des Vektors
// new y-component of the vector
function TForm1.yComp(Vektor: TPoint; Angle: Extended): Integer;
begin
Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
end;
function TForm1.RotImage(srcbit: TBitmap; Angle: Extended; FPoint: TPoint;
Background: TColor): TBitmap;
{
srcbit: TBitmap; // Bitmap dass gedreht werden soll ; Bitmap to be rotated
Angle: extended; // Winkel in Bogenma?, angle
FPoint: TPoint; // Punkt um den gedreht wird ; Point to be rotated around
Background: TColor): TBitmap; // Hintergrundfarbe des neuen Bitmaps ;
// Backgroundcolor of the new bitmap
}
var
highest, lowest, mostleft, mostright: TPoint;
topoverh, leftoverh: integer;
x, y, newx, newy: integer;
begin
Result := TBitmap.Create;
// Drehwinkel runterrechnen auf eine Umdrehung, wenn notig
// Calculate angle down on one rotation, if necessary
while Angle >= (2 * pi) do
begin
angle := Angle - (2 * pi);
end;
// neue Ausma?e festlegen
// specify new size
if (angle <= (pi / 2)) then
begin
highest := Point(0,0); //OL
Lowest := Point(Srcbit.Width, Srcbit.Height); //UR
mostleft := Point(0,Srcbit.Height); //UL
mostright := Point(Srcbit.Width, 0); //OR
end
else if (angle <= pi) then
begin
highest := Point(0,Srcbit.Height);
Lowest := Point(Srcbit.Width, 0);
mostleft := Point(Srcbit.Width, Srcbit.Height);
mostright := Point(0,0);
end
else if (Angle <= (pi * 3 / 2)) then
begin
highest := Point(Srcbit.Width, Srcbit.Height);
Lowest := Point(0,0);
mostleft := Point(Srcbit.Width, 0);
mostright := Point(0,Srcbit.Height);
end
else
begin
highest := Point(Srcbit.Width, 0);
Lowest := Point(0,Srcbit.Height);
mostleft := Point(0,0);
mostright := Point(Srcbit.Width, Srcbit.Height);
end;
topoverh := yComp(Vektor(FPoint, highest), Angle);
leftoverh := xComp(Vektor(FPoint, mostleft), Angle);
Result.Height := Abs(yComp(Vektor(FPoint, lowest), Angle)) + Abs(topOverh);
Result.Width := Abs(xComp(Vektor(FPoint, mostright), Angle)) + Abs(leftoverh);
// Verschiebung des FPoint im neuen Bild gegenuber srcbit
// change of FPoint in the new picture in relation on srcbit
Topoverh := TopOverh + FPoint.y;
Leftoverh := LeftOverh + FPoint.x;
// erstmal mit Hintergrundfarbe fullen
// at first fill with background color
Result.Canvas.Brush.Color := Background;
Result.Canvas.pen.Color := background;
Result.Canvas.Fillrect(Rect(0,0,Result.Width, Result.Height));
// Start des eigentlichen Rotierens
// Start of actual rotation
for y := 0 to srcbit.Height - 1 do
begin // Zeilen ; Rows
for x := 0 to srcbit.Width - 1 do
begin // Spalten ; Columns
newX := xComp(Vektor(FPoint, Point(x, y)), Angle);
newY := yComp(Vektor(FPoint, Point(x, y)), Angle);
newX := FPoint.x + newx - leftoverh;
// Verschieben wegen der neuen Ausma?e
newy := FPoint.y + newy - topoverh;
// Move beacause of new size
Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
// auch das Pixel daneben fullen um Leerpixel bei Drehungen zu verhindern
// 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] := srcbit.Canvas.Pixels[x, y];
end
else
begin
Result.Canvas.Pixels[newx + 1,newy] := srcbit.Canvas.Pixels[x, y];
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
mybitmap, newbit: TBitMap;
begin
if OpenDialog1.Execute then
begin
mybitmap := TBitmap.Create;
mybitmap.LoadFromFile(OpenDialog1.FileName);
newbit := RotImage(mybitmap, DegToRad(45),
Point(mybitmap.Width div 2, mybitmap.Height div 2), clBlack);
Image1.Canvas.Draw(0,0, newBit);
end;
end;
end;
procedure flip_horizontal(Quelle, Ziel: TBitMap);
begin
Ziel.Assign(nil);
Ziel.Width := Quelle.Width;
Ziel.Height := Quelle.Height;
StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
0, Quelle.Height, Quelle.Width, Quelle.Height, srccopy);
end;
procedure flip_vertikal(Quelle, Ziel: TBitMap);
begin
Ziel.Assign(nil);
Ziel.Width := Quelle.Width;
Ziel.Height := Quelle.Height;
StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
Quelle.Width, 0, Quelle.Width, Quelle.Height, srccopy);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
temp: TBitMap;
begin
temp := TBitMap.Create;
try
temp.Assign(Image1.Picture.BitMap);
flip_vertikal(Temp, Image1.Picture.Bitmap);
finally
Temp.Free;
end;
end;
============================
{ **** UBPFD *********** by delphibase.endimus.com ****
***************************************************** }
procedure FlipBitmap(Bitmap: TBitmap; FlipHor: Boolean);
var
x, y, W, H: Integer;
Pixel_1, Pixel_2: PRGBTriple;
MemPixel: TRGBTriple;
begin
Bitmap.PixelFormat := pf24Bit;
W := Bitmap.Width - 1;
H := Bitmap.Height - 1;
for y := 0 to H do
begin
Pixel_1 := Bitmap.ScanLine[y];
Pixel_2 := Bitmap.ScanLine[y];
Inc(Pixel_2, W);
for x := 0 to W div 2 do
begin
MemPixel := Pixel_1^;
Pixel_1^ := Pixel_2^;
Pixel_2^ := MemPixel;
end;
end
for y := 0 to H div 2 do
begin
Pixel_1 := Bitmap.ScanLine[y];
Pixel_2 := Bitmap.ScanLine[H - y];
for x := 0 to W do
begin
MemPixel := Pixel_1^;
Pixel_1^ := Pixel_2^;
Pixel_2^ := MemPixel;
end;
end;
end;

Мини-форум вопроса

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 459

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 459

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом