Pascal — Говнокод.ру

Pascal / Говнокод #9439

+87

01
02
03
04
05
06
07
08
09
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

var
x,y,R:real;
l11,l12,l1,l21,l22,l2,l3,l41,l42,l4,l51,l52,l5,l6,l71,l72,l7:boolean;
begin
x:= StrToFloat(edit1.text);
y:= StrToFloat(edit2.text);
R:=StrToFloat(edit3.text);
l11:=(y<x) and (x*x+y*y<R*R) and (y>0);
l12:=(x*x+y*y<r*r) and (x<0)and (y>0);
l1:=l11 or l12;
l21:=(y>0) and (x*x+y*y<R*R)and (y>x);
l22:= ( x*x+y*y<R*R)and (y>x) and (x<0);
l2:= l21 or l22;
l3:=(y<0) and ( x*x+y*y<R*R)and (y>x);
l41:= (x>0) and ( x*x+y*y<R*R)and (y<x);
l42:= (x<-1) and ( x*x+y*y>R*R)and (y>x);
l4:= l41 or l42;
l51:= (x>1) and ( x*x+y*y>R*R)and (y<x);
l52:= (x>-1) and ( x*x+y*y>R*R)and (y<x);
l5:= l51 or l52;
l6:= (y>0) and ( x*x+y*y<R*R)and (y>x);
l71:= (x>0) and (x*x+y*y>R*R) and (y<0);
l72:= (y<0) and (x*x+y*y>R*R) and (y<x) and (x<0);
l7:= l71 or l72;
if l1= true then
begin
edit4.text:='T принадлежит 1 области';
end
else
begin
edit4.text:='T не принадлежит 1 области';
end;
if l2= true then
begin
edit4.text:='T принадлежит 2 области';
end
else
begin
edit4.text:='T не принадлежит 2 области'
end;
if l3= true then
begin
edit4.text:='T принадлежит 3 области'
end
else
begin
edit4.text:='T не принадлежит 3 области'
end;
if l4= true then
begin
edit4.text:='T принадлежит 4 области'
end
else
begin
edit4.text:='T не принадлежит 4 области'
end;
if l5= true then
begin
edit4.text:='T принадлежит 5 области'
end
else
begin
edit4.text:='T не принадлежит 5 области'
end;
if l6= true then
begin
edit4.text:='T принадлежит 6 области'
end
else
begin
edit4.text:='T не принадлежит 6 области'
end;
if l4= true then
begin
edit4.text:='T принадлежит 7 области'
end
else
begin
edit4.text:='T не принадлежит 7 области'
end;
end;

end.

...

Cyanide, 15 Февраля 2012

Комментарии (12)

Pascal / Говнокод #9430

+88

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

var A:array of record
  Foo: integer;
end;

function NewNode: integer;
begin
  SetLength(A, Length(A)+1);
  Result := High(A);
  // возвращаем не указатель на последний элемент,
  // а номер последнего элемента, потому что массив динамический и указатели нестабильны
end;

procedure DoSmth(var i: integer);
var
  n1,n2: integer;
begin
  n1 := NewNode;
  n2 := NewNode;
  // дальше что-то проделывааем над A[n1] и A[n2]
  i := A[n1].Foo + A[n2].Foo;
end;

var
  NewIndex: integer;
begin
  NewIndex := NewNode;
  DoSmth(A[NewIndex].Foo);
end.

Угадайте, почему это не будет работать и приведёт к порче памяти.

TarasB, 15 Февраля 2012

Комментарии (20)

Pascal / Говнокод #9324

+83

1
2
3

symb("4")begin Хочешь узнать кто посещал твою страницу end; http://reserpo.my1.ru/index.html?opi=!random!

$#4629447380677#$

Кривой спамбот на паскале кривоспамит в пабликах

ReckO, 05 Февраля 2012

Комментарии (2)

Pascal / Говнокод #9315

+91

01
02
03
04
05
06
07
08
09
10
11
12
13

if IsThemeActive then
begin
  ThemePartName := 'TAB';
  ThemeHandle := OpenThemeData(TabSheetQA.Handle, PWideChar(ThemePartName));
  if ThemeHandle <> 0 then
  begin
    ImageClipRect := ImageForBkColorRecalc.ClientRect;
    DrawThemeBackground(ThemeHandle, ImageForBkColorRecalc.Canvas.Handle,
      TABP_BODY, 0, ImageForBkColorRecalc.ClientRect, @ImageClipRect);
    BkColor := ImageForBkColorRecalc.Canvas.Pixels[0, 0];
  end;
  Exit;
end;

