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
| ... / ...
CONST Chemin = 'D:\Virtual_Pascal\Fichiers_VP\Z_Prog_Dev_com\' +
'Insert_Rectangle\';
Npoint = 20; Np1 = Npoint + 1;
TYPE Ve_2E = RECORD x, y: Z_32 END;
Tab_V = ARRAY[0..Np1] OF Ve_2E;
VAR Nuage: Tab_V;
Ve1, Ve2: Ve_2E;
Smax: Z_32;
.../...
FUNCTION TestL(K1, K2, L1, L2: Byte; VAR N_: Tab_V): Bool;
VAR m: Byte; Test, Tx, Ty: Bool;
BEGIN
Test:= True;
FOR m:= 1 TO Npoint DO
BEGIN
Tx:= ((N_[K1].x<N_[m].x) AND (N_[m].x<N_[K2].x));
Ty:= ((N_[L1].y<N_[m].y) AND (N_[m].y<N_[L2].y));
IF (Tx AND Ty) THEN Test:= False
END;
Result:= Test
END;
PROCEDURE Enumeration(VAR N_: Tab_V; VAR W_1, W_2: Ve_2E; VAR S_m: Z_32);
CONST C1 = 4; C2 = C1 + 10; L1 = 53; o = 4;
VAR I1, I2, J1, J2: Byte; Dx, Dy, Smax, Sxy: Z_32;
W1, W2: Ve_2E; Test: Bool;
BEGIN
Smax:= 0; E(0014); Wt(C1, L1, '(I1, J1) = ');
FOR I1:= 0 TO Np1 DO
FOR I2:= 0 TO Np1 DO
IF (N_[I2].x>N_[I1].x) THEN
BEGIN
We(C2, L1, I1, o); Write(I2:o);
Dx:= N_[I2].x - N_[I1].x;
FOR J1:= 0 TO Np1 DO
FOR J2:= 0 TO Np1 DO
IF (N_[J2].y>N_[J1].y) THEN
BEGIN
Test:= TestL(I1, I2, J1, J2, Nuage);
Dy:= N_[J2].y - N_[J1].y;
Sxy:= Dx * Dy;
IF (Test AND (Smax<Sxy)) THEN
BEGIN
Smax:= Sxy;
W1.x:= N_[I1].x; W1.y:= N_[J1].y;
W2.x:= N_[I2].x; W2.y:= N_[J2].y
END
END
END;
W_1:= W1; W_2:= W2; S_m:= Smax
END; |
