1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
| Program Geolog_Engine;
Uses CRT, GraphABC;
Type Proba=record
X:real;
Y:real;
Concent:real;
Lirics:string
end;
Var
I,N,Y1,Y2,X1,X2,Imax,Imin,Ymax,Xmax:integer;
Ky,Kx,MinA,MaxA,R,S:real;
K,K1,PopravkaX,PopravkaY,Color:integer;
A:array [1..30,1..3] of real;
Data:array [1..30] of Proba;
Number1,Number:char;
Name,Nazvanie,Stroka:string;
F:text;
//==============================================================================
Procedure Entering;
var i:integer;
Begin
Clrscr;
WriteLn('Введите количество результатов опробования:');
Read(N);
For I:=1 to N do
Begin
WriteLn('Введите координату по оси Х для ',I,'-й пробы:');
Read(A[I,1]);
WriteLn('Введите координату по оси Y для ',I,'-й пробы:');
Read(A[I,2]);
End;
WriteLn('Ввод данных завершён. Для продолжения нажмите любую клавишу...');
Read();
End;
//==============================================================================
Procedure Dislocation;
var i:integer;
Begin
Clrscr;
PopravkaX:=40;
PopravkaY:=40;
Rectangle(40,40,440,400);//площадь обследования
For I:=1 to N Do
Begin
if A[I,1]>Xmax Then Xmax:=Round(A[I,1]);
If A[I,2]>Ymax Then Ymax:=Round(A[I,2]);
End;
If Ymax>Xmax Then Xmax:=Ymax
Else Ymax:=Xmax;
Ky:=400/(Ymax+2);
Kx:=400/(Xmax+2);
PopravkaX:=40;
PopravkaY:=40;
TextOut(400,400,IntToStr(Xmax+1));
SetPenStyle(psDot);
For I:=1 to Xmax+1 Do
Begin
Line(I*Round(Kx)+PopravkaX,40,I*Round(Kx)+PopravkaX,400);
Line(40,(400-Round(I*Ky)),400+PopravkaX,(400-Round(I*Ky)));
TextOut(I*Round(Kx)+PopravkaX,405,IntToStr(I));
TextOut(25,(400-Round(I*Ky)),IntToStr(I));
End;
SetPenStyle(psSolid);
Line(40,40,400,40);
For I:=1 to N
Do
Begin
TextOut(Round(A[I,1]*Kx+PopravkaX),Round(400-A[I,2]*Ky),IntToStr(I));
TextOut(Round(A[I,1]*Kx)+PopravkaX,400,FloatToStr(A[I,1]));
TextOut(25,Round(400-A[I,2]*Ky),FloatToStr(A[I,2]));
Circle(Round(A[I,1]*Kx)+PopravkaX,Round(400-A[I,2]*Ky),5);
FloodFill(Round(A[I,1]*Kx)+PopravkaX,Round(400-A[I,2]*Ky),clRed);
End;
TextOut(40,450,'Схема расположения проб на площади опробования. Для продолжения нажмите любую клавишу...');
Readln;
SetBrushColor(clWhite);
FillRect(0,0,1000,500);
readln;
End;
//==============================================================================
BEGIN
CenterWindow;
SetWindowSize(1000,500);
Repeat
Clrscr;
Writeln('1. Ввод');
Writeln('2. Расположение проб на площади опробования');
Writeln;
Writeln('0. BbIXOД');
Write('Выберите нужный пункт: ');
Read(Number);
//==============================================================================
Case Number of
'1': Entering;
'2': Dislocation;
End;
Until Number='0';
END. |
(
