Работа с кодом

@pinkiezin · Регистрация: 07.04.2017

Студворк — интернет-сервис помощи студентам

Привет, ребята. Прошу помощи с кодом.

Сам код.

Pascal
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
program q;
uses graphabc,crt;
var
i,j,n,gd,gm,y0,ym,y1,x,x0,xm   : integer;
tt :  string;
a,b  : array[0..2048] of real;
c,c1 : real;
begin
{gd:=detect; nitgraph(gd,gm,' ');}
pen.Color:=clBLACK; 
{setbkcolor(15);}
{============ Information1 ==========}
n:=640 ; y0:=5 ; ym:=200 ; x0:=10 ; xm:=300;
{pen.Width:=(0,0,3: integer)};
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do a[i]:=sin(i/40)+0.5*sin(i/120);
moveto(x0,round(y1+c1*a[0]));
{setlinestyle(0,0,1);}
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*a[i]));
{settextstyle(1,0,3);}
textout(xm+5,ym div 2+2,'t') ; textout(x0+5,y0,'A(t)');
{--------------------------- AM1 ----------------------------------}
n:=640;y0:=225;ym:=420;x0:=10;xm:=300;
{setlinestyle(0,0,3);}
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do b[i]:=(-0.25*a[i]+0.5)*sin(i/2);
moveto(x0,round(y1+c1*b[0]));
{setlinestyle(0,0,1);}
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*b[i]));
{settextstyle(1,0,3);}
textout(xm+5,y1+2,'t') ; textout(x0+5,y0,'S(t)');
{============== Information2 ==============}
n:=640;y0:=5;ym:=200;x0:=330;xm:=610;
{setlinestyle(0,0,3);}
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do a[i]:=sin(i/40)+0.5*sin(i/120);
moveto(x0,round(y1+c1*a[0]));
{setlinestyle(0,0,1);}
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*a[i]));
{settextstyle(1,0,3);}
textout(xm+5,ym div 2+2,'t') ; textout(x0+5,y0,'A(t)');
{----------------------------- AM2 --------------------------------}
n:=640;y0:=225;ym:=420;x0:=330;xm:=620;
{setlinestyle(0,0,3);}
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1) ; line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do b[i]:=(-0.6*a[i]+0.4)*sin(i/2);
moveto(x0,round(y1+c1*b[0]));
{setlinestyle(0,0,1);}
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*b[i]));
{settextstyle(1,0,3);}
textout(xm+5,y1+2,'t') ; textout(x0+5,y0,'S(t)');
readln ; 
{closegraph;}
end.

Нужно переделать пару строчек.

{gd:=detect; nitgraph(gd,gm,' ');} - на нее совсем мыслей нет.
{setbkcolor(15);} - с задним фоном также.
{pen.Width:=(0,0,3: integer)} - здесь пробовал записать в виде setpenWidth(3)
{setlinestyle(0,0,1);} - setpenstyle(dashstyle.DashDotDot);
{settextstyle(1,0,3);} - setfontstyle(fsnormal);
{setlinestyle(0,0,3);} - setpenstyle(dashstyle.DashDotDot);

Не знаю, на сколько мои исправления были верны. Программа запускается, но линии не рисует и отключается.
Думаю проблема в {gd:=detect; nitgraph(gd,gm,' ');} этой строчке, но не знаю что с ней делать.
Подскажите, что делать, пожалуйста.

@Puporev · 22.03.2018, 18:32

Для любого АВС.

Pascal
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
uses graphabc;
var i,j,n,y0,ym,y1,x,x0,xm :integer;
    tt :  string;
    a,b  : array[0..2048] of real;
    c,c1 : real;