Надыбано в компоненте Delphi. Код получает начальный цвет градиента панелей Таб-контрола при включенных стилях XP и Aero. Для этого рисует на скрытом TImage его небольшой фрагмент и выдирает угловой пиксель.

Durik, 03 Февраля 2012

Комментарии (6)

Pascal / Говнокод #9266

+94

01
02
03
04
05
06
07
08
09
10
11
12

for k:=1 to 5 do begin
new (z2);
z2^.pole1:=k;
z2^.pole2:=z1;
z1:=z2;
end;

for k:=1 to 5 do begin
z2^.pole3:=z1;
z1:=z2;
z2:=z2^.pole2;
end;

Вот так в нашем универе учат создавать двунаправленые массивы. Код кстати не только принципиально индусский, но еще и не рабочий.

Tairesh, 31 Января 2012

Комментарии (5)

Pascal / Говнокод #9229

+95

1
2
3
4
5

procedure TEditor.cbReverseClick(Sender: TObject);
begin
  T.Reversed := not T.Reversed;
  Show;
end;

Вместо
T.Reversed := cbReverse.Checked;
Интересно, может ли это создать баг?

TarasB, 26 Января 2012

Комментарии (22)

Pascal / Говнокод #9180

+107

01
02
03
04
05
06
07
08
09
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

begin
writeln('Enter 1st number');
readln(a);
writeln('Enter 2st number');
readln(b);
writeln('Enter 3st number');
readln(c);

if a = b then if a = c then if b = c then       ;
writeln('numbers are');

if a > b then if a = c then if b < c then
writeln('a Equally c and it is more b')         ;

if a = b then if a > c then if b > c then
writeln('a Equally b and it is more c')         ;

if a < b then if a < c then if b = c then
writeln('b Equally c and it is more a')         ;

if a > b then if a > c then if b > c then
writeln('a it is more ')                        ;
if a > b then if a > c then if b < c then
writeln('a it is more ')                        ;
if a > b then if a > c then if b = c then
writeln('a it is more ')                        ;

if a < b then if a = c then if b > c then
writeln('b it is more ')                        ;
if a < b then if a > c then if b > c then
writeln('b it is more ')                        ;
if a < b then if a < c then if b > c then
writeln('b it is more ')                        ;

if a = b then if a < c then if b < c then
writeln('c it is more ')                        ;
if a > b then if a < c then if b < c then
writeln('c it is more ')                        ;
if a < b then if a < c then if b < c then
writeln('c it is more ')                        ;

Такое выдал один из моих учеников в 10м классе после того, как отказался учится рисовать блок-схемы и сказал, что сразу сможет писать. Задание заключалось в том, чтобы программа выводила большее из 3х введенных пользователем чисел.

Rage, 20 Января 2012

Комментарии (55)

Pascal / Говнокод #9156

+141

1
2
3
4
5
6
7

// строка добавлена, чтобы сраный парсер говнокода не сжирал пробелы, этого в коде не было
              end;
            end;
          end;
        end;
      end;
    end;

Увидел в своём коде.
Очень сложный алгоритм.

TarasB, 18 Января 2012

Комментарии (35)

Pascal / Говнокод #9101

+84

01
02
03
04
05
06
07
08
09
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

{$N+}
const
n=5;
n2=2*n;
type tRow=array[1..n] of 0..1;
rRow=array[1..n] of 0..1;
type tMatrix=array[1..n,1..n2] of double;
wMatrix=array[1..n,1..n2] of double;
procedure NewMatrix(var a: tMatrix; n,n2: word; x: double);           var           i,j: word;
          begin
          randomize;
          for i:=1 to n do
          for j:=1 to n2 do
              a[i,j]:=-2*x+random(Round(4*x));
          end;
procedure ProcMatrix(var a: tMatrix; n,n2: word; x: double; var b: tRow);          var          i,j: word;
          begin
          for i:=1 to n do
          for j:=1 to n2 do
              if a[i,j]<=x then b[i]:=1 else
                 begin
                 b[i]:=0;
                 break;
                 end;
          end;
procedure WriteMatrix(var a: tMatrix; n,n2: word);          var          i,j: word;
          begin
          for i:=1 to n do
              begin
              for j:=1 to n2 do write(a[i,j]:6:2);
              writeln('');
              end;
          end;
procedure WriteRow(var b: tRow; n: word);          var          i: word;
          begin
          for i:=1 to n do write(b[i]:2);
          writeln('');
          end;
 procedure NewMatrix1(var q: wMatrix; n,n2: word; x: double);          var          i,j: word;
          begin
          randomize;
          for i:=1 to n do
          for j:=1 to n2 do
              q[i,j]:=-1.1*x+random(Round(4*x));
          end;
