1. Pascal / Говнокод #13023

    +84

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    uses crt;
    type point=record{точки}
               x,y:real;
               end;
         okr=record{окружности}
             x,y,r:real;
             end;
    const nmax=20;
    function Peres(a,b:point;c:okr):boolean;{пересекаются или нет}
    var s,ab,h:real;
    begin
    s:=abs(a.x*(b.y-c.y)+b.x*(c.y-a.y)+c.x*(a.y-b.y));{удвоенная площадь треугольника
    вершины которого центр окружности и 2 точки}
    ab:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y));{сторона, противоположная центру окружности}
    h:=s/ab;{высота на нее=расстояние от центра до прямой}
    Peres:=h<c.r;{если лно меньше радиуса, пересекаются}
    end;
    var a:array[1..nmax] of point;
        b:array[1..nmax] of okr;
        n,m,i,j,k,p,mx,imx,jmx:integer;
    begin
    clrscr;
    randomize;
    repeat
    write('Количество точек до ',nmax,' n=');
    readln(n);
    until n in [1..nmax];
    repeat
    write('Количество окружностей до ',nmax,' m=');
    readln(m);
    until m in [1..nmax];
    for i:=1 to n do
     begin
      a[i].x:=-10+random*21;
      a[i].y:=-10+random*21;
     end;
    for i:=1 to m do
     begin
      b[i].x:=-5+11*random;
      b[i].y:=-5+11*random;
      b[i].r:=5*random;
     end;
    writeln('Координаты точек:');
    write('X:');
    for i:=1 to n do
    write(a[i].x:6:2);
    writeln;
    write('Y:');
    for i:=1 to n do
    write(a[i].y:6:2);
    writeln;
    writeln;
    writeln('Параметры окружностей:');
    write('X:');
    for i:=1 to m do
    write(b[i].x:6:2);
    writeln;
    write('Y:');
    for i:=1 to m do
    write(b[i].y:6:2);
    writeln;
    write('R:');
    for i:=1 to m do
    write(b[i].r:6:2);
    writeln;
    writeln;
    mx:=0;
    imx:=0;
    jmx:=0;
    for i:=1 to n-1 do
    for j:=i+1 to n do
     begin
      k:=0;
      for p:=1 to m do
      if Peres(a[i],a[j],b[p]) then k:=k+1;
      if k>mx then
       begin
        mx:=k;
        imx:=i;
        jmx:=j;
       end;
     end;
    if mx=0 then write('Нет пересекающихся прямых и окружностей')
    else
     begin
      writeln('Максимальное число пересечений прямой с окружностями=',mx);
      write('Эта прямая проходит через точки (',a[imx].x:0:2,';',a[imx].y:0:2,') и (',a[jmx].x:0:2,';',a[jmx].y:0:2,')');
     end;
    readln
    end.

    Рекурсивная функций с циклами тройной вложенности

    Psilon, 20 Мая 2013

    Комментарии (13)
  2. Pascal / Говнокод #12978

    +103

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    if (s[n][c]='1')and(s[n][c+1]='0')and(s[n+1][c]='0')and(n=1)and(c=1) then writeln('*');
    if (s[n][c]='1')and(s[n][c-1]='0')and(s[n+1][c]='0')and(s[n][c+1]='0')and(n=1) then writeln('*');
    if (s[n][c]='1')and(s[n][c-1]='0')and(s[n+1][c]='0')and(n=1)and(c=10) then writeln('*');
    if (s[n][c]='1')and(s[n-1][c]='0')and(s[n][c-1]='0')and(s[n+1][c]='0')and(c=10) then writeln('*');
    if (s[n][c]='1')and(s[n-1][c]='0')and(s[n][c-1]='0')and(n=10)and(c=10) then writeln('*');
    if (s[n][c]='1')and(s[n][c+1]='0')and(s[n-1][c]='0')and(s[n][c-1]='0')and(n=10) then writeln('*');
    if (s[n][c]='1')and(s[n][c+1]='0')and(s[n-1][c]='0')and(n=10)and(c=1) then writeln('*');
    if (s[n][c]='1')and(s[n+1][c]='0')and(s[n][c+1]='0')and(s[n-1][c]='0')and(c=1) then writeln('*');
    if (s[n][c]='1')and(s[n][c+1]='.')and(s[n+1][c]='.')and(n=1)and(c=1) then writeln('*');
    if (s[n][c]='1')and(s[n][c-1]='.')and(s[n+1][c]='.')and(s[n][c+1]='.')and(n=1) then writeln('*');
    if (s[n][c]='1')and(s[n][c-1]='.')and(s[n+1][c]='.')and(n=1)and(c=10) then writeln('*');
    if (s[n][c]='1')and(s[n-1][c]='.')and(s[n][c-1]='.')and(s[n+1][c]='.')and(c=10) then writeln('*');
    if (s[n][c]='1')and(s[n-1][c]='.')and(s[n][c-1]='.')and(n=10)and(c=10) then writeln('*');
    if (s[n][c]='1')and(s[n][c+1]='.')and(s[n-1][c]='.')and(s[n][c-1]='.')and(n=10) then writeln('*');
    if (s[n][c]='1')and(s[n][c+1]='.')and(s[n-1][c]='.')and(n=10)and(c=1) then writeln('*');
    if (s[n][c]='1')and(s[n+1][c]='.')and(s[n][c+1]='.')and(s[n-1][c]='.')and(c=1) then writeln('*');

    Конец решения первой задачи все из той же дистанционки.
    На этот раз мопед не мой, а одной юной дамы.
    Вот за ЭТО я и недолюбливаю Паскаль: иногда код хер прочитаешь. А еще путаница с типами. И логикой. Гы.

    ckopo, 08 Мая 2013

    Комментарии (56)
  3. Pascal / Говнокод #12945

    +78

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    {$ifdef Profile}
      {$define __TRACE__:= try Profile_TraceCall}
      {$define __END__:=finally Profile_LeaveCall; end;}
    {$else}
      {$define __TRACE__:= //}
      {$define __END__:=}
    {$endif}
    
    procedure Foo();
    begin
      __TRACE__('Foo');
      ...
      __END__
    end;

    FPC.

    runewalsh, 28 Апреля 2013

    Комментарии (2)
  4. Pascal / Говнокод #12914

    +100

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    procedure print(RTK_select:boolean; RLK_select:boolen;MOLK_select:boolean)
    begin
         if (RTK_select and not RLK_select and not MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'РТК';
    
         if (not RTK_select and RLK_select and not MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'РЛК';
    
         if (not RTK_select and not RLK_select and MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'МОЛК';
    
         if (RTK_select and RLK_select and not MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'РТК,РЛК';
    
         if (not RTK_select and RLK_select and MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'РЛК,МОЛК';
    
         if (RTK_select and not RLK_select and  MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'РТК,МОЛК';
    
         if (RTK_select and RLK_select and  MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := 'РТК,РЛК,МОЛК';
    
         if (not RTK_select and not RLK_select and not MOLK_select) then
             Excel.ActiveWorkBook.WorkSheets[1].Range['B4'] := '';
    end

    Обнаружено в недрах старинного проекта. Запись строчки по флажкам.

    astamir, 19 Апреля 2013

    Комментарии (13)
  5. Pascal / Говнокод #12714

    +96

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    procedure TForm1.FormCreate(Sender: TObject);
    var formattedDateTime : string; S: TSearchRec; sf : Int64;
    begin
      Application.OnException := MyHandler;
      if IsRunningEXEName(ExtractFileName(Application.ExeName)) = true then
      begin
        Application.Terminate;
        Exit;
      end;

    Попытка запретить запуск копии программы. Неудачная.

    increazon, 09 Марта 2013

    Комментарии (26)
  6. Pascal / Говнокод #12646

    +93

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 95
    96. 96
    97. 97
    98. 98
    99. 99
    begin
    if n=15 then
    begin
    a:=7200*56*99*12*13*14*15;
    end
    else
    begin
    if n=16 then
    begin
    a:=7200*56*99*12*13*14*15*16;
    end
    else
    begin
    if n=17 then
    begin
    a:=7200*56*99*12*13*14*15*16*17;
    end
    else
    begin
    if n=18 then
    begin
    a:=7200*56*99*12*13*14*15*16*17*18;
    end
    else
    begin
    if n=19 then
    begin
    a:=7200*56*99*12*13*14*15*16*17*18*19;
    end
    else
    begin
    if n=20 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19;
    end
    else
    begin
    if n=21 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21;
    end
    else
    begin
    if n=22 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22;
    end
    else
    begin
    if n=23 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23;
    end
    else
    begin
    if n=24 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24;
    end
    else
    begin
    if n=25 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24*25;
    end
    else
    begin
    if n=26 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24*25*26;
    end
    else
    begin
    if n=27 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24*25*26*27;
    end
    else
    begin
    if n=28 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24*25*26*27*28;
    end
    else
    begin
    if n=29 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24*25*26*27*28*29;
    end
    else
    begin
    if n=30 then
    begin
    a:=144000*56*99*12*13*14*15*16*17*18*19*21*22*23*24*25*26*27*28*29*30;
    end
    else
    begin
    if n=31 then
    begin

    crazy_horse, 25 Февраля 2013

    Комментарии (24)
  7. Pascal / Говнокод #12602

    +93

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    s := '  .  ';
    IF fGamma >= 1000 THEN s[1] := CHR (ORD ('0') + fGamma DIV 1000);
    s[2] := CHR (ORD ('0') + fGamma DIV 100 MOD 10);
    s[4] := CHR (ORD ('0') + fGamma DIV 10 MOD 10);
    s[5] := CHR (ORD ('0') + fGamma MOD 10);

    Перевод числа в строку.
    Из исходников Photoshop 1.0.1
    http://bit.ly/W11p5e
    Там на первый взгляд хватает копипасты. Но особо не углублялся.

    absolut, 16 Февраля 2013

    Комментарии (15)
  8. Pascal / Говнокод #12564

    +86

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    Function TMainForm.PrimGenerateMaze(Width, Height: Integer): Maze;
    
    Type Point = record
      x, y: Integer;
    end;
    
    Var
      TehMaze: Maze;
      Todo: array of Point;
      todonum: integer;
      x,y,n,d: integer;
    
    Const
      dx: array [0..3] of Integer = (0, 0, -1, 1);
      dy: array [0..3] of Integer = (-1, 1, 0, 0);
    
    BEGIN
      SetLength(TehMaze, Width, Height);
      SetLength(Todo, (Width * Height) - 1);
    
      For x:=0 to Width-1 do
        For y:=0 to Height-1 do
          If (x = 0) or (x = Width-1) or (y = 0) or (y = Height-1) then
            TehMaze[x][y]:=32
          Else TehMaze[x][y]:=63;
    
      Randomize;
      x := Random(Width-2)+1;
      y := Random(Height-2)+1;
      todonum := 0;
    
      TehMaze[x][y]:= TehMaze[x][y] and not 48; // Пометить клетку как принадлежащую лабиринту
    
       // Пока не обработаны все клетки
       Repeat
        Begin
           // Занести в список todo все ближайшие необработанные клетки
           For d:=0 to 3 do
               if (TehMaze[x + dx[d]][y + dy[d]] and 16) <> 0 then
               Begin
                 todo[todonum].x := x + dx[d];
                 todo[todonum].y := y + dy[d];
                 Inc(todonum);
                 TehMaze[x + dx[d]][y + dy[d]] := TehMaze[x + dx[d]][y + dy[d]] and not 16;
               End;
    
           // Выбрать из списка todo произвольную клетку
           n:= Random(todoNum);
           x:= ToDo[n].x;
           y:= ToDo[n].y;
    
           // Удалить из списка обработанную клетку
           Dec(todonum);
           ToDo[n]:= todo[todonum];
    
           // Выбрать направление, которое ведет к лабиринту
           Repeat
               d:=Random(4);
           Until ((TehMaze[x + dx[d]][y + dy[d]] and 32) = 0);
    
           // Присоединить выбранную клетку к лабиринту
           TehMaze[x][y] := TehMaze[x][y] and not ((1 shl d) or 32);
           TehMaze[x + dx[d]][y + dy[d]] := TehMaze[x + dx[d]][y + dy[d]] and not (1 shl (d xor 1));
        End;
       Until (todonum = 0);
    
       TehMaze[1][1] := TehMaze[1][1] and -2;                 // начало лабиринта - в левом верхнем углу
       TehMaze[Width-2][Height-2] := TehMaze[Width-2][Height-2] and not 2; // конец лабиринта - в правом нижнем углу
    
       Result := TehMaze;
    END;

    Генерация лабиринтов по алгоритму Прима.

    Govnocoder#0xFF, 10 Февраля 2013

    Комментарии (24)
  9. Pascal / Говнокод #12544

    +106

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    for j := Low(Matrix) to High(Matrix) do begin
        Caption := 'Processing ' + IntToStr(j) + ' of ' + IntToStr(High(Matrix));
        for i := Low(Matrix[j]) to High(Matrix[j]) do begin
            SendMessage(PictureWindow, WM_MOUSEMOVE, 0, MakeLPARAM(i,j));
            S := GetCaption(TemperatureWindow);
            Matrix[j,i].V := StrToFloat(S);
        end;
    end;

    Я не смог раскрыть формат нужной программы, поэтому я извлекаю данные, бегая по окну с картинкой и считывая число из окна с температурой, лол.
    Скорость считывания удручает, но пока альтернатив нет.

    TarasB, 06 Февраля 2013

    Комментарии (3)
  10. Pascal / Говнокод #12478

    +81

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    var
          sMem: String;
    .......
    case Byte(sMem[len]) of
          Word('k'): { Что то делаем };
          Word('m'): { Что то делаем };
          Word('g'): { Что то делаем };
    end;

    Вот такой вот гавнокод

    haker, 25 Января 2013

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