begin
{============ Information1 ==========}
n:=640 ; y0:=5 ; ym:=200 ; x0:=10 ; xm:=300;
setpenwidth(3);
setfontsize(10);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do a[i]:=sin(i/40)+0.5*sin(i/120);
moveto(x0,round(y1+c1*a[0]));
setpenwidth(1);
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*a[i]));
textout(xm+5,ym div 2+2,'t') ; textout(x0+5,y0,'A(t)');
{--------------------------- AM1 ----------------------------------}
n:=640;y0:=225;ym:=420;x0:=10;xm:=300;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do b[i]:=(-0.25*a[i]+0.5)*sin(i/2);
moveto(x0,round(y1+c1*b[0]));
setpenwidth(1);
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*b[i]));
textout(xm+5,y1+2,'t') ; textout(x0+5,y0,'S(t)');
{============== Information2 ==============}
n:=640;y0:=5;ym:=200;x0:=330;xm:=610;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do a[i]:=sin(i/40)+0.5*sin(i/120);
moveto(x0,round(y1+c1*a[0]));
setpenwidth(1);
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*a[i]));
setfontsize(10);
textout(xm+5,ym div 2+2,'t') ; textout(x0+5,y0,'A(t)');
{----------------------------- AM2 --------------------------------}
n:=640;y0:=225;ym:=420;x0:=330;xm:=620;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1) ; line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do b[i]:=(-0.6*a[i]+0.4)*sin(i/2);
moveto(x0,round(y1+c1*b[0]));
setpenwidth(1);
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*b[i]));
textout(xm+5,y1+2,'t') ;
textout(x0+5,y0,'S(t)');
end.

@pinkiezin · 22.03.2018, 18:45 **[ТС]**

Спасибо большое. Можете объяснить немного.
setpenwidth(3); - тройка потому что (0, 0, 3) было я так понимаю, да? а если бы там были (1,0,3) как бы они записались?
А остальные строчки вы заменили просто кодом размера шрифта, так?

@Puporev · 22.03.2018, 18:50

setpenwidth(3)-толщина линий 3 пиксела, можно написать 2 или 4, в Турбо Паскале только 1 и 3.
setfontsize(10) - размер шрифта, можно 9 или 11 или какой Вам нужно.

@pinkiezin · 22.03.2018, 19:40 **[ТС]**

Можно еще спросить насчет одного кода?

Pascal
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
uses graphabc,crt;
var
i,j,n,gd,gm,y0,ym,y1,x,x0,xm   : integer;
tt                             : string;
a,b                       : array[0..2048] of real;
c,c1                      : real;
v                         : longint;
begin
{gd:=ega;gm:=egahi; initgraph(gd,gm,'');}
pen.Color:=clblack;setfontsize(10);
v:=0; repeat
if odd(v) then begin
setactivepage(0);setvisualpage(1) end
else begin
setactivepage(1);setvisualpage(0); end;
clearviewport;
{==================== Information =====================}
n:=300;y0:=5;ym:=150;x0:=10;xm:=600;
setlinestyle(0,0,3);y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3;
for i:=0 to n do a[i]:=sin(v/5+i/20);
moveto(x0,round(y1+c1*a[i]));setlinestyle(0,0,1);
c:=(xm-x0)/n;
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*a[i]));
settextstyle(1,0,1);
textout(xm+5,ym div 2+2,'t') ; textout(x0+5,y0,'A(t)');
{--------------------- FM1 -----------------------------}
y0:=175;ym:=340;x0:=10;xm:=600;
setlinestyle(0,0,3);y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3;
for i:=0 to n do b[i]:=sin((2*a[i])+i/3);
moveto(x0,round(y1+c1*b[i]));setlinestyle(0,0,1);
c:=(xm-x0)/n;
for i:=0 to n do 
lineto(x0+(round(i*c)),y1+round(c1*b[i]));
settextstyle(1,0,1);
textout(xm+5,y1+2,'t') ; textout(x0+5,y0,'S(t)');
inc(v);if v>100000 then v:=0;
until keypressed;
{readln;} closegraph;end.

{gd:=ega;gm:=egahi; initgraph(gd,gm,'');} - эту строчку ведь можно убрать?
setactivepage(0);setvisualpage(1) - на какой рабочий код их можно поменять?
setlinestyle(0,0,3) и settextstyle(1,0,1); - можно заменить также setpenwidth(3) этим?

@Puporev · 22.03.2018, 20:05

Сообщение от pinkiezin

etactivepage(0);setvisualpage(1)

