2 Unit1.Dfm
object Form1: TForm1
Left = 252
Top = 36
Width = 713
Height = 644
Caption = 'bmp-full and part rotate'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 101
TextHeight = 13
object Image1: TImage
Left = 8
Top = 32
Width = 320
Height = 240
end
object Image2: TImage
Left = 344
Top = 32
Width = 320
Height = 240
end
object Image3: TImage
Left = 16
Top = 296
Width = 313
Height = 273
end
object Label1: TLabel
Left = 72
Top = 8
Width = 167
Height = 24
Caption = 'эталонный снимок'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -18
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label2: TLabel
Left = 408
Top = 8
Width = 158
Height = 24
Caption = 'реальный снимок'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -18
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label3: TLabel
Left = 56
Top = 272
Width = 201
Height = 24
Caption = 'обработанный снимок'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -18
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label4: TLabel
Left = 528
Top = 368
Width = 26
Height = 13
Caption = 'angle'
end
object Label5: TLabel
Left = 528
Top = 448
Width = 29
Height = 13
Caption = '-angle'
end
object Edit1: TEdit
Left = 512
Top = 384
Width = 65
Height = 21
TabOrder = 0
Text = '0'
end
object Button1: TButton
Left = 512
Top = 416
Width = 73
Height = 25
Caption = 'rotate!'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 280
Top = 0
Width = 73
Height = 25
Caption = 'open'
TabOrder = 2
OnClick = Button2Click
end
object Button3: TButton
Left = 512
Top = 496
Width = 81
Height = 33
Caption = 'currect'
TabOrder = 3
OnClick = Button3Click
end
object Edit2: TEdit
Left = 512
Top = 464
Width = 65
Height = 21
TabOrder = 4
Text = '0'
end
object CheckBox1: TCheckBox
Left = 512
Top = 320
Width = 65
Height = 25
Caption = 'метод 2'
TabOrder = 5
end
object Button4: TButton
Left = 584
Top = 320
Width = 65
Height = 25
Caption = 'очистка'
TabOrder = 6
OnClick = Button4Click
end
object OpenDialog1: TOpenDialog
Filter = 'изображения|*.bmp'
Left = 592
Top = 368
end
end
3 Unit1.Pas (векторная модель)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Math, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Image2: TImage;
Button2: TButton;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Image3: TImage;
Edit2: TEdit;
Button3: TButton;
Label6: TLabel;
Label7: TLabel;
CheckBox1: TCheckBox;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; AP:array[0..5] of Tpoint;
var delta_x,delta_y,x1,y1,xx1,yy1: integer;
N,n1 : Double;
I, J: Integer;
XMax, YMax: Integer;
Max : Integer;
X, Y,X2,Y2: Integer;
Xm, Ym, Xx, Yx: Integer;
L, A: Double;
implementation
procedure pryam(delta_x,delta_y:integer);
begin
AP[0].X:=196; AP[0].Y:=31;
AP[1].X:=245; AP[1].Y:=20;
AP[2].X:=291; AP[2].Y:=72;
AP[3].X:=154; AP[3].Y:=50;
AP[4].X:=130; AP[4].Y:=109;
AP[5].X:=174; AP[5].Y:=58;
delta_x:=round(Form1.Image1.Width/10);
delta_y:=round(Form1.Image1.Height/10);
Form1.Image1.Canvas.Brush.Color:=$0063FF8A;
Form1.Image1.Canvas.Rectangle(delta_x,delta_y,delta_x*2,delta_y*2);
Form1.Image1.Canvas.Rectangle(delta_x,delta_y*2,delta_x*2,delta_y*3);
Form1.Image1.Canvas.Rectangle(delta_x*2,delta_y*2,delta_x*3,delta_y*3);
Form1.Image1.Canvas.Brush.Color:=$0000ae1A;
Form1.Image1.Canvas.Rectangle(delta_x*5,delta_y*5,delta_x*6,delta_y*6);
Form1.Image1.Canvas.Rectangle(delta_x*6,delta_y*5,delta_x*7,delta_y*6);
Form1.Image1.Canvas.Rectangle(delta_x*5,delta_y*6,delta_x*6,delta_y*7);
Form1.Image1.Canvas.Rectangle(delta_x*7,delta_y*6,delta_x*8,delta_y*5);
Form1.Image1.Canvas.Brush.Color:=$0011660f;
Form1.Image1.Canvas.Ellipse(15,200,110,220);
Form1.Image1.Canvas.Brush.Color:=$006aff12;
Form1.Image1.Canvas.Polygon(AP);
end;
procedure setka(x,y:integer);
var a,b,i,b1:integer; delta_x,delta_y:integer;
begin
a:=0;b:=0; b1:=0;
delta_x:=round(Form1.Image1.Width/10);
delta_y:=round(Form1.Image1.Height/10);
Form1.Image1.Canvas.Pen.Color:=$00000001;
for i:=1 to 10 do begin
Form1.Image1.Canvas.MoveTo(a, b);
Form1.Image1.Canvas.LineTo(Form1.Image1.Width,b1); //гор линии
b:=b+delta_y;
b1:=b1+delta_y;
end;
a:=0;b:=0; b1:=0;
for i:=1 to 10 do begin
Form1.Image1.Canvas.MoveTo(a, b);
Form1.Image1.Canvas.LineTo(b1,Form1.Image1.Height); //верт линии
a:=a+delta_x;
b1:=b1+delta_x;;
end; end;
{$R *.dfm}
procedure NewCoord(Var X, Y : Integer; Alpha : Double);
Var
A, L: Double;
Begin
// Вычисляем размер плеча
L:= Sqrt(X*X+Y*Y);
// Вычисляем угол поворота, но если X = 0, то на него делить нельзя поэтому запишем угол равный PI/2
IF X = 0 THEN
IF Y < 0 THEN
A:= -PI/2
ELSE
A:=PI/2
ELSE
A:=ArcTan(Y/X);
// Скорректируем значение угла (если X < 0, то угол должен лежать PI/2 до 3PI/2)
IF X < 0 THEN
A:= A+PI;
// Вычисляем новые координаты
X:= Round(L*(Cos(A+Alpha)));
Y:= Round(L*(Sin(A+Alpha)));
End;
procedure TForm1.FormCreate(Sender: TObject);
begin
setka(x,y);
pryam(delta_x,delta_y);
end;
procedure TForm1.Button2Click(Sender: TObject);
var qq,bm, bm1: TBitMap;
x, y: integer;
r, a,b: single;
xo, yo: integer;
s, c: extended;
{Var
N,n1 : Double;
I, J: Integer;
XMax, YMax: Integer;
Max : Integer;
X, Y,X2,Y2: Integer;
Xm, Ym, Xx, Yx: Integer;
L, A: Double;}
begin
//Для начала преобразуем наш угол поворота в радианы
N:= -StrToFloat(Edit1.Text)*PI/180;
//Причем угол имеет обратное значение *
// Узнаем максимальные размеры изображения
XMax:= Image1.Width-1;
YMax:= Image1.Height-1;
// Получим координаты серидины изображения (именно вокруг него мы и будем вращать)
X2:=XMax DIV 2;
Y2:=YMax DIV 2;
//Размеры будущего изображения
Xm:= 0; Xx:= 0; Ym:= 0; Yx:= 0;
//Определяем размер получаемого изображения
//левый верхний угол
X:= -X2; Y:= -Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:= Y;
//правый верхний угол
X:= X2; Y:= -Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:=Y;
//правый нижний угол
X:= X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:=Y;
//левый нижний угол
X:= -X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:=Y;
//Теперь мы знаем размеры изображения которое будет
Image2.Width:= Xx-Xm;
Image2.Height:= Yx-Ym;
//Идем по координатам полученой картинки и вычисляем для них координаты исходного изображения
FOR I:= Xm TO Xx DO
FOR J:= Ym TO Yx DO Begin
//Получаем координаты точки изображения относительно его центра
X:= I-X2;
Y:= J-Y2;
//Преобразоваваем
NewCoord(X, Y, N);
//Переходим к абсолютным координатам
X:= X+X2; Y:= Y+Y2;
//Если координаты точки не попадают в исходное изображение, то рисуем простую белую точку
IF (X > Image1.Width-1) OR (Y > Image1.Height-1) OR (X < 0) OR (Y < 0) THEN
Image2.Canvas.Pixels[I-Xm, J-Ym]:= clWhite
ELSE // иначе переносим точку с изображения оригинала
Image2.Canvas.Pixels[I-Xm, J-Ym]:= Image1.Canvas.Pixels[X, Y];
end;
if Checkbox1.Checked=true then begin
bm:=Image1.Picture.Bitmap; qq:=TBitMap.Create;
// bm := TBitMap.Create;
//bm.LoadFromFile('C:\11.bmp');
xo := bm.Width div 2;
yo := bm.Height div 2;
// bm1 := TBitMap.Create;
bm1:=Image2.Picture.Bitmap.Create;
bm1.Width := bm.Width;
bm1.Height := bm.Height;
b := StrToFloat(Edit1.Text); if (b>1) then begin
messagebox(handle,'попробуй ввести число меньше 1','ошиблись',mb_ok);
exit; end; a:=0;
while a<b do begin
for y := 0 to Image1.Height - 1 do
begin
for x := 0 to Image1.Width - 1 do
begin
r := sqrt(sqr(x - xo) + sqr(y - yo));
SinCos(a + arctan2((y - yo), (x - xo)), s, c);
Image2.Canvas.Pixels[x,y] := Image1.Canvas.Pixels[
round(xo + r * c), round(yo + r * s)];
if (Image2.Canvas.Pixels[x,y]=clblack) then
//Image2.Canvas.Pixels[x,y]:=Image2.Picture.Bitmap.TransparentColor;
Image2.Canvas.Pixels[x,y]:=clwhite;
end;
Application.ProcessMessages;
end;
Form1.Image2.Canvas.Draw(xo, yo, qq);
a := a + 0.05;
Application.ProcessMessages;
end; end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
qq,bm, bm1: TBitMap;
x, y: integer;
r, a,b1: single;
xo, yo: integer;
s, c: extended;
begin
//Для начала преобразуем наш угол поворота в радианы
N:= -StrToFloat(Edit2.Text)*PI/180;
//Причем угол имеет обратное значение *
// Узнаем максимальные размеры изображения
XMax:= Image2.Width-1;
YMax:= Image2.Height-1;
// Получим координаты серидины изображения (именно вокруг него мы и будем вращать)
X2:=XMax DIV 2;
Y2:=YMax DIV 2;
//Размеры будущего изображения
Xm:= 0; Xx:= 0; Ym:= 0; Yx:= 0;
//Определяем размер получаемого изображения
//левый верхний угол
X:= X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:= Y;
//правый верхний угол
X:= X2; Y:= -Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:=Y;
//правый нижний угол
X:= X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:=Y;
//левый нижний угол
X:= -X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:=Y;
//Теперь мы знаем размеры изображения которое будет
Image3.Width:= Xx-Xm;
Image3.Height:= Yx-Ym;
//Идем по координатам полученой картинки и вычисляем для них координаты исходного изображения
FOR I:= Xm TO Xx DO
FOR J:= Ym TO Yx DO Begin
//Получаем координаты точки изображения относительно его центра
X:= I-X2;
Y:= J-Y2;
//Преобразоваваем
NewCoord(X, Y, N);
//Переходим к абсолютным координатам
X:= X+X2; Y:= Y+Y2;
//Если координаты точки не попадают в исходное изображение, то рисуем простую белую точку
IF (X > Image2.Width-1) OR (Y > Image2.Height-1) OR (X < 0) OR (Y < 0) THEN
Image3.Canvas.Pixels[I-Xm, J-Ym]:= clWhite
ELSE // иначе переносим точку с изображения оригинала
Image3.Canvas.Pixels[I-Xm, J-Ym]:= Image2.Canvas.Pixels[X, Y];
end;
if checkbox1.Checked=true then begin
bm:=Image2.Picture.Bitmap; qq:=TBitMap.Create;
// bm := TBitMap.Create;
//bm.LoadFromFile('C:\11.bmp');
xo := bm.Width div 2;
yo := bm.Height div 2;
// bm1 := TBitMap.Create;
bm1:=Image3.Picture.Bitmap.Create;
bm1.Width := bm.Width;
bm1.Height := bm.Height;
b1 := StrToFloat(Edit2.Text); a:=0;
while a>b1 do begin
for y := 0 to Image1.Height - 1 do
begin
for x := 0 to Image1.Width - 1 do
begin
r := sqrt(sqr(x - xo) + sqr(y - yo));
SinCos(a + arctan2((y - yo), (x - xo)), s, c);
Image3.Canvas.Pixels[x,y] := Image2.Canvas.Pixels[
round(xo + r * c), round(yo + r * s)];
if (Image3.Canvas.Pixels[x,y]=clblack) then
Image3.Canvas.Pixels[x,y]:=clwhite;
end;
Application.ProcessMessages;
end;
Form1.Image3.Canvas.Draw(xo, yo, qq);
a := a - 0.05;
end; end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
image2.Picture:=nil; image3.Picture:=nil;
end;
end.