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

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

+115

1
2
3
4
5
6
7
8
9

Function isEQ(x,y : Real) : Boolean;
Begin
if(x = y) Then isEQ := True Else isEQ := False;
End;


Begin
{...}
End.

Не выспался...

x0wl, 18 Июля 2010

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

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

+97

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

procedure TStdMessageInfo.Build(pMessage: String; pKind: Integer);
var List: TStringList;
begin
  List := TStringList.Create;
  try {!!! это такой хитрый способ заменить #13 на #13#10}
    List.Text := pMessage;
    if List.Count = 1 then FMessage := List[0]
    else FMessage := List.Text;
  finally
    List.Free;
  end;
  FKind := pKind;
end;

borka, 16 Июля 2010

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

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

+97

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

{
----------------------8<----------------------
Цей юніт призначений лише для використання
разом із пакетом програм ███████
будь-якої версії.
Він не може розповсюджуватися окремо, так
як являється частиною пакету, який може
розповсюджуватися на платній основі.

(С) Copyright ███████████████
----------------------8<----------------------
}

(* ~15 строк поскипано за унылостью *)

procedure TranslateForm(var form:TObject; const LNGFile:String);
var
ini:TIniW;
c1,c2,p1,p2,i:Integer;
Sct,par,val:string;
keys:TStringList;
cobg:TObject;
comp:TComponent;
begin
  initini(ini,LNGFile);
  keys:=TStringList.Create;
  sct:=Trim((form as TForm).Name);
    c1:=ini.KeyCount(Sct);
    ini.ReadSection(Sct,keys);
    cobg:=(form as TObject);
    for I := 0 to c1-1 do
    begin
      par:=keys[I];
      p1:=Pos('=',par);
      par:=Trim(Copy(par,0,p1-1));
      val:=ini.ReadString(Sct,par,'read error');
      typinfo.SetStrProp(cobg,par,val);
    end;
    c2:=(form as TForm).ComponentCount;
    for p2 := 0 to c2 - 1 do
      begin
      comp:=(form as TForm).Components[p2];
        cobg:=(comp as TObject);
        sct:=typinfo.GetStrProp(cobg,'Name');

          c1:=ini.KeyCount(Sct);
          if c1>0 then
          ini.ReadSection(Sct,keys);
            for I := 0 to c1-1 do
            begin
              par:=keys[I];
              p1:=Pos('=',par);
              par:=Trim(Copy(par,0,p1-1));
              val:=ini.ReadString(Sct,par,'read error');
              try
              typinfo.SetStrProp(cobg,par,val);
              except

              end;
            end;

      end;
end;


end.

Сверху - жадность, снизу - отсутствие скиллов.

bugmenot, 16 Июля 2010

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

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

+102

1
2
3
4
5
6
7

case dlg.sort.ItemIndex of
         0: Qry.SQL.Add('ORDER BY b.nn_rez;');
         1: if dlg.view.ItemIndex=1 then Qry.SQL.Add('ORDER BY c.prod_code;')
                                                 else Qry.SQL.Add('ORDER BY c.kod_okp;');
         2: if dlg.view.ItemIndex=1 then Qry.SQL.Add('ORDER BY c.res_name;')
                                                 else Qry.SQL.Add('ORDER BY c.naimres;');
     end;

Твой кролик писал!
кто-то явно мастер на выдумки

Grizzly, 23 Июня 2010

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

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

+85

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100

program Project2;

{$APPTYPE CONSOLE}

{#1.Ввести последовательность натуральных чисел. Если в последовательности есть
простые числа, упорядочить последовательность по неубыванию суммы цифр.
В противном случае удалить из последовательности числа с нечетным количеством
цифр и продублировать 4-хзначные числа. Последовательность хранить в
односвязном списке. Перед завершением программы очистить динамическую память с
помощью процедуры Dispose.}

uses
  SysUtils;

type
  adres=^Element;
  element=
           RECORD
  body:integer; next:adres; end;

Var n,i:integer;
    dub,nov,t,first,p,p0:adres;
    pred:adres;
    a:integer;
    pr:boolean;


    function sum(a:integer):integer;
    var i,s:integer;
    begin
    s:=0;
    while a<>0 do begin
    inc(s,a mod 10);
    a:=a div 10;
    end;
    sum:=s;
    end;



 function prostoe(a:integer):boolean;
 var i:integer;
 p:boolean;
 begin
 a:=abs(a);
 p:=true;
 for i:=2 to trunc(sqrt(a)) do
 if a mod i=0 then begin p:=false; break;  end;
 prostoe:=p;
 if a=1 then prostoe:=false;
 end;



BEGIN
 pr:=false;
 reset(input,'input.txt');
 rewrite(output,'output.txt');
 first:=NIL;
 while not seekeof do begin
 read(a);
 new(p);
 p^.body:=a;
 if first=nil then first:=p else p0^.next:=p;
 p0:=p;
 end;

 p:=first;
 while p<>nil do begin
 if prostoe(p^.body)  then pr:=true;
 p:=p^.next;
 end;

if not pr then begin
  p:=first;
if (length(inttostr(p.body)) mod 2<>0) then first:=p.next;
  p:=first;
while p<>nil do
begin
if (p.next <> nil) and (length(inttostr(p.next^.body)) mod 2<>0) then
begin
T:=p.next;
p.next:=T.next;
Dispose(T);
end
else p:=p.next;
end;


  p:=first;
while p<>nil do
begin
if (p <> nil) and (length(inttostr(p.body))=4) then
      begin
        new(dub);
        dub.body:=p.body;
        dub.next:=p.next;
        p.next:=dub;
p:=p.next.next;
      end

basic, 14 Июня 2010

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

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

+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
84
85
86
87
88
89
90
91
92
93
94
95

program lab_16;
 {$APPTYPE CONSOLE}
 uses
  windows,
  SysUtils;
 {#1. Дана строка, содержащая русский текст.
 Если в тексте нет слов-палиндромов длиной более 1-й буквы,
 то вывести слова текста в    соответствии с убыванием количества согласных,
 в противном    случае пpодублиpовать в словах текста гласные буквы и вывести
  полученные слова в поpядке, обpатном к алфавитному.}
  const nmax=100;
  Alf = ['А'..'Я','а'..'я'];
  rulett3 = ['А', 'Е', 'Ё', 'И', 'О', 'У', 'Ы', 'Э', 'Ю', 'Я', 'а', 'е', 'ё', 'и', 'о', 'у', 'ы', 'э', 'ю', 'я'];
 type Mas_slov=array[1..nmax] of string;

 procedure vvod(var a : Mas_slov; var n : integer);
 var stroka,str:string;
     i : integer;
 begin
      reset(input,'input.txt');
      read(stroka);
      str:='';
      n:=0;
      stroka:=stroka+' ';
      for i:=1 to length(stroka) do
       if stroka[i] in Alf then str:=str+stroka[i]
       else if str<>'' then begin
             inc(n);
             a[n]:=str;
             str:='';
       end;
 end;

 function kolsog(x:string):integer;    {фунция нахождения кол-ва согл букв}
 var k,j,z:integer;
  begin
    z:=0;
    for k:=1 to length(x) do
    if not (x[k] in rulett3) then inc(z);
    kolsog:=z;
  end;

 function palin(x:string):boolean;     {проверка на палиндром}
 var z,i:integer;
 begin
    palin:=false;
    z:=0;
    for i:=1 to length(x) do
    if x[i]=x[length(x)+1-i] then z:=z+1;
  if z=length(x) then palin:=true;
 end;

 function prov(a : Mas_slov; n : integer):boolean;
 var i,j:integer;
 begin
 prov:=false;
 for i:=1 to n do
 if (length(a[i])>1) and (palin(a[i])=true) then prov:=true;
 end;

 procedure sort(var a:mas_slov; n: integer);
 var i,j:integer;
      st:string;
 begin
  for i:=1 to n-1 do
 for j:=i+1 to n do
 if kolsog(a[i])< kolsog(a[j]) then
 begin   st:=a[i]; a[i]:=a[j]; a[j]:=st; end;
 end;

 function dubl(x:string):string;  {дублирование гласных букв}
 var q:integer;
 begin
 q:=1;
 while q<>length(x)+1 do  begin
 if (x[q] in rulett3) then begin Insert(x[q],x,q); inc(q,2)end else inc(q); end;
 dubl:=x;
 end;

 procedure dubl2(var a:mas_slov; n:integer);
 var i:integer;
 begin
 for i:=1 to n do
 a[i]:=dubl(a[i]);
 end;

 procedure sort2(var a:mas_slov; n: integer);
 var i,j:integer;
      st:string;
 begin
    for i:=1 to n-1 do
    for j:=i+1 to n do
    if a[i]<a[j] then
    begin st:=a[i]; a[i]:=a[j]; a[j]:=st; end;
 end;

basic, 14 Июня 2010

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

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

+103

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

program lab15;
 uses crt;
 const nmax=100;
 var z,i,j,k,n,m:integer;
     pr:boolean;
     stolb:boolean;
 sum:array[1..nmax] of integer;
 A:array[1..nmax,1..nmax] of integer;

 procedure swap(var a,b:integer);
 var c:integer;
 begin
 c:=0;
 c:=a;
 a:=b;
 b:=c;
 end;

 function prostoe(x:integer):boolean;
 var i:integer;
     p:boolean;
     begin
 x:=abs(x);
 p:=false;
 if x>1 then p:=true;
 for i:=2 to x-1 do
 if x mod i=0 then p:=false;
 prostoe:=p
 end;


 begin
 z:=0;
 stolb:=false;
 pr:=false;
   clrscr;
    write('n= ');
    readln(n);
    write('m= ');
    readln(m);
    for i:=1 to n do
      for j:=1 to m do
        read(A[i,j]);
    for i:=1 to n do
    sum[i]:=0;
    for i:=1 to n do
     for j:=1 to m do
       sum[i]:=sum[i]+abs(a[i,j]);
         for i:=1 to n do
          for j:=1 to m do
           if prostoe(a[i,j])=true then pr:=true;

         for i:=1 to m-1 do
         begin
           for j:=i+1 to m do
           begin
           z:=0;
            for k:=1 to n do
             begin
               if a[k,i]=a[k,j] then z:=z+1;
               if z=n then stolb:=true;
             end;
           end;
         end;

            if (pr=true) and (stolb=true) then
            begin
               for i:=1 to n-1 do
               for j:=i+1 to n  do
                 if sum[i]>sum[j] then begin
                 swap(sum[i],sum[j]);
                 for k:=1 to m do
                   swap(a[i,k],a[j,k]);
                 end;
            end;

  writeln('stolbec= ', stolb);
  writeln('prostoe= ', pr);

  for i:=1 to n do
  begin
  writeln;
  for j:=1 to m do
  write(a[i,j], ' ');
  end;
    readkey;
    end.

basic, 14 Июня 2010

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

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

+99

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

procedure TCommonFineEdit.SetTopControls;
begin
  if beSummHist.Visible then
    SummEdit.Width := 92
  else
    SummEdit.Width := 108;
  if VarToInt(Oper.OperationType) in [otFine, otNoAgreeFine, otPayFine, otPayFineCorrect] then
    begin
      NameEdit.Top := 16;
      Label1.Top := NameEdit.Top+3;
      PODateEdit.Top := 47;
      AccountDateJvDateEdit.Top := PODateEdit.Top;
      label3.Top := PODateEdit.Top+3;
      lPODate.Top := PODateEdit.Top+3;
      beSummHist.Top := 77;
      SummEdit.Top := 78;
      POSummEdit.Top := SummEdit.Top;
      label12.Top := SummEdit.Top+3;
      lPOSumm.Top := SummEdit.Top+3;
      StateComboBox.Top := 109;
      label4.Top := StateComboBox.Top+3;
      InspectNameEdit.Top := 140;
      InspectNameLabel.Top := InspectNameEdit.Top+3;
      CommentEdit.Top := 171;
      label2.Top := CommentEdit.Top+3;
      if ftSale then
      begin
        RateNameEdit.Top := 202;
        lRate.Top := RateNameEdit.Top+3;
        BasePriceEdit.Top := 233;
        PaySummMoneyEdit.Top := BasePriceEdit.Top;
        lMoney.Top := BasePriceEdit.Top+3;
        lBasePrice.Top := BasePriceEdit.Top+3;
        Height := 368;
      end else
        Height := 310;
    end
...

Umak, 11 Июня 2010

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

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

+112

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17

procedure TForm1.btn_enterClick(Sender: TObject);
begin
  //blalbla
  if someInput.text='0' then
  begin
    //blabla
  end;
  if someInput.text='0.0' then
  begin
    //blabla
  end;
  if someInput.text='0.00' then
  begin
    //blabla
  end;
  //blalbla
end;

Мне когда-то одногруппник показал такой код.
- А если там будет '0.0000'? - спросил я
- Этот случай я не прорабатывал, люди так вводить не будут

J0hnny, 10 Июня 2010

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

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

+90

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

procedure TForm1.registration;
var
reg:TRegistry;
i,lbc:integer;
aentsys,alawarkey:boolean;
const
dw:DWORD =1800000;
begin
  reg:=TRegistry.Create;
  reg.RootKey:=HKEY_CURRENT_USER;
  aentsys:= reg.KeyExists('software\Aent Sys');

  alawarkey:=reg.KeyExists('software\Alawar');
  //aentsys
     if aentsys = true  then
   begin
  reg.OpenKey('software\Aent Sys\pr',true);
  reg.GetKeyNames(ListBox1.Items);
  reg.CloseKey;
  lbc:=listbox1.Items.Count;
  sProgressBar1.Max:=lbc*10;
  i:=0;
  while not (i=lbc) do
  begin
   reg.RootKey:=HKEY_CURRENT_USER;
  reg.OpenKey('software\Aent Sys\pr',true);
  reg.OpenKey(ListBox1.Items.Strings[i],true);
  reg.GetKeyNames(ListBox2.Items);
  reg.OpenKey(ListBox2.Items.Strings[0],true);
  reg.WriteInteger('Program',dw);
  sProgressBar1.Position:= sProgressBar1.Position+10;
  i:=i+1;
  listbox2.Clear;
  reg.CloseKey;
  end;
  end;
  i:=0;
  listbox2.Clear;
  listbox1.clear;
  lbc:=0;
  //alawar key
   if alawarkey = true  then
   begin
  reg.OpenKey('software\Alawar\play',true);
  reg.GetKeyNames(ListBox1.Items);
  reg.CloseKey;
  lbc:=listbox1.Items.Count;
  sProgressBar1.Max:=lbc*10;
  i:=0;
  while not (i=lbc) do
  begin
   reg.RootKey:=HKEY_CURRENT_USER;
  reg.OpenKey('software\Alawar\play',true);
  reg.OpenKey(ListBox1.Items.Strings[i]+'\trial',true);
  reg.GetKeyNames(ListBox2.Items);
  reg.OpenKey(ListBox2.Items.Strings[0],true);
  reg.WriteInteger('Program',dw);
  sProgressBar1.Position:= sProgressBar1.Position+10;
  i:=i+1;
  listbox2.Clear;
  reg.CloseKey;
  end;
  end;

end;

Заново даёт триццать минут для игры от компании Alawar))) аццкое гавно

mistmax, 10 Июня 2010

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

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

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

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

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

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

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

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

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

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

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

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