Этого в Паскаль АВС нет вообще. Нужно брать условие задачи и писать программу с ноля.

Добавлено через 12 минут
Я посмотрел в Турбо Паскале эту программу, переделаю на АВС, но только скорее всего завтра.

@pinkiezin · 22.03.2018, 20:07 **[ТС]**

Сообщение от Puporev

Этого в Паскаль АВС нет вообще

А можно вместо активных страниц использовать пустую форму?

Pascal
1
myForm:=new Form;

Добавлено через 46 секунд

Сообщение от Puporev

Я посмотрел в Турбо Паскале эту программу, переделаю на АВС, но только скорее всего завтра.

Буду очень сильно благодарен, если у вас получится.

@Puporev · 22.03.2018, 20:27

Да не нужно формы, просто

Pascal
1
2
3
4
5
6
7
8
lockdrawing;
repeat
clearwindow;
//рисуем
//задержка sleep
//меняем значения
redraw;
until false;

Добавлено через 18 минут
Перерисовал.

Pascal
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
uses graphabc;
var
i,j,n,gd,gm,y0,ym,y1,x,x0,xm   : integer;
tt                             : string;
a,b                       : array[0..2048] of real;
c,c1                      : real;
v                         : longint;
begin
{==================== Information =====================}
setfontsize(10);
setpenwidth(3);
v:=0;
repeat
n:=300;y0:=5;ym:=150;x0:=10;xm:=600;
clearwindow;
y1:=y0+(ym-y0) div 2;
setpenwidth(3);
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3;
for i:=0 to n do a[i]:=sin(v/5+i/20);
moveto(x0,round(y1+c1*a[i]));
setpenwidth(1);
c:=(xm-x0)/n;
for i:=0 to n do lineto(x0+(round(i*c)),y1+round(c1*a[i]));
textout(xm+5,ym div 2+2,'t') ; textout(x0+5,y0,'A(t)');
{--------------------- FM1 -----------------------------}
y0:=175;ym:=340;x0:=10;xm:=600;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3;
for i:=0 to n do b[i]:=sin((2*a[i])+i/3);
moveto(x0,round(y1+c1*b[i]));
setpenwidth(1);
c:=(xm-x0)/n;
for i:=0 to n do
lineto(x0+(round(i*c)),y1+round(c1*b[i]));
textout(xm+5,y1+2,'t') ; textout(x0+5,y0,'S(t)');
sleep(50);
inc(v);
if v>100000 then v:=0;
redraw;
until false;
end.

@pinkiezin · 23.03.2018, 17:03 **[ТС]**

Сообщение от Puporev

Перерисовал.

Спасибо огромное за помощь.

Добавлено через 20 часов 32 минуты
Здравствуйте. Можете подсказать по поводу этого кода.

Pascal
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
uses graphabc;
var
i,j,n,gd,gm,y0,ym,y1,x,x0,xm   : integer;
tt                             : string;
a,b                       : array[0..2048] of real;
c,c1,c2,Max               : real;
begin
setfontsize(10);
{==================== Information1 =====================}
n:=1024;y0:=5;ym:=105;x0:=10;xm:=600;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do
b[i]:=sin(i/8){+0.5*sin(i/5)};
moveto(x0,round(y1+c1*b[i]));
setpenwidth(3);
for i:=0 to n do
lineto(x0+(round(i*c)),y1+round(c1*b[i]));
setpenwidth(3);
textout(xm+5,ym div 2+2,'t'); textout(x0+5,y0,'A(t)');
{--------------------- AM1 -----------------------------}
y0:=115;ym:=215;x0:=10;xm:=600;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3;
for i:=0 to n do begin
a[i]:=(-0.45*b[i]+0.5)*sin(pi*i/4);b[i]:=0;
end;
{a[i]:=(-0.45*b[i]+1.0)*sin(pi*i/4)-1.0*cos(pi*i/4-i/8);b[i]:=0;end;}
moveto(x0,round(y1+c1*a[i]));
setpenwidth(3);
c:=(xm-x0)/n;
for i:=0 to n do
lineto(x0+(round(i*c)),y1+round(c1*a[i]));
textout(xm+5,y1+2,'t'); textout(x0+5,y0,'S(t)');
{--------------------- PSD -----------------------------}
y0:=225;ym:=325;x0:=10;xm:=600;c2:=(xm-x0)/10;
setpenwidth(3);
y1:=y0+(ym-y0) div 2;
line(x0,ym+5,xm+5,ym+5);line(x0,y0,x0,ym+5);
setpenwidth(3);
for i:=0 to 10 do begin
x:=x0+round(i*c2);line(x,ym+5,x,ym+10);
str(i,tt);textout(x-2,ym+12,tt);end;
{FFT(N,1,a,b); n1:=N div 2; Max:=1;
For i:=0 to N1 do begin
a[i]:=sqr(a[i])+sqr(b[i]);
if Max<a[i] then Max:=a[i] ; end;
c:=(xm-x0)/n1 ; c1:=(ym-y0)/Max;
moveto(x0,round(y1+c1*a[i]));
setpenwidth(3);
for i:=0 to N1 do
lineto(x0+(round(i*c)),ym-round(c1*a[i]));
textout(xm+25,ym+10,'f'); textout(x0+5,y0,'S(f)');}
readln ;
end.

