Форум: "Media";
Текущий архив: 2003.09.04;
Скачать: [xml.tar.bz2];

Вниз

как повернуть картинку   Найти похожие ветки 

← →
Lamer111   (2003-05-06 22:55) [0]

народ!, кто нить может кинуть готовый алгоритм поворота картинки ( bitmap), я сам пытался чето намутить вроде даже и получилось только поворачивать то он поворачивает а вот при повороте увеличивается высота и ширина катринки и меняесть ее положение относительно центра и я както забил на это дело.....короче помогите кто чем сможет....

---

← →
Kest   (2003-05-06 23:30) [1]

Вот что у себя нашел, но насколько помню там тоже картинку сдвигает. И еще БМП предварительно в *РЕС запихивается.

unit Unit1;
interface

uses
Windows, Messages, SysUtils, Classes, Controls,
Forms, StdCtrls, Math,Graphics, Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;

procedure Button1Click(Sender: TObject);
procedure Label1Click(Sender: TObject);



private
{ Private declarations }


public
function BmpRot(const B: TBitmap;fi:integer):TBitmap;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
function TForm1.BmpRot(const B: TBitmap;fi:integer):TBitmap;
type
TRGBTripleArray = array[0..2023] of TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;
var
x0,y0,i,j,x1,y1,x11,y11,x2,y2:integer;
ht,wd,newht,newwd:integer;
cfi,sfi: double;
sline1,sline2: pRGBTRipleArray;
BEGIN
sfi:=sin(degtorad(fi));
cfi:=cos(degtorad(fi));
ht:=b.Height;
wd:=b.Width;
newwd:=abs(round(ht*sfi))+abs(round(wd*cfi));
newht:=abs(round(wd*sfi))+abs(round(ht*cfi));
Result:=TBitmap.Create;
Result.Width:=newwd;
Result.Height:=newht;
Result.PixelFormat:=pf24bit;
x0:=wd div 2;
y0:=ht div 2;
for j :=newht-1 downto 0 do begin
sline2 := Result.scanline[j];
y1:= 2*(j-(newht-ht) div 2 -y0)+1;
for i := newwd-1 downto 0 do begin
x1:=2*(i-(newwd-wd) div 2 -x0)+1;
x2 :=round(x1 * cfi - y1 * sfi);
y2 :=round(x1 * sfi + y1 * cfi);
x11:=(x2-1) div 2 +x0;
y11:=(y2-1) div 2 +y0;
if (x11>=0)and(x11<wd)and(y11>=0)and(y11<ht) then begin
sline1 := b.scanline[y11];
sline2[i] := sline1[x11];
end;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var b:tbitmap;
( "Resource.res") Вот что у себя нашел, но насколько помню там тоже картинку сдвигает. И еще БМП предварительно в *РЕС запихивается.

unit Unit1;
interface

uses
Windows, Messages, SysUtils, Classes, Controls,
Forms, StdCtrls, Math,Graphics, Dialogs, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;

procedure Button1Click(Sender: TObject);
procedure Label1Click(Sender: TObject);



private
{ Private declarations }


public
function BmpRot(const B: TBitmap;fi:integer):TBitmap;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
function TForm1.BmpRot(const B: TBitmap;fi:integer):TBitmap;
type
TRGBTripleArray = array[0..2023] of TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;
var
x0,y0,i,j,x1,y1,x11,y11,x2,y2:integer;
ht,wd,newht,newwd:integer;
cfi,sfi: double;
sline1,sline2: pRGBTRipleArray;
BEGIN
sfi:=sin(degtorad(fi));
cfi:=cos(degtorad(fi));
ht:=b.Height;
wd:=b.Width;
newwd:=abs(round(ht*sfi))+abs(round(wd*cfi));
newht:=abs(round(wd*sfi))+abs(round(ht*cfi));
Result:=TBitmap.Create;
Result.Width:=newwd;
Result.Height:=newht;
Result.PixelFormat:=pf24bit;
x0:=wd div 2;
y0:=ht div 2;
for j :=newht-1 downto 0 do begin
sline2 := Result.scanline[j];
y1:= 2*(j-(newht-ht) div 2 -y0)+1;
for i := newwd-1 downto 0 do begin
x1:=2*(i-(newwd-wd) div 2 -x0)+1;
x2 :=round(x1 * cfi - y1 * sfi);
y2 :=round(x1 * sfi + y1 * cfi);
x11:=(x2-1) div 2 +x0;
y11:=(y2-1) div 2 +y0;
if (x11>=0)and(x11<wd)and(y11>=0)and(y11<ht) then begin
sline1 := b.scanline[y11];
sline2[i] := sline1[x11];
end;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var b:tbitmap;
i: integer;
begin
i:=0;
while i<723 do
begin
b:=tbitmap.Create;
b.LoadFromFile("Resource.res");
image1.Picture.Assign(BmpRot(b,i));
image1.Repaint;
b.free;
i:=i+3;
Label2.Caption:=inttostr(i);
Label2.Repaint;

end;
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
Application.Terminate;
end;

end.

---

← →
Axis_of_Evil   (2003-05-07 08:51) [2]

SetWorldTransform и поехали ...

---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2003.09.04;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.009 c