УТВЕРЖДЁН
643.МГУЛ.5528.ВТ-14 12
ПРОГРАММНАЯ МОДЕЛЬ СОВМЕЩЕНИЯ АЭРОКОСМИЧСКИХ СНИМКОВ ЭТАЛОННЫХ УЧАСТКОВ ПОДСТИЛАЮЩЕЙ ПОВЕРХНОСТИ
643.Мгул.5528.Вт-14 12
Текст программы
Листов 30
Аннотация
Данный документ содержит текст программы. Каждая модель реализована в разных программных модулях.
Содержание
1. Unit1.pas(растровая модель) .…………………………………………………… 4
2. Unit1.dfm …………………………………………………………………………… 12
3. Unit1.pas(векторная модель)……………………………………………………….16
4. Unit1.dfm …………………………………………………………………………… 24
1 Unit1.Pas
unit Unit1;
interface
uses
Windows, Messages, Math, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Edit1: TEdit;
Button1: TButton;
OpenDialog1: TOpenDialog;
Image2: TImage;
Button2: TButton;
Image3: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
Edit2: TEdit;
Label4: TLabel;
Label5: TLabel;
CheckBox1: TCheckBox;
Button4: TButton;
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;
N : Double;
I, J: Integer;
XMax, YMax: Integer;
Max : Integer;
X, Y,X2,Y2: Integer;
Xm, Ym, Xx, Yx: Integer;
L, A: Double;
implementation
{$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.Button1Click(Sender: TObject);
var qq,bm, bm1: TBitMap;
x, y: integer;
r, a,b: single;
xo, yo: integer;
s, c: extended;
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]:=clwhite;
end;
Application.ProcessMessages;
end;
Form1.Image2.Canvas.Draw(xo, yo, qq);
a := a + 0.05;
Application.ProcessMessages;
end; end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if not OpenDialog1.Execute then exit;
if OpenDialog1.Execute then
Form1.Image1.Picture.Bitmap.LoadFromFile(OpenDialog1.FileName);
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.
}