Код рабочий, только не знаю что делать с этой строчкой:

Pascal
1
2
3
4
5
6
7
8
9
10
{FFT(N,1,a,b); n1:=N div 2; Max:=1;
For i:=0 to N1 do begin
a[i]:=sqr(a[i])+sqr(b[i]);
if Max<a[i] then Max:=a[i] ; end;
c:=(xm-x0)/n1 ; c1:=(ym-y0)/Max;
moveto(x0,round(y1+c1*a[i]));
setpenwidth(3);
for i:=0 to N1 do
lineto(x0+(round(i*c)),ym-round(c1*a[i]));
textout(xm+25,ym+10,'f'); textout(x0+5,y0,'S(f)');}

Остальное исправлял подобно предыдущим кодам.

@Puporev · 23.03.2018, 17:28

Сообщение от pinkiezin

не знаю что делать с этой строчкой:

Нужно найти описание функции FFT. Посмотрите в исходнике на Турбо паскаль.
Если есть полный код на Турбо Паскале, скиньте его, посмотрю что ТП рисует.

@pinkiezin · 23.03.2018, 17:39 **[ТС]**

Есть только исходный код без моих исправлений:

Pascal
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
uses graph,crt,gss_1;
var
i,j,n,gd,gm,y0,ym,y1,x,x0,xm   : integer;
tt                             : string;
a,b                       : array[0..2048] of real;
c,c1,c2,Max               : real;
begin
gd:=ega;gm:=egahi; initgraph(gd,gm,'');
setcolor(1);setbkcolor(15);
{==================== Information1 =====================}
n:=1024;y0:=5;ym:=105;x0:=10;xm:=600;
setlinestyle(0,0,3);y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3 ; c:=(xm-x0)/n;
for i:=0 to n do
b[i]:=sin(i/8){+0.5*sin(i/5)};
moveto(x0,round(y1+c1*b[i]));setlinestyle(0,0,1);
for i:=0 to n do
lineto(x0+(round(i*c)),y1+round(c1*b[i]));
settextstyle(0,0,0);
outtextxy(xm+5,ym div 2+2,'t'); outtextxy(x0+5,y0,'A(t)');
{--------------------- AM1 -----------------------------}
y0:=115;ym:=215;x0:=10;xm:=600;
setlinestyle(0,0,3);y1:=y0+(ym-y0) div 2;
line(x0,y1,xm+5,y1);line(x0,y0,x0,ym);
c1:=(ym-y0)/3;
for i:=0 to n do begin
a[i]:=(-0.45*b[i]+0.5)*sin(pi*i/4);b[i]:=0;end;
{a[i]:=(-0.45*b[i]+1.0)*sin(pi*i/4)-1.0*cos(pi*i/4-i/8);b[i]:=0;end;}
moveto(x0,round(y1+c1*a[i]));setlinestyle(0,0,1);
c:=(xm-x0)/n;
for i:=0 to n do
lineto(x0+(round(i*c)),y1+round(c1*a[i]));
outtextxy(xm+5,y1+2,'t'); outtextxy(x0+5,y0,'S(t)');
{--------------------- PSD -----------------------------}
y0:=225;ym:=325;x0:=10;xm:=600;c2:=(xm-x0)/10;
setlinestyle(0,0,3);y1:=y0+(ym-y0) div 2;
line(x0,ym+5,xm+5,ym+5);line(x0,y0,x0,ym+5);
setlinestyle(0,0,0);
for i:=0 to 10 do begin
x:=x0+round(i*c2);line(x,ym+5,x,ym+10);
str(i,tt);outtextxy(x-2,ym+12,tt);end;
FFT(N,1,a,b); n1:=N div 2; Max:=1;
For i:=0 to N1 do begin
a[i]:=sqr(a[i])+sqr(b[i]);
if Max<a[i] then Max:=a[i] ; end;
c:=(xm-x0)/n1 ; c1:=(ym-y0)/Max;
moveto(x0,round(y1+c1*a[i]));setlinestyle(0,0,1);
for i:=0 to N1 do
lineto(x0+(round(i*c)),ym-round(c1*a[i]));
outtextxy(xm+25,ym+10,'f'); outtextxy(x0+5,y0,'S(f)');
readln ; closegraph;end.

