unit
Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls, Unit2, ExtDlgs;
type
TForm1 =
class
(TForm)
PaintBox1: TPaintBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
procedure
ScalingClick(Sender: TObject);
procedure
PaintBox1Paint(Sender: TObject);
procedure
FormCreate(Sender: TObject);
procedure
TrackBar1Change(Sender: TObject);
procedure
TrackBar2Change(Sender: TObject);
procedure
RadioButton1Click(Sender: TObject);
procedure
RadioButton2Click(Sender: TObject);
procedure
FormResize(Sender: TObject);
procedure
ScrollBar1Change(Sender: TObject);
procedure
ScrollBar2Change(Sender: TObject);
private
public
end
;
TFigure =
class
clrFColorPen: TColor;
intFCaretPos, intFLastPositionX, intFLastPositionY, intFPoseX, intFPoseY,
intFPositionX, intFPositionY, intFShiftX, intFShiftY:
Integer
;
realFScale:
Real
;
strFDateTime, strFNumberFigure, strFTrackBarPosition:
String
;
procedure
Displacement;
procedure
Drawing;
constructor
Create;
Protected
pntarFPoints:
array
[
0..12
]
of
TPoint;
end
;
TFigureTwo =
class
(TFigure)
realFScaleNext:
Real
;
procedure
Drawing;
constructor
Create;
end
;
var
Form1: TForm1;
objVFigure: TFigure;
objVFigureTwo: TFigureTwo;
implementation
{$R *.dfm}
constructor
TFigure
.
Create;
var
i:
byte
;
begin
clrFColorPen:=Form1
.
PaintBox1
.
Canvas
.
Pen
.
Color;
realFScale:=
1
;
intFPositionX:=
0
;
intFPositionY:=
0
;
intFShiftX:=
0
;
intFShiftY:=
0
;
strFTrackBarPosition:=IntToStr(
0
);
strFDateTime:=IntToStr(
0
);
intFPoseX:=
0
;
intFPoseY:=
0
;
intFLastPositionX:=
0
;
intFLastPositionY:=
0
;
for
i:=
0
to
12
do
pntarFPoints[i]:=Point(
0
,
0
);
strFNumberFigure:=IntToStr(
1
);
end
;
constructor
TFigureTwo
.
Create;
begin
inherited
;
strFNumberFigure:=IntToStr(
2
);
realFScaleNext:=
1
;
end
;
procedure
TFigure
.
Drawing;
begin
Form1
.
PaintBox1
.
Canvas
.
Pen
.
Color:=Form1
.
Color;
Form1
.
PaintBox1
.
Canvas
.
Polyline(pntarFPoints);
intFShiftX:=round((Form1
.
ClientWidth-
30
)/
2
-
50
*realFScale+intFPoseX);
intFShiftY:=round((Form1
.
ClientHeight-
185
)/
2
-
50
*realFScale+intFPoseY);
pntarFPoints[
0
]:=Point(intFShiftX,round(
15
*realFScale)+intFShiftY);
pntarFPoints[
1
]:=Point(round(
15
*realFScale)+intFShiftX,intFShiftY);
pntarFPoints[
2
]:=Point(round(
30
*realFScale)+intFShiftX,round(
15
*realFScale)
+intFShiftY);
pntarFPoints[
3
]:=Point(round(
70
*realFScale)+intFShiftX,round(
15
*realFScale)
+intFShiftY);
pntarFPoints[
4
]:=Point(round(
85
*realFScale)+intFShiftX,intFShiftY);
pntarFPoints[
5
]:=Point(round(
100
*realFScale)+intFShiftX,round(
15
*realFScale)
+intFShiftY);
pntarFPoints[
6
]:=Point(round(
100
*realFScale)+intFShiftX,round(
85
*realFScale)
+intFShiftY);
pntarFPoints[
7
]:=Point(round(
85
*realFScale)+intFShiftX,round(
100
*realFScale)
+intFShiftY);
pntarFPoints[
8
]:=Point(round(
70
*realFScale)+intFShiftX,round(
85
*realFScale)
+intFShiftY);
pntarFPoints[
9
]:=Point(round(
30
*realFScale)+intFShiftX,round(
85
*realFScale)
+intFShiftY);
pntarFPoints[
10
]:=Point(round(
15
*realFScale)+intFShiftX,round(
100
*realFScale)
+intFShiftY);
pntarFPoints[
11
]:=Point(intFShiftX,round(
85
*realFScale)+intFShiftY);
pntarFPoints[
12
]:=Point(intFShiftX,round(
15
*realFScale)+intFShiftY);
Form1
.
PaintBox1
.
Canvas
.
Pen
.
Color:=clrFColorPen;
Form1
.
PaintBox1
.
Canvas
.
Polyline(pntarFPoints);
end
;
procedure
TFigureTwo
.
Drawing;
begin
With
Form1
.
PaintBox1
.
Canvas
do
begin
Pen
.
Color:=Form1
.
Color;
MoveTo(intFShiftX-round(
25
*realFScaleNext),intFShiftY-round(
50
*realFScaleNext));
LineTo(intFShiftX+round(
90
*realFScaleNext),intFShiftY+round(
25
*realFScaleNext));
LineTo(intFShiftX+round(
35
*realFScaleNext),intFShiftY+round(
50
*realFScaleNext));
LineTo(intFShiftX-round(
50
*realFScaleNext),intFShiftY-round(
25
*realFScaleNext));
LineTo(intFShiftX-round(
35
*realFScaleNext),intFShiftY-round(
50
*realFScaleNext));
MoveTo(intFShiftX+round(
25
*realFScaleNext),intFShiftY-round(
50
*realFScaleNext));
LineTo(intFShiftX+round(
50
*realFScaleNext),intFShiftY-round(
25
*realFScaleNext));
LineTo(intFShiftX-round(
25
*realFScaleNext),intFShiftY+round(
50
*realFScaleNext));
LineTo(intFShiftX-round(
50
*realFScaleNext),intFShiftY+round(
25
*realFScaleNext));
LineTo(intFShiftX+round(
25
*realFScaleNext),intFShiftY-round(
50
*realFScaleNext));
end
;
realFScaleNext:=realFScale;
intFShiftX:=round((Form1
.
ClientWidth-
30
)/
2
+intFPoseX);
intFShiftY:=round((Form1
.
ClientHeight-
185
)/
2
+intFPoseY);
With
Form1
.
PaintBox1
.
Canvas
do
begin
Pen
.
Color:=clrFColorPen;
MoveTo(intFShiftX-round(
25
*realFScale),intFShiftY-round(
50
*realFScale));
LineTo(intFShiftX+round(
50
*realFScale),intFShiftY+round(
25
*realFScale));
LineTo(intFShiftX+round(
25
*realFScale),intFShiftY+round(
50
*realFScale));
LineTo(intFShiftX-round(
50
*realFScale),intFShiftY-round(
25
*realFScale));
LineTo(intFShiftX-round(
25
*realFScale),intFShiftY-round(
50
*realFScale));
MoveTo(intFShiftX+round(
25
*realFScale),intFShiftY-round(
50
*realFScale));
LineTo(intFShiftX+round(
50
*realFScale),intFShiftY-round(
25
*realFScale));
LineTo(intFShiftX-round(
25
*realFScale),intFShiftY+round(
50
*realFScale));
LineTo(intFShiftX-round(
50
*realFScale),intFShiftY+round(
25
*realFScale));
LineTo(intFShiftX+round(
25
*realFScale),intFShiftY-round(
50
*realFScale));
end
;
end
;
procedure
TFigure
.
Displacement;
begin
intFPoseX:=round(intFPositionX*((Form1
.
ClientWidth-
30
-
100
*realFScale)/
60
));
intFPoseY:=round(intFPositionY*((Form1
.
ClientHeight-
185
-
100
*realFScale)/
60
));
intFLastPositionX:=intFPositionX;
intFLastPositionY:=intFPositionY;
end
;
procedure
TForm1
.
FormCreate(Sender: TObject);
begin
objVFigure:=TFigure
.
Create;
objVFigureTwo:=TFigureTwo
.
Create;
end
;
procedure
TForm1
.
PaintBox1Paint(Sender: TObject);
begin
objVFigure
.
Drawing;
objVFigureTwo
.
Drawing;
end
;
procedure
TForm1
.
FormResize(Sender: TObject);
begin
objVFigure
.
Displacement;
objVFigureTwo
.
Displacement;
end
;
procedure
TForm1
.
ScalingClick(Sender: TObject);
begin
if
RadioButton1
.
Checked=
true
then
begin
objVFigure
.
Displacement;
objVFigure
.
Drawing;
objVFigureTwo
.
Drawing;
end
else
begin
objVFigureTwo
.
Displacement;
objVFigureTwo
.
Drawing;
objVFigure
.
Drawing;
end
;
end
;
procedure
TForm1
.
TrackBar1Change(Sender: TObject);
begin
if
Form1
.
RadioButton1
.
Checked=
true
then
begin
objVFigure
.
Displacement;
objVFigure
.
Drawing;
objVFigureTwo
.
Drawing;
end
else
begin
objVFigureTwo
.
Displacement;
objVFigureTwo
.
Drawing;
objVFigure
.
Drawing;
end
;
end
;
procedure
TForm1
.
TrackBar2Change(Sender: TObject);
begin
if
Form1
.
RadioButton1
.
Checked=
true
then
begin
objVFigure
.
Displacement;
objVFigure
.
Drawing;
objVFigureTwo
.
Drawing;
end
else
begin
objVFigureTwo
.
Displacement;
objVFigureTwo
.
Drawing;
objVFigure
.
Drawing;
end
;
end
;
procedure
TForm1
.
RadioButton1Click(Sender: TObject);
begin
Form1
.
ScrollBar1
.
Position:=objVFigure
.
intFPositionX;
Form1
.
ScrollBar2
.
Position:=objVFigure
.
intFPositionY;
end
;
procedure
TForm1
.
RadioButton2Click(Sender: TObject);
begin
Form1
.
ScrollBar1
.
Position:=objVFigureTwo
.
intFPositionX;
Form1
.
ScrollBar2
.
Position:=objVFigureTwo
.
intFPositionY;
end
;
procedure
TForm1
.
ScrollBar1Change(Sender: TObject);
begin
if
Form1
.
RadioButton1
.
Checked=
true
then
begin
objVFigure
.
intFPositionX:=Form1
.
ScrollBar1
.
Position;
objVFigure
.
Displacement;
objVFigure
.
Drawing;
objVFigureTwo
.
Drawing;
end
else
begin
objVFigureTwo
.
intFPositionX:=Form1
.
ScrollBar1
.
Position;
objVFigureTwo
.
Displacement;
objVFigureTwo
.
Drawing;
objVFigure
.
Drawing;
end
;
end
;
procedure
TForm1
.
ScrollBar2Change(Sender: TObject);
begin
begin
if
Form1
.
RadioButton1
.
Checked=
true
then
begin
objVFigure
.
intFPositionY:=Form1
.
ScrollBar2
.
Position;
objVFigure
.
Displacement;
objVFigure
.
Drawing;
objVFigureTwo
.
Drawing;
end
else
begin
objVFigureTwo
.
intFPositionY:=Form1
.
ScrollBar2
.
Position;
objVFigureTwo
.
Displacement;
objVFigureTwo
.
Drawing;
objVFigure
.
Drawing;
end
;
end
;
end
;
end
.