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

    +105

    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
    procedure TForm2.FormCreate(Sender: TObject);
begin
  SpeedButton1.Left := Form2.ClientWidth div 2 - SpeedButton1.Width;
  SpeedButton1.Top := Form2.ClientHeight div 2 - SpeedButton1.Height;
 
  SpeedButton2.Left := Form2.ClientWidth div 2;
  SpeedButton2.Top := Form2.ClientHeight div 2 - SpeedButton2.Height;
 
  SpeedButton3.Left := Form2.ClientWidth div 2 - SpeedButton3.Width;
  SpeedButton3.Top := Form2.ClientHeight div 2;
 
  SpeedButton4.Left := Form2.ClientWidth div 2;
  SpeedButton4.Top := Form2.ClientHeight div 2;
end;

    Fai, 30 Августа 2011

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

  2. Pascal / Говнокод #7647

    +100

    1. 1
    2. 2
    3. 3
    4. 4
    case
   0: FilterList.Add('RCHECK = '+''''+'+'+'''');
   1: FilterList.Add('RCHECK = '+''''+'-'+'''');
...

    Автор кода жжот. Код реально работает. Но прочитать такое даже автор по прошествии года не сможет.

    Можно было проще
    0:FilterList.Add('RCHECK = ''+''');

    siqel, 25 Августа 2011

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

  3. Pascal / Говнокод #7624

    +123

    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
    function HexWrdToStr(Dval : integer) : string;
var i : integer;
retstr : string;
begin
retstr := '';
i := (Dval AND $F000) DIV $1000;
case i of
  0 : retstr := retstr + '0';
  1 : retstr := retstr + '1';
  2 : retstr := retstr + '2';
  3 : retstr := retstr + '3';
  4 : retstr := retstr + '4';
  5 : retstr := retstr + '5';
  6 : retstr := retstr + '6';
  7 : retstr := retstr + '7';
  8 : retstr := retstr + '8';
  9 : retstr := retstr + '9';
  10 : retstr := retstr + 'A';
  11 : retstr := retstr + 'B';
  12 : retstr := retstr + 'C';
  13 : retstr := retstr + 'D';
  14 : retstr := retstr + 'E';
  15 : retstr := retstr + 'F';
end;
i := (Dval AND $F00) DIV $100;
case i of
  0 : retstr := retstr + '0';
  1 : retstr := retstr + '1';
  2 : retstr := retstr + '2';
  3 : retstr := retstr + '3';
  4 : retstr := retstr + '4';
  5 : retstr := retstr + '5';
  6 : retstr := retstr + '6';
  7 : retstr := retstr + '7';
  8 : retstr := retstr + '8';
  9 : retstr := retstr + '9';
  10 : retstr := retstr + 'A';
  11 : retstr := retstr + 'B';
  12 : retstr := retstr + 'C';
  13 : retstr := retstr + 'D';
  14 : retstr := retstr + 'E';
  15 : retstr := retstr + 'F';
end;
i := (Dval AND $F0) DIV $10;
case i of
  0 : retstr := retstr + '0';
  1 : retstr := retstr + '1';
  2 : retstr := retstr + '2';
  3 : retstr := retstr + '3';
  4 : retstr := retstr + '4';
  5 : retstr := retstr + '5';
  6 : retstr := retstr + '6';
  7 : retstr := retstr + '7';
  8 : retstr := retstr + '8';
  9 : retstr := retstr + '9';
  10 : retstr := retstr + 'A';
  11 : retstr := retstr + 'B';
  12 : retstr := retstr + 'C';
  13 : retstr := retstr + 'D';
  14 : retstr := retstr + 'E';
  15 : retstr := retstr + 'F';
end;
i := Dval AND $F;
case i of
  0 : retstr := retstr + '0';
  1 : retstr := retstr + '1';
  2 : retstr := retstr + '2';
  3 : retstr := retstr + '3';
  4 : retstr := retstr + '4';
  5 : retstr := retstr + '5';
  6 : retstr := retstr + '6';
  7 : retstr := retstr + '7';
  8 : retstr := retstr + '8';
  9 : retstr := retstr + '9';
  10 : retstr := retstr + 'A';
  11 : retstr := retstr + 'B';
  12 : retstr := retstr + 'C';
  13 : retstr := retstr + 'D';
  14 : retstr := retstr + 'E';
  15 : retstr := retstr + 'F';
end;
HexWrdToStr := retstr;
end;

    Авторы - программисты из FTDI, взято из экзамплов работы с USB-конвертерами.
    Полный текст можно найти здесь: __http://www.ftdichip.com/Support/SoftwareExamples/CodeExamples/Delphi.htm

    З.Ы. Ниже по тексту идет аналогичная функция HexByteToStr. Алгоритм, так сказать, тот же.

    1291, 23 Августа 2011

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

  4. Pascal / Говнокод #7586

    +108

    1. 1
    if (rmes<>'')and(rmes<>#13#10)and(rmes<>#13#10#13#10)and(rmes<>#13#10#13#10#13#10) then

    Эталонный условный оператор прямо из Парижской Дельфийской палатки мер и весов.

    bugmenot, 18 Августа 2011

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

  5. Pascal / Говнокод #7472

    +120

    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
    VAR
m0:array[0..61,0..41]of byte;
ma:array[1..60,1..40]of byte;
I,J:byte;
BEGIN
randomize;
for I:=0to 61do
for J:=0to 41do
if (I=0) or
   (I=61)or
   (J=0) or
   (J=61)
           then m0[I,J]:=0
           else m0[I,J]:=random(2);
for I:=1to 60do
for J:=1to 40do
if m0[I,J]=1then ma[I,J]:=9
            else ma[I,J]:=m0[ I-1 , J-1  ] +
                                m0[ I-1 , J     ] +
                                m0[ I+1 , J+1 ]+
                                m0[ I   , J+1  ]+
                                m0[ I   , J-1   ]+
                                m0[ I-1 , J+1 ]+
                                m0[ I+1 , J-1 ]+
                                m0[ I+1 , J    ];
... ... ... ... ... ... ... ... ... ... 
... ... ... ... ... ... ... ... ... ... 
END.

    Начало игры САПЁР. Край массива заполняем нулями,
    середину - 0 или 1. В меньшем массиве складываем соседние
    клетки (выходит от 0 до 8), если мина - 9.

    dos, 06 Августа 2011

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

  6. Pascal / Говнокод #7431

    +120

    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
    // Check if You need Administrator-level access to create a folder
try
  mkdir(SDirectory + '\~TEST');
except
  on E: exception do
  begin
    if E.message = 'File access denied' then
    begin
      MessageBox(self.Handle,
        'You need Administrator-level access to create this folder', '', MB_ICONERROR);
      exit;
    end;
  end;
end;
RmDir(SDirectory + '\~TEST');

    Мартышки плакали, кололись, но продолжали ронять UAC себе на лапки.

    bugmenot, 03 Августа 2011

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

  7. Pascal / Говнокод #7423

    +98

    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
    case ColorChunkStart of  
   0 : result := RGB(255,   
                     (255 div ColorChunk) * ColorChunkIndex,   
                     0);   
   1 : result := RGB(255 - (255 div ColorChunk) * ColorChunkIndex,   
                     255,   
                     0);   
   2 : result := RGB(0, 255, (255 div ColorChunk) * ColorChunkIndex);   
   3 : result := RGB(0,   
                     255 - (255 div ColorChunk) * ColorChunkIndex,   
                     255);   
   4 : result := RGB((255 div ColorChunk) * ColorChunkIndex,   
                     0,   
                     255);   
   5 : result := RGB(255,   
                     0,   
                     255 - (255 div ColorChunk) * ColorChunkIndex);   
  else  
    if WrapToRed <> false then  
      result := RGB(255, 0, 0) else  
      result := RGB(255, 0, 255);   
end;{Case}

    Говно?

    Fai, 02 Августа 2011

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

  8. Pascal / Говнокод #7408

    +96

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    procedure TForm1.Timer1Timer(Sender: TObject);//интервал 1 минута
var
  f: file of byte;
  c: byte;
begin
  assignfile(f, 'c:\0.dsk');
  if fileexists('c:\0.dsk') then reset(f) else rewrite(f);// :)
  c := 0;
  write(f, c);
  closefile(f);
end;

    Процедура "дёрганья" диска ))

    eoln, 01 Августа 2011

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

  9. Pascal / Говнокод #7396

    +106

    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
    function TmainForm1.getLetterFinger( letter: String ): Integer;
begin
  letter := UpperCase( letter );
  if ( letter = 'Ё' ) or ( letter = '1' ) or ( letter = 'Й' ) or
    ( letter = 'Ф' ) or ( letter = 'Я' ) or ( letter = '~' ) or
    ( letter = '!' ) or ( letter = 'Q' ) or ( letter = 'A' ) or
    ( letter = 'Z' ) or ( letter = 'LSHIFT' ) or ( letter = 'LCTRL' ) or
    ( letter = 'TAB' ) or ( letter = 'CAPS' ) or ( letter = 'SHIFT' ) then
    Result := 1;
  if ( letter = '2' ) or ( letter = '@' ) or ( letter = '"' ) or
    ( letter = 'W' ) or ( letter = 'S' ) or ( letter = 'X' ) or
    ( letter = 'Ц' ) or ( letter = 'Ы' ) or ( letter = 'Ч' ) then
    Result := 2;
  if ( letter = '3' ) or ( letter = '№' ) or ( letter = '#' ) or
    ( letter = 'E' ) or ( letter = 'D' ) or ( letter = 'C' ) or
    ( letter = 'У' ) or ( letter = 'В' ) or ( letter = 'С' ) then
    Result := 3;
  if ( letter = '4' ) or ( letter = ';' ) or ( letter = '$' ) or
    ( letter = 'R' ) or ( letter = 'F' ) or ( letter = 'V' ) or
    ( letter = 'К' ) or ( letter = 'А' ) or ( letter = 'М' ) or
    ( letter = '5' ) or ( letter = '%' ) or ( letter = 'Е' ) or
    ( letter = 'П' ) or ( letter = 'И' ) or ( letter = 'Е' ) or
    ( letter = 'T' ) or ( letter = 'G' ) or ( letter = 'B' ) then
    Result := 4;
  if ( letter = 'LSPACE' ) or ( letter = 'LATL' ) then
    Result := 5;
  if ( letter = 'RSPACE' ) or ( letter = 'RATL' ) then
    Result := 6;
  if ( letter = '&' ) or ( letter = '?' ) or ( letter = '7' ) or
    ( letter = 'Y' ) or ( letter = 'U' ) or ( letter = 'H' ) or
    ( letter = 'J' ) or ( letter = 'N' ) or ( letter = 'M' ) or
    ( letter = 'Н' ) or ( letter = 'Г' ) or ( letter = 'Р' ) or
    ( letter = 'О' ) or ( letter = 'Т' ) or ( letter = 'Ь' ) then
    Result := 7;
  if ( letter = '8' ) or ( letter = '*' ) or ( letter = 'Ш' ) or
    ( letter = 'Л' ) or ( letter = 'Б' ) or ( letter = ',' ) or
    ( letter = '<' ) or ( letter = 'K' ) or ( letter = 'I' ) then
    Result := 8;
  if ( letter = '9' ) or ( letter = '(' ) or ( letter = 'O' ) or
    ( letter = 'L' ) or ( letter = '.' ) or ( letter = '>' ) or
    ( letter = 'Щ' ) or ( letter = 'Д' ) or ( letter = 'Ю' ) then
    Result := 9;
  if ( letter = '0' ) or ( letter = ')' ) or ( letter = '-' ) or
    ( letter = '_' ) or ( letter = '+' ) or ( letter = '=' ) or
    ( letter = 'BACKSPACE' ) or ( letter = 'ENTER' ) or
    ( letter = 'RSHIFT' ) or ( letter = 'P' ) or ( letter = '{' ) or
    ( letter = '[' ) or ( letter = '}' ) or ( letter = ']' ) or
    ( letter = ':' ) or ( letter = ';' ) or ( letter = '''' ) or
    ( letter = '"' ) or ( letter = '/' ) or ( letter = '?' ) or
    ( letter = '\' ) or ( letter = '/' ) or ( letter = '?' ) or
    ( letter = '|' ) or ( letter = 'Ж' ) or ( letter = 'Э' ) or
    ( letter = '.' ) or ( letter = ',' ) or ( letter = 'З' ) or
    ( letter = 'Х' ) or ( letter = 'Ъ' ) then
    Result := 10;

end;

    Nuff said.

    Fai, 30 Июля 2011

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

  10. Pascal / Говнокод #7394

    +104

    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
    procedure drawGird( var image1: TImage; needAxisLines: Boolean = True );
var
  xP, yP: Integer;
  xC, yC: Double;
  h, w, tx, ty: Integer;
  Text: String;
begin
  image1.Canvas.FillRect( image1.ClientRect );
  accuracy := 1 / cellSize;
  image1.Canvas.Brush.Style := bsClear;

  xC := p2cX( 0 );
  while forC( xC, p2cX( image1.Width ), accuracy ) do
    if floor( xC * cellSize ) mod cellSize = 0 then
    begin
      xP := c2pX( xC );
      image1.Canvas.Pen.Color := clSilver;
      image1.Canvas.MoveTo( xP, 0 );
      image1.Canvas.LineTo( xP, image1.Height );

      if ( needaxislines ) and ( abs( xC ) > 0.5 ) and
        ( xP > 30 ) and ( xP < image1.Width - 30 ) then
      begin
        image1.Canvas.Pen.Color := clBlack;
        image1.Canvas.MoveTo( xP, c2pY( -0.5 ) );
        image1.Canvas.LineTo( xP, c2pY( 0.5 ) );
      end;
    end;

  yC := p2cY( 0 );
  while forC( yC, p2cY( image1.Height ), accuracy ) do
    if floor( yC * cellSize ) mod cellSize = 0 then
    begin
      yP := c2pY( yC );
      image1.Canvas.Pen.Color := clSilver;
      image1.Canvas.MoveTo( 0, yP );
      image1.Canvas.LineTo( image1.Width, yP );

      if ( needaxislines ) and ( abs( yC ) > 0.5 ) and
        ( yP > 30 ) and ( yP < image1.Height - 30 ) then
      begin
        image1.Canvas.Pen.Color := clBlack;
        image1.Canvas.MoveTo( c2pX( -0.5 ), yP );
        image1.Canvas.LineTo( c2pX( 0.5 ), yP );
      end;
    end;

  xC := p2cX( 0 );
  while forC( xC, p2cX( image1.Width ), accuracy ) do
    if floor( xC * cellSize ) mod cellSize = 0 then
    begin
      xP := c2pX( xC );

      if ( needaxislines ) and ( abs( xC ) > 1.5 ) and
        ( xP > 30 ) and ( xP < image1.Width - 30 ) then
      begin
        image1.Canvas.Pen.Color := clBlack;

        Text := IntToStr( floor( xC ) );
        h := image1.Canvas.TextHeight( Text ) div 2;
        w := image1.Canvas.TextWidth( Text ) div 2;

        image1.Canvas.TextOut( xP - w, c2pY( -0.5 ) + ( h + 3 ) *
          ( ( floor( abs( xC ) ) mod ( ( ( w * 2 + 8 ) div cellSize ) +
          1 ) ) ), Text );

      end;
    end;

  yC := p2cY( 0 );
  while forC( yC, p2cY( image1.Height ), accuracy ) do
    if floor( yC * cellSize ) mod cellSize = 0 then
    begin
      yP := c2pY( yC );
      if ( needaxislines ) and ( abs( yC ) > 1.5 ) and
        ( yP > 30 ) and ( yP < image1.Height - 30 ) then
      begin
        image1.Canvas.Pen.Color := clBlack;

        Text := IntToStr( floor( yC ) );
        h := image1.Canvas.TextHeight( Text ) div 2;
        w := image1.Canvas.TextWidth( Text ) div 2;

        image1.Canvas.TextOut( c2pX( -0.5 ) - w * 2 - 2, yP - h, Text );
      end;
    end;

  image1.Canvas.Brush.Style := bsSolid;

end;

    Сотня строк кода, для того, чтобы нарисовать сетку.

    Fai, 30 Июля 2011

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