@Puporev · 23.03.2018, 17:43

Но здесь нет никакой функции FFT, где Вы ее взяли?

Добавлено через 1 минуту
Зато здесь есть модуль gss_1, без него программа не будет работать.

@pinkiezin · 23.03.2018, 17:47 **[ТС]**

Сообщение от Puporev

Но здесь нет никакой функции FFT, где Вы ее взяли?

43 строчка же появляется.

Сообщение от Puporev

Зато здесь есть модуль gss_1, без него программа не будет работать.

А ее я просто стер по привычке, но программа работает.

@Puporev · 23.03.2018, 17:52

Программа по коду Турбо Паскаля не работает, просит этот модуль.
А В АВС конечно работает, но не рисут то что написано в этом модуле. Короче если не найдешь модуль, ко мне не приставай.

@Puporev · 23.03.2018, 17:56

В том модуле формируются массивы a,b, размерностью N,что значит 1, не знаю.

@pinkiezin · 04.04.2018, 17:15 **[ТС]**

Помогите найти ошибки из-за которых программа не может запуститься.

Pascal
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
uses graphabc,crt;
const K=33;
abc  : string[K] ='АБВГДЕ`ЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
var
j,n,X0,Xm,Y0,Ym,xx,yy : integer;
ttt: string;
ch                            : char;
Max                           : longint;
c,ss,En,Enm,P                 : real;
txt                           : text;
dd                : array[0..256] of longint;
begin
clrscr ; 
For var r:=1 to K do dd[r]:=0;
Write('Enter File Name ?  ') ; 
Readln(ttt);
assign(txt,ttt) ; 
Reset(txt);
j:=0 ; 
repeat read(txt,ch) ; 
write(ch);
case ch of
'А','а' : inc(dd[1]) ;
'Б','б' : inc(dd[2]) ;
'В','в' : inc(dd[3]) ;
'Г','г' : inc(dd[4]) ;
'Д','д' : inc(dd[5]) ;
'Е','е' : inc(dd[6]) ;
'~','`' : inc(dd[7]) ;
'Ж','ж' : inc(dd[8]) ;
'З','з' : inc(dd[9]) ;
'И','и' : inc(dd[10]);
'Й','й' : inc(dd[11]);
'К','к' : inc(dd[12]);
'Л','л' : inc(dd[13]);
'М','м' : inc(dd[14]);
'Н','н' : inc(dd[15]);
'О','о' : inc(dd[16]);
'П','п' : inc(dd[17]);
'Р','р' : inc(dd[18]);
'С','с' : inc(dd[19]);
'Т','т' : inc(dd[20]);
'У','у' : inc(dd[21]);
'Ф','ф' : inc(dd[22]);
'Х','х' : inc(dd[23]);
'Ц','ц' : inc(dd[24]);
'Ч','ч' : inc(dd[25]);
'Ш','ш' : inc(dd[26]);
'Щ','щ' : inc(dd[27]);
'Ъ','ъ' : inc(dd[28]);
'Ы','ы' : inc(dd[29]);
'Ь','ь' : inc(dd[30]);
'Э','э' : inc(dd[31]);
'Ю','ю' : inc(dd[32]);
'Я','я' : inc(dd[33]);
end ;  
if ord(ch)>14 then inc(j) ;
until Eof(txt);
N:=j ; 
readln ; 
Max:=1;
For var r:=1 to K do if Max<dd[r] then Max:=dd[r];
{================= Distribution ================}
X0:=5;Xm:=630;Y0:=15;Ym:=280;
c:=(Ym-Y0)/Max;
setfontsize(3);
setpenwidth(10);
setpenstyle(dashstyle.DashDotDot);
Line(X0,Ym+5,Xm,Ym+5);
write(0,0,3);
For var r:=1 to K do begin;
xx:=x0+r*18 ; 
yy:=ym-round(c*dd[r]);
line(xx,ym,xx,yy);
writeln(r,'ttt');
textout(xx-4,ym+10,ttt);
textout(xx-4,yy-15,abc[r]); 
end;
{================ Entropy ================}
SS:=0 ; 
For var r:=1 to K do SS:=SS+dd[r];
For var r:=1 to K do begin P:=dd[r]/SS;
if P>1e-16 then En:=En-P*ln(P)/ln(2);
end; 
setpenwidth(3);
writeln(En:8:5,'ttt');
textout(1,ym+30,'Entropy = '+ttt);
Enm:=ln(K)/ln(2);
writeln(Enm:8:5,'ttt');
textout(250,ym+30,'Entropy max = '+ttt);
writeln(N:5,'ttt');
textout(500,ym+30,'N = '+ttt);
SS:=100*(Enm-En)/Enm;
writeln(SS:8:5,'ttt');
textout(1,ym+45,'Surplus = '+ttt+' %');
readkey ;
end.