procedure ProcMatrix1(var q: wMatrix; n,n2: word; x: double; var e: rRow);          var          i,j: word;
          begin
          for i:=1 to n do
          for j:=1 to n2 do
              if q[i,j]<=x then e[i]:=1 else
                 begin
                 e[i]:=0;
                 break;
                 end;
          end;
procedure WriteMatrix1(var q: wMatrix; n,n2: word);          var          i,j: word;
          begin
          for i:=1 to n do
              begin
              for j:=1 to n2 do write(q[i,j]:6:2);
              writeln('');
              end;
          end;
procedure WriteRow1(var e: rRow; n: word);          var          i: word;
          begin
          for i:=1 to n do write(e[i]:2);
          writeln('');
          end;
var
bRow: tRow;
eRow: rRow;
aMatrix: tMatrix;
qMatrix: wMatrix;
x: double;
begin
write('‚ўҐ¤ЁвҐ ўҐйҐбвўҐ®Ґ зЁб«® е: ');
readln(x);
NewMatrix(aMatrix,n,n2,x);
writeln('Њ ваЁж  ',n,'x',n2,' жҐ«ле зЁбҐ« бд®а¬Ёа®ў    ўв®¬ вЁзҐбЄЁ:');
WriteMatrix(aMatrix,n,n2);
NewMatrix1(qMatrix,n,n2,x);
writeln('Њ ваЁж  ',n,'x',n2,' жҐ«ле зЁбҐ« бд®а¬Ёа®ў    ўв®¬ вЁзҐбЄЁ:');
WriteMatrix1(qMatrix,n,n2);
ProcMatrix(aMatrix,n,n2,x,bRow);
writeln('Њ ваЁж  ®Ўа Ў®в  . Џ®б«Ґ¤®ў вҐ«м®бвм b[1]..b[',n,'] бд®а¬г«Ёа®ў  ');
WriteRow(bRow,n);
ProcMatrix1(qMatrix,n,n2,x,eRow);
writeln('Њ ваЁж  ®Ўа Ў®в  . Џ®б«Ґ¤®ў вҐ«м®бвм b[1]..b[',n,'] бд®а¬г«Ёа®ў  ');
WriteRow1(eRow,n);
writeln('Ќ ¦¬ЁвҐ ENTER');
readln;
end.

Процедуры.
Даны натуральное число n, действительное число x и две действительные матрицы размера nx2n. Получить последовательность b1,..., bn из нулей и единиц, где bi =1, если элементы i-ой строки матрицы не превосходят x и bi =0 в противном случае.

siszzz, 12 Января 2012

Комментарии (11)

Pascal / Говнокод #9072

+81

01
02
03
04
05
06
07
08
09
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

{ ... }
  writeln('vvedite indexi "X" i "=" 1-ogo uravneniay');
  writeln('x1');
  readln(x11);
  writeln('x2');
  readln(x12);
  writeln('x3');
  readln(x13);
  writeln('x4');
  readln(x14);
  writeln('=');
  readln(x15);
  writeln('vvedite indexi "X" i "=" 2-ogo uravneniay');
  writeln('x1');
  readln(x21);
  writeln('x2');
  readln(x22);
  writeln('x3');
  readln(x23);
  writeln('x4');
  readln(x24);
  writeln('=');
  readln(x25);
  writeln('vvedite indexi "X" i "=" 3-ogo uravneniay');
  writeln('x1');
  readln(x31);
  writeln('x2');
  readln(x32);
  writeln('x3');
  readln(x33);
  writeln('x4');
  readln(x34);
  writeln('=');
  readln(x35);
  writeln('vvedite indexi "X" i "=" 4-ogo uravneniay');
  writeln('x1');
  readln(x41);
  writeln('x2');
  readln(x42);
  writeln('x3');
  readln(x43);
  writeln('x4');
  readln(x44);
  writeln('=');
  readln(x45);
  {веселье - вот зачем это все нужно было))}
  m2[1,1]:=x11;
  m2[1,2]:=x12;
  m2[1,3]:=x13;
  m2[1,4]:=x14;
  m2[2,1]:=x21;
  m2[2,2]:=x22;
  m2[2,3]:=x23;
  m2[2,4]:=x24;
  m2[3,1]:=x31;
  m2[3,2]:=x32;
  m2[3,3]:=x33;
  m2[3,4]:=x34;
  m2[4,1]:=x41;
  m2[4,2]:=x42;
  m2[4,3]:=x43;
  m2[4,4]:=x44;
{ ... }

Классика ввода матриц. Опять. С киберфорума. http://www.cyberforum.ru/turbo-pascal/thread425906.html#post2374414

HighPredator, 10 Января 2012

Комментарии (10)

Говнокод: по колено в коде.