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

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

+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

glpushmatrix;
if ((commandflat=2)and((commandaxis=2) or(commandaxis=3)))or((commandflat=1)and(commandaxis=1)) then
 glrotatef(faza,rotation[0],rotation[1],rotation[2]);

  glcolor3f(kubcol[Y[2,1,1]].R,kubcol[Y[2,1,1]].G,kubcol[Y[2,1,1]].B);
 glbegin(gl_quads);
  glvertex3f(-1.5,1.5,1.5);
  glvertex3f(-1.5,1.5,0.5);
  glvertex3f(-0.5,1.5,0.5);
  glvertex3f(-0.5,1.5,1.5);
 glend;
 glcolor3f(kubcol[X[1,1,1]].R,kubcol[X[1,1,1]].G,kubcol[X[1,1,1]].B);
 glbegin(gl_quads);
  glvertex3f(-1.5,1.5,1.5);
  glvertex3f(-1.5,1.5,0.5);
  glvertex3f(-1.5,0.5,0.5);
  glvertex3f(-1.5,0.5,1.5);
 glend;
 glcolor3f(kubcol[Z[2,1,1]].R,kubcol[Z[2,1,1]].G,kubcol[Z[2,1,1]].B);
 glbegin(gl_quads);
  glvertex3f(-1.5,1.5,1.5);
  glvertex3f(-0.5,1.5,1.5);
  glvertex3f(-0.5,0.5,1.5);
  glvertex3f(-1.5,0.5,1.5);
 glend;
 glcolor3f(0.5,0.5,0.5);
 glbegin(gl_quads);
  glvertex3f(-1.5,0.5,1.5);
  glvertex3f(-1.5,0.5,0.5);
  glvertex3f(-0.5,0.5,0.5);
  glvertex3f(-0.5,0.5,1.5);
 glend;
 glcolor3f(0.5,0.5,0.5);
 glbegin(gl_quads);
  glvertex3f(-0.5,1.5,1.5);
  glvertex3f(-0.5,1.5,0.5);
  glvertex3f(-0.5,0.5,0.5);
  glvertex3f(-0.5,0.5,1.5);
 glend;
 glcolor3f(0.5,0.5,0.5);
 glbegin(gl_quads);
  glvertex3f(-1.5,1.5,0.5);
  glvertex3f(-0.5,1.5,0.5);
  glvertex3f(-0.5,0.5,0.5);
  glvertex3f(-1.5,0.5,0.5);
 glend;
glpopmatrix;
///////112

Захотел как то кубик рубика накодить, это фрагмент модуля из 1214 строк который выводит 26 кубиков. Цвет лицевых граней берется из массива, остальные - серые.

Dent, 14 Февраля 2011

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

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

+101

01
02
03
04
05
06
07
08
09
10

type Table = record
   f1, f2, f3, f4, f5: integer;
end;

procedure Sort(a: array of Table; L, R: integer; Shift: integer);
begin
// что-то там...
// сравнение элементов:
   if pinteger(size_t(@a[i])+Shift)^ < pinteger(size_t(@a[j])+Shift)^
end;

Использование: Sort(a, 0, Length(a) - 1, size_t(@a[0].f4) - size_t(@a[0]))
сортировка по полю f4.

chaoswithin, 13 Февраля 2011

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

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

+93

1
2
3
4
5
6
7
8

for i:=1 to 100 do
begin
for j:=1 to f do
begin
...
end;
f:=f+1000;
end;

Бедные дельфины, им не повезло с циклами.

CHayT, 12 Февраля 2011

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

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

+110

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

procedure TMainForm.ApplicationEventsShortCut(var Msg: TWMKey;
  var Handled: Boolean);
begin
  if msg.CharCode <> vk_F11 then
    exit;
  raise Exception.Create('Вы хотите выйти из программы?');
end;

procedure TMainForm.ApplicationEventsException(Sender: TObject;
  E: Exception);
