Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
25
Добавлен:
02.05.2014
Размер:
12.03 Кб
Скачать
unit laba3;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Spin, Buttons,Math, XPMan;

type
Stroka= array[0..2] of extended;
Matrix= array[0..2] of stroka;
TAffinPlaneForm = class(TForm)
MainImage: TImage;
GrPoly: TGroupBox;
Lcord1: TLabel;
Lcord2: TLabel;
Lcord3: TLabel;
Lcord4: TLabel;
Lcord5: TLabel;
Lcord6: TLabel;
Lcord7: TLabel;
Lcord8: TLabel;
Sx1: TSpinEdit;
Sy1: TSpinEdit;
Sx2: TSpinEdit;
Sy2: TSpinEdit;
Sx3: TSpinEdit;
Sy3: TSpinEdit;
Sx4: TSpinEdit;
Sy4: TSpinEdit;
Button1: TButton;
PreobrGB: TGroupBox;
PreobrPC: TPageControl;
MoveTS: TTabSheet;
X0Lbl: TLabel;
Y0Lbl: TLabel;
MoveXSp: TSpinEdit;
MoveYSp: TSpinEdit;
RotateTS: TTabSheet;
Label11: TLabel;
RotateSp: TSpinEdit;
SdvigTS: TTabSheet;
Label12: TLabel;
Label13: TLabel;
KxSdvigSpin: TSpinEdit;
KySdvigSpin: TSpinEdit;
ScaleTS: TTabSheet;
Label14: TLabel;
Label15: TLabel;
ScaleXSp: TSpinEdit;
ScaleYSp: TSpinEdit;
ZerOtrTS: TTabSheet;
Label16: TLabel;
OxCBox: TCheckBox;
OyCBox: TCheckBox;
GrRel: TRadioGroup;
Button5: TButton;
Button2: TButton;
XPManifest1: TXPManifest;
GroupBox1: TGroupBox;
procedure ReNew();
procedure FormCreate(Sender: TObject);
function MMul(A:Matrix;X:Stroka):Stroka;
procedure Move(Add:integer=0);
function Trans(M:Matrix):Matrix;
procedure Rotate(Add:integer=0);
procedure BoxModifyChange(Sender: TObject);
procedure GrRelClick(Sender: TObject);
procedure Scale();
procedure Mirror();
procedure Shift();
procedure Sx1Change(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure MainImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PreobrPCChange(Sender: TObject);
procedure MoveXSpChange(Sender: TObject);
procedure Button2Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
AffinPlaneForm: TAffinPlaneForm;
S1,S2:Stroka;
Fig: stroka;
Coord: array[0..3] of stroka;
Beg: array[0..3] of stroka;

const
One:matrix=((1,0,0),(0,1,0),(0,0,1));

implementation

{$R *.dfm}


procedure TAffinPlaneForm.ReNew();
var
dl: integer;
hi,i: integer;
jk:integer;
begin
dl := MainImage.Width;
hi := MainImage.Height;
i := 0;
with MainImage.Canvas do
begin
Brush.Color:=clwhite; {выбираем белый цвет}
Rectangle(0,0,MainImage.ClientWidth+1,MainImage.ClientHeight+1); {рисуем прямоугольник размер=размеру image,
т.е. закрашиваем область рисования белым цветом}
Brush.Style := bsClear;
//Сетка
Pen.Color := clhighlight;
while (i<dl-1) do
begin
MoveTo(i,0);
LineTo(i,402);
i := i + 20
end;
i := 0;
while (i<hi-1) do
begin
MoveTo(0,i);
LineTo(402,i);
i := i + 20;
end;
//
Pen.Color := clHotLight;
Pen.Style := psSolid;
//Центральные оси
MoveTo(201,0);
LineTo(201,402);
MoveTo(0,201);
LineTo(402,201);
//Стрелка по OY
MoveTo(201,0);
LineTo(198,10);
MoveTo(201,0);
LineTo(204,10);
TextOut(210,1,'y');
//Стрелка по OX
MoveTo(402,201);
LineTo(392,198);
MoveTo(402,201);
LineTo(392,204);
TextOut(393,201,'x');

// Родной многоугольник
Pen.Color := clTeal;
Brush.Style := bsClear;
MoveTo(Trunc(Sx1.Value + 201),Trunc(-Sy1.Value + 201));
LineTo(Trunc(Sx2.Value + 201),Trunc(-Sy2.Value + 201));
LineTo(Trunc(Sx3.Value + 200),Trunc(-Sy3.Value + 201));
LineTo(Trunc(Sx4.Value + 200),Trunc(-Sy4.Value + 201));
LineTo(Trunc(Sx1.Value + 201),Trunc(-Sy1.Value + 201));
for i:=0 to 3 do
TextOut(TSpinEdit(GrPoly.FindChildControl('Sx'+IntToStr(i+1))).Value + 201,-TSpinEdit(GrPoly.FindChildControl('Sy'+IntToStr(i+1))).Value+201,IntToStr(TSpinEdit(GrPoly.FindChildControl('Sx'+IntToStr(i+1))).Value)+';'+IntToStr(TSpinEdit(GrPoly.FindChildControl('Sy'+IntToStr(i+1))).Value));

Pen.Color := clLime;
Brush.Style := bsClear;
MoveTo(Trunc(Coord[0,0] + 201),Trunc(-Coord[0,1] + 201));
LineTo(Trunc(Coord[1,0] + 201),Trunc(-Coord[1,1] + 201));
LineTo(Trunc(Coord[2,0] + 200),Trunc(-Coord[2,1] + 201));
LineTo(Trunc(Coord[3,0] + 200),Trunc(-Coord[3,1] + 201));
LineTo(Trunc(Coord[0,0] + 201),Trunc(-Coord[0,1] + 201));
// центр лск
if GrRel.ItemIndex = 1 then
begin
Pen.Color := clred;
Brush.Color := clred;
Brush.Style := bsSolid;
Ellipse(MoveXSp.Value-4+201,-MoveYSp.Value-4+201,
MoveXSp.Value+4+201,-MoveYSp.Value+4+201);
end;

Pen.Color := clLime;
Brush.Color:=clMaroon;
for i:=0 to 3 do
Ellipse(Trunc(Coord[i,0] + 199),Trunc(-Coord[i,1] + 199),Trunc(Coord[i,0] + 203),Trunc(-Coord[i,1] + 203));
Brush.Style := bsClear;
for i:=0 to 3 do
TextOut(Trunc(Coord[i,0] + 201),Trunc(-Coord[i,1] + 201),IntToStr(Trunc(Coord[i,0]))+';'+IntToStr(Trunc(Coord[i,1])));
end;
end;

procedure TAffinPlaneForm.FormCreate(Sender: TObject);
var
i: integer;
begin
for i:=0 to 3 do
begin
Coord[i,0] := TSpinEdit(GrPoly.FindChildControl('Sx'+intToStr(i+1))).Value;
Coord[i,1] := TSpinEdit(GrPoly.FindChildControl('Sy'+intToStr(i+1))).Value;
Coord[i,2] := 1;
Beg[i,0] := TSpinEdit(GrPoly.FindChildControl('Sx'+intToStr(i+1))).Value;
Beg[i,1] := TSpinEdit(GrPoly.FindChildControl('Sy'+intToStr(i+1))).Value;
Beg[i,2] := 1;
end;
ReNew();
end;

function TAffinPlaneForm.Trans(M:Matrix):Matrix;
var
Temp : Matrix;
i,j: integer;
begin
Temp := M;
for i:=0 to 2 do
for j:=0 to 2 do
M[j,i] := Temp[i,j];
Result := M;
end;

function TAffinPlaneForm.MMul(A:Matrix;X:Stroka):Stroka;
var
Res:stroka;
i,j:integer;
begin
for i:=0 to 2 do
Res[i]:=0;
for j:=0 to 2 do
for i:=0 to 2 do
Res[j]:=Res[j]+A[i][j]*X[i];
Result:=Res;
end;

procedure TAffinPlaneForm.Move(Add:integer=0);
var
i:integer;
A:matrix;
begin
A:=One;
if Add=0 then
begin
A[0,2] := MoveXSp.Value;
A[1,2] := MoveYSp.Value;
end
else
begin
A[0,2] := -MoveXSp.Value;
A[1,2] := -MoveYSp.Value;
end ;
A := Trans(A);
for i:=0 to 3 do
if GrRel.ItemIndex=1 then
Coord[i]:=MMul(A,Coord[i])//Beg[i]);
else
// Coord[i]:=MMul(A,Beg[i]);
Coord[i]:=MMul(A,Coord[i])//Beg[i]);
end;


procedure TAffinPlaneForm.Rotate(Add:integer=0);
var
i:integer;
A:Matrix;
begin
A:=One;
A[0][0]:=cos(DegToRad(RotateSp.Value));
A[0][1]:=-sin(DegToRad(RotateSp.Value));
A[1][0]:=sin(DegToRad(RotateSp.Value));
A[1][1]:=cos(DegToRad(RotateSp.Value));
A := Trans(A);
if GrRel.ItemIndex=1 then
Move(1);
for i:=0 to 3 do
Coord[i]:=MMul(A,Coord[i]);
if GrRel.ItemIndex=1 then
Move();
end;

procedure TAffinPlaneForm.Scale();
var
i:integer;
A:Matrix;
begin
A:=One;
A[0][0]:= ScaleXSp.Value*0.1;
A[1][1]:= ScaleYSp.Value*0.1;
A := Trans(A);
if GrRel.ItemIndex=1 then
Move(1);
for i:=0 to 3 do
Coord[i]:=MMul(A,Coord[i]);
if GrRel.ItemIndex=1 then
Move();
end;

procedure TAffinPlaneForm.Mirror();
var
i:integer;
A:Matrix;
begin
A:=One;
if OXCBox.Checked then
A[0][0]:=-1;
if OYCBox.Checked then
A[1][1]:=-1;
A := Trans(A);
if GrRel.ItemIndex=1 then
Move(1);
for i:=0 to 3 do
Coord[i]:=MMul(A,Coord[i]);
if GrRel.ItemIndex=1 then
Move();
end;


procedure TAffinPlaneForm.Shift();
var
i:integer;
A: Matrix;
begin
A:=One;
A[0][1]:=KxSdvigSpin.Value*0.1;
A[1][0]:=KySdvigSpin.Value*0.1;
A := Trans(A);
if GrRel.ItemIndex=1 then
Move(1);
for i:=0 to 3 do
Coord[i]:=MMul(A,Coord[i]);
if GrRel.ItemIndex=1 then
Move();
end;


procedure TAffinPlaneForm.BoxModifyChange(Sender: TObject);
var
i:integer;
begin

end;

procedure TAffinPlaneForm.GrRelClick(Sender: TObject);
begin
if GrRel.ItemIndex=0 then
begin
MoveTS.Caption := 'Перенос';
X0Lbl.Caption := 'X:';
Y0Lbl.Caption := 'Y:';
end
else
begin
PreobrPc.ActivePage := MoveTS;
MoveTS.Caption := 'Центр ЛCK';
X0Lbl.Caption := 'X0:';
Y0Lbl.Caption := 'Y0:';
MoveXSp.Value := 0;
MoveYSp.Value := 0;
end;
ReNew();
end;

procedure TAffinPlaneForm.Sx1Change(Sender: TObject);
var
i:integer;
begin
for i:=0 to 3 do
begin
Coord[i,0] := TSpinEdit(GrPoly.FindChildControl('Sx'+intToStr(i+1))).Value;
Coord[i,1] := TSpinEdit(GrPoly.FindChildControl('Sy'+intToStr(i+1))).Value;
Coord[i,2] := 1;
{ Beg[i,0] := TSpinEdit(GrPoly.FindChildControl('Sx'+intToStr(i+1))).Value;
Beg[i,1] := TSpinEdit(GrPoly.FindChildControl('Sy'+intToStr(i+1))).Value;
Beg[i,2] := 1; }
end;
ReNew();
end;

procedure TAffinPlaneForm.Button5Click(Sender: TObject);
begin
GrPoly.Enabled := False;
MainImage.Canvas.Pen.Color := clRed;
case PreobrPC.ActivePageIndex of
0:Move();
1:Rotate();
2:Shift();
3:Scale();
4:Mirror();

end;
ReNew();
end;

procedure TAffinPlaneForm.Button1Click(Sender: TObject);
var
i: integer;
begin
MoveTS.Caption := 'Перенос';
X0Lbl.Caption := 'X:';
Y0Lbl.Caption := 'Y:';
GrRel.Enabled := False;
PreobrPC.ActivePageIndex := 0;
MoveXSp.Value :=0;
MoveYSp.Value :=0;;
RotateSp.Value :=0;
KXSdvigSpin.Value := 0;
KYSdvigSpin.Value := 0;
ScaleXSp.Value := 0;
ScaleYSp.Value := 0;
OYCBox.Checked := False;
OXCBox.Checked := False;
GrRel.ItemIndex := 0;
Sx1.Value := 0; Sy1.Value := 0;
Sx2.Value := 30; Sy2.Value := 70;
Sx3.Value := 70; Sy3.Value := 70;
Sx4.Value := 100; Sy4.Value := 0;
GrPoly.Enabled := True;
for i:=0 to 3 do
begin
Coord[i,0] := TSpinEdit(GrPoly.FindChildControl('Sx'+intToStr(i+1))).Value;
Coord[i,1] := TSpinEdit(GrPoly.FindChildControl('Sy'+intToStr(i+1))).Value;
Coord[i,2] := 1;
{ Beg[i,0] := TSpinEdit(GrPoly.FindChildControl('Sx'+intToStr(i+1))).Value;
Beg[i,1] := TSpinEdit(GrPoly.FindChildControl('Sy'+intToStr(i+1))).Value;
Beg[i,2] := 1; }
end;
ReNew();
end;

procedure TAffinPlaneForm.MainImageMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if GrRel.ItemIndex = 1 then
begin
MoveXSp.Value := (x-201);
MoveYSp.Value := (-y+201);
ReNew();
end;
end;

procedure TAffinPlaneForm.PreobrPCChange(Sender: TObject);
begin
if PreobrPC.ActivePageIndex <> 0 then
GrRel.Enabled := True
else
GrRel.Enabled := False;
end;

procedure TAffinPlaneForm.MoveXSpChange(Sender: TObject);
begin
if GrRel.ItemIndex=1 then
begin
with MainImage.Canvas do
begin

Pen.Color := clred;
Brush.Color := clred;
Brush.Style := bsSolid;
Ellipse(MoveXSp.Value-4+201,-MoveYSp.Value-4+201,
MoveXSp.Value+4+201,-MoveYSp.Value+4+201);

end
end;
ReNew();
end;

procedure TAffinPlaneForm.Button2Click(Sender: TObject);
begin
Close;
end;

end.
Соседние файлы в папке Вариант 2
  • #
    02.05.201417.38 Кб28laba3.dcu
  • #
    02.05.201451 б23laba3.ddp
  • #
    02.05.20149.91 Кб23laba3.dfm
  • #
    02.05.201412.03 Кб25laba3.pas
  • #
    02.05.2014434 б24labprogect3.cfg
  • #
    02.05.20142.05 Кб24labprogect3.dof
  • #
    02.05.2014218 б23labprogect3.dpr
  • #
    02.05.2014876 б23labprogect3.res