@Puporev · 04.04.2018, 18:01

А зачем Вы в программу для простого АВС всунули код на Паскаль АВС.net?

Новые блоги и статьи Все статьи Все блоги /
Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .	модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .
Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ	Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .	Использование значений реквизитов справочника в документе, с определенными условиями и правами Maks 07.04.2026 1. Контроль срока действия договора Алгоритм из решения ниже реализован на примере нетипового документа "ЗаявкаНаРаботу", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если. . .

Работа с кодом

Решение

Решение

Решение

@pinkiezin 1 / 1 / 0 Регистрация: 07.04.2017 Сообщений: 34
	22.03.2018, 18:45 [ТС]
	Спасибо большое. Можете объяснить немного. setpenwidth(3); - тройка потому что (0, 0, 3) было я так понимаю, да? а если бы там были (1,0,3) как бы они записались? А остальные строчки вы заменили просто кодом размера шрифта, так? 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	22.03.2018, 18:50
	Сообщение было отмечено ZX Spectrum-128 как решение Решение setpenwidth(3)-толщина линий 3 пиксела, можно написать 2 или 4, в Турбо Паскале только 1 и 3. setfontsize(10) - размер шрифта, можно 9 или 11 или какой Вам нужно. 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	23.03.2018, 17:43
	Но здесь нет никакой функции FFT, где Вы ее взяли? Добавлено через 1 минуту Зато здесь есть модуль gss_1, без него программа не будет работать. 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	23.03.2018, 17:52
	Программа по коду Турбо Паскаля не работает, просит этот модуль. А В АВС конечно работает, но не рисут то что написано в этом модуле. Короче если не найдешь модуль, ко мне не приставай. Миниатюры 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	23.03.2018, 17:56
	В том модуле формируются массивы a,b, размерностью N,что значит 1, не знаю. 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	04.04.2018, 18:01
	А зачем Вы в программу для простого АВС всунули код на Паскаль АВС.net? 0