begin
  if Application.MessageBox(pchar('Произошла ошибка:'#13#10 + e.Message
    +
    #13#10'Нажмите Retry продолжить работу c программой.'#13#10'Нажмите Сancel чтобы завершить работу программы.'),
    'Ошибка', MB_RETRYCANCEL or MB_ICONINFORMATION or MB_SYSTEMMODAL) =
    ID_CANCEL then try
    MainData.MainDataBaseBeforeDisconnect(nil);
    Close;
  finally
    Application.Terminate;
  end;
  if not CaptureError(E) then
    Close;
end;

предыдущий автор одного проекта таким вот нетривиальным образом сделал подтверждение выхода из программы. так понравилось, что не стал убивать, просто закомментарил. сейчас весть этот код заменен одной строчкой в OnCloseQuery.

поясню, на всякий случай. по нажатию F11 поднимается эспепшен "Вы хотите выйти из программы?", этот экспепшен перехватывается на уровне TApplication, выводится сообщение "Произошла ошибка: "Вы хотите выйти из программы?"" с педалями "Retry" и "Cancel", и при нажатии на отмену прога тупо рубиться по Application.Terminate.

непростое детство было у песателя, по ходу.

x77, 11 Февраля 2011

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

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

+96

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

procedure tnew.execute;
var
cod:utf8string;
id:byte;

captcha,sim,idc:string;
ss:TStringStream;
s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,
s11,s12,s13,s14,s15,s16,s17,s18,
s19,s20,s21,s22,s23,s24,s25,s26,
s27,s28,s29,s30,s31,s32,s33:utf8string;
FS:TFileStream;
Antigate: TAntigate;
begin
form3.IdHTTP1.Request.Referer :='http://www.aboutlive.ru/phpBB2/profile.php?mode=register';

cod:=form3.IdHTTP1.get('http://www.aboutlive.ru/phpBB2/profile.php?mode=register&agreed=true');

function Pars (T_, ForS, _T: string): string;
var
a, b: integer;
begin
Result := '';
if (T_ = '') or (ForS = '') or (_T = '') then
Exit;
a := Pos (T_, ForS);
if a = 0 then
Exit
else
a := a + Length (T_);
ForS := Copy (ForS, a, Length (ForS) - a + 1);
b := Pos (_T, ForS);
if b > 0 then
Result := Copy (ForS, 1, b - 1);
end;


idc:= pars('confirm_id" value="',cod,'" />');
sim:= pars('sid" value="',cod,'" />');

FS:=TFileStream.Create('captcha.png',FMCreate);
form3.IdHTTP1.Get('http://www.aboutlive.ru/phpBB2/profile.php?mode=confirm&id='+idc, FS);
FS.free;
form3.Image1.Picture.LoadFromFile('captcha.png');

Antigate := TAntigate.Create; // это разгадка капчи
antigate.Calc:=1;
antigate.MaxRetry:=3;
Antigate.Key := '';
Antigate.ImageFile := 'captcha.png';
captcha:=Antigate.Recognize;
Antigate.free;

form3.RichEdit1.Lines.Add('Капча: '+AnsiUpperCase(captcha));

form3.IdHTTP1.Request.Referer :='http://www.aboutlive.ru/phpBB2/profile.php?mode=register&agreed=true';
ss := TStringStream.Create;

s1:='username=sadsaddfsa12342';
s2:='[email protected]';
s3:='new_pasword=1234567';
s4:='pasword_confirm=1234567';
s5:='confirm_code='+captcha;
s6:='icq=';
s7:='aim=';
s8:='msn=';
s9:='yim=';
s10:='website=';
s11:='location=';
s12:='occupation=';
s13:='interests=';
s14:='signature=';
s15:='viewemail=0';
s16:='hideonline=0';
s17:='notifyreply=0';
s18:='notifypm=1';
s19:='popup_pm=1';
s20:='attachsig=1';
s21:='allowbbcode=1';
s22:='allowhtml=1';
s23:='allowsmilies=1';
s24:='language=russian';
s25:='style=1';
s26:='timezone=4';
s27:='dateformat=D M d, Y g:i a';
s28:='mode=register';
s29:='agreed=true';
s30:='coppa=0';
s31:='sid='+sim;
s32:='confirm_id='+idc;
s33:='submit=Отправить';
ss.WriteString (s1+'&'+s2+'&'+s3+'&'+s4+'&'+s5+'&'+s6+'&'+s7+'&'+s8+'&'+s9+'&'+s10+'&'+s11+'&'+s12+'&'+s13+'&'+s14+'&'+s15+'&'+s16+'&'+s17+'&'+s18+'&'+s19+'&'+s20+'&'+s21+'&'+s22+'&'+s23+'&'+s24+'&'+s25+'&'+s26+'&'+s27+'&'+s28+'&'+s29+'&'+s30+'&'+s31+'&'+s32+'&'+s33);

Что уж тут напишешь....

Irdis, 11 Февраля 2011

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

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

+102

1

while dlg_SmplSpk.ShowModal = mrOk do ;

Узрел такое! Срочно к себе в рецепты прогрессивного программирования!
Сделано это для того, чтобы окно не закрывалось при подтверждении всех сделанных действий.
Закрываться должно только при нажатии кнопочки "Закрыть".
Отсюда непонятен ход мыслей автора сия творения.

Grizzly, 11 Февраля 2011

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

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

+92

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

I:=1;
    while I<=High(Sockets) do
     begin
      if FD_IsSet(Sockets[I],FDSet) then
       if Recv(Sockets[I],…)<=0 then
        begin
         // Связь разорвана, надо закрыть сокет
         // и удалить его из массива
         CloseSocket(Sockets[I]);
         for J:=I to High(Sockets)-1 do
          Sockets[J]:=Sockets[J+1];
         Dec(I);
         SetLength(Sockets,Length(Sockets)-1)
        end
       else
        begin
         // Получены данные от клиента, надо ответить
         Send(Sockets[I],…)
        end;
      Inc(I)
     end;

На первый взгляд может показаться странным, почему для перебора элементов массива используется цикл while, а не for. Но в дальнейшем мы увидим, что размер массива во время выполнения цикла может изменяться. Особенность же цикла for заключается в том, что его границы вычисляются один раз и запоминаются в отдельных ячейках памяти, и дальнейшее изменение значений выражений, задающих эти границы, не изменяет эти границы. В нашем примере это приведёт к тому, что в случае уменьшения массива цикл for не остановится на реальной уменьшившейся длине, а продолжит цикл по уже не существующим элементам, что приведёт к трудно предсказуемым последствиям. Поэтому в данном случае лучше использовать цикл while, в котором условие продолжения цикла полностью вычисляется при каждой его итерации.

TarasB, 09 Февраля 2011

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

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

+101

01
02
03
04
05
06
07
08
09
10

....
for i:=1 to 4 do for j:=1 to 4 do begin a[i,j]:=b; b:=b-1; end;
for i:=1 to 4 do for j:=1 to 4 do if a[i,j]=16 then begin k:=i;l:=j; end;
for i:=1 to 4 do
for j:=1 to 4 do
begin
gotoxy(5+3*i,5+2*j);
write(a[i,j]);
end; 
....

http://otvet.mail.ru/question/52501602/

1_and_0, 02 Февраля 2011

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

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

+99

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

procedure TForm1.Timer1Timer(Sender: TObject);
var Ras, MinRas, MinC, Comp: Integer;
begin
Ras:=0;
MinC:=0;
MinRas:=0;      // всё по нулям
 for Comp:=0 to ComponentCount-1 do // цикл по всем компонентам
  begin
   IF (Components[Comp] is TPanel) and (Components[Comp] <> Panel1) and (Panel1.Left>TPanel(Components[Comp]).Left) then
                 Ras:=Panel1.Left-TPanel(Components[Comp]).Left
                 else
   IF (Components[Comp] is TPanel) and (Components[Comp] <> Panel1) and (Panel1.Left<TPanel(Components[Comp]).Left) then
                 Ras:=TPanel(Components[Comp]).Left-Panel1.Left;
   If Ras < MinRas
    then begin
            MinRas:= Ras;  //устанавливаем переменные этой панельки за основные
            MinC:= Comp;
    end;
  end;
   if Panel1.top<(TPanel(Components[MinC]).Top-TPanel(Components[MinC]).Height) then
                Panel1.Top:=Panel1.Top+3;    //если панель ниже то допрыгиваем
  PROBEL:=Panel1.Top=TPanel(Components[MinC]).Top-TPanel(Components[MinC]).Height
  end;

какое-то панельное безумие

bugmenot, 02 Февраля 2011

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

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