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

    +94

    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
    For i := 0 to 7 do
     Begin
      If ((iMass[i])[1] = dClick.xAlf) and (StrToInt((iMass[i])[2]) = dClick.yFlt) then
      BegiN
       cObject.Caption := '';
       If (i = 1) or (i = 2) then
       Begin
        (Sender as TSpeedButton).Glyph.LoadFromFile('images/Grenadier1.bmp');
        Break;
       End;

       If i = 4 then
       Begin
        (Sender as TSpeedButton).Glyph.LoadFromFile('images/Grenadier3.bmp');
        Break;
       End;

       If i >= 5 then
       Begin
        (Sender as TSpeedButton).Glyph.LoadFromFile('images/Grenadier2.bmp');
        Break;
       End;

       (Sender as TSpeedButton).Glyph.LoadFromFile('images/Grenadier'+IntToStr(i + 1)+'.bmp');
       Break;
      EnD;
     End;

    Мой высер. За неимением идей, больше ничего придумать не смог.

    Govnocoder#0xFF, 15 Января 2011

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

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

    +114

    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
    TMapObj = record
    Size: integer;
    Selected, Valid: boolean;
    case Kind: TKind of
// дохрена пропущено
   koTxr: (
        TxrFileName: string [31];
        tLast: integer;
        TxrCorrect: boolean;
        LODS: array [0 .. 3] of TBitmap;
        Pixel: TBitmap;
      );
      koItem: (
        Location: TLocation;
        ItemEndSel: boolean;        // выделена ли для перетаскивания
        TimeBeforeReborn: integer;  // времени до восстановления
        DescrIndex: integer;        // индекс описателя
        Rotation: integer;

        TeamColor, EnemyColor: integer;

        iLast: integer;

        CannotGet: boolean;

        case TKindItem of
          kiWeapon: (
            iwpFallen: boolean;
            iwpBulletsLeft: integer;
            iwpState: TWeaponState;
          );
          kiHuman: (
            ihState: integer;
          );
          kiFlag: (
            ifState: TFlagState;
            ifHome: integer;
          );
          kiScepter: (
            isState: TScepterState;
          );
      );
      koItemDescr: (
        ItemFileName: string [31];  // файл с описанием предмета
        idLast: integer;
        ItemCorrect: boolean;
        ItemName: string [31];      // название предмета
        SpriteIndName: string [31];
        SpriteInd: integer;         // картинка
        RebornTime: integer;        // время перерождения
        case KindItem: TKindItem of
          kiHealth: (
            hlCount: integer;
          );                          
          kiShield: (
            shCount: integer;
          );
          kiFlag: (
            flTeam: integer;
          );        
          kiSL: (
            slTeam: integer;
          );
          kiAmmo: (
            amCount: integer;
            amIndex: integer;       // тип патрона
          );
          kiWeapon: (                          // всё про пушку
            wpAmmoIndex: integer;              // тип патронов
            wpKeyNumber: integer;              // кнопка на клавиатуре
            wpBulletsInCharge: integer;        // патронов в обойме
            wpInitBullets: integer;            // изначальное число патронов
            wpMaxBullets: integer;             // максимальное число патронов
            wpShotBullets: integer;            // патронов за раз
            wpReloadTime, wpShotTime: integer; // время перезарядки, скорострельность (скорострельность в миллисекундах)
            wpDispersion, wpKickBack: integer; // разброс самого оружия и отдача
            wpBasic: integer;       // базовое ли
            wpDamage: integer;      // урон
            wpDistance, wpBulletSpeed: integer;    // предельная дальность выстрела, скорость пуль
            wpSound: integer;       // номер ноты
            wpColor: TColor;        // цвет
          );
      );   
      koBullet: (
        bLast: integer;

        BLocP: array [0 .. 1] of TPoint;
        BLocRoom: integer;

        BVector: TPoint;           // нормализованный вектор направления

        BDamage: integer;          // параметры, которые надо передавать в процедуру создания пули
        BSpeed: integer;
        BLengthLeft: integer;
        BOwner: integer;
        Bn, Bm: TDistFunc;
        BColor: TColor;
    );
end;

    Меня попросили показать, до чего может довести структурное программирование при отрицании ООП. Разветвлённая структура с кучей ветвей.
    Для лучшего эффекта обмазываться вместе с http://govnokod.ru/4249

    TarasB, 13 Января 2011

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

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

    +97

    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
    TPicture = class(TInterfacedPersistent, IStreamPersist)
....
    property Bitmap: TBitmap read GetBitmap write SetBitmap;
    property Icon: TIcon read GetIcon write SetIcon;
    property Metafile: TMetafile read GetMetafile write SetMetafile;
....

procedure TPicture.ForceType(GraphicType: TGraphicClass);
begin
  if not (Graphic is GraphicType) then
  begin
    FGraphic.Free; // 0_0 йобаный стыд!!
    FGraphic := nil;
    FGraphic := GraphicType.Create;
    FGraphic.OnChange := Changed;
    FGraphic.OnProgress := Progress;
    Changed(Self);
  end;
end;

function TPicture.GetBitmap: TBitmap;
begin
  ForceType(TBitmap);
  Result := TBitmap(Graphic);
end;

function TPicture.GetIcon: TIcon;
begin
  ForceType(TIcon);
  Result := TIcon(Graphic);
end;

function TPicture.GetMetafile: TMetafile;
begin
  ForceType(TMetafile);
  Result := TMetafile(Graphic);
end;

    Взято из "ДНК", т.е. VCL от Delphi7. unit graphics.pas

    Методы get-аксессоры свойств Bitmap, Icon и Metafile вызывают ForceType(). Шутка в том, что если картинка у вас другого типа - то она будет ВНЕЗАПНО выпилена насовсем, стоит только прочитать(sic!) не то свойство объекта класса TPicture.

    Наступил сам на эти грабли и потратил драгоценный, час пока понял в чем дело.

    StriderMan, 13 Января 2011

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

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

    +97

    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
    if MethodName = AnsiUpperCase('Зробити_все_чудово_пречудово') then
  begin
    Screen.Cursor := crHourGlass;
    try
      for LowIndex := 0 to 200 do
      begin
        Application.ProcessMessages;
        Sleep(10);
      end;
      ShowInfo('Тепер все чудово-пречудово.'#13#10'Посміхніться!');
    finally
      Screen.Cursor := crDefault;
    end;
  end

    Внутренний скрипотвый язык

    stokito, 12 Января 2011

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

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

    +101

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    procedure TwndMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  s: string;
begin
  s := UpperCase(GetCompName);
  CanClose :=
    ((Pos('VADIM', s) <> 0) and (DM.DefDBID = 0)) or
    (ShowConfirmation('Ви дійсно бажаєте вийти з програми?') = mrYes);
end;

    Программиста Вадима реально задолбало это сообщение :)

    stokito, 12 Января 2011

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

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

    +98

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    if a[512] < x then L := n – 512 + 1;
if a[L + 256] < x then L := L + 256;
if a[L + 128] < x then L := L + 128;
if a[L + 64] < x then L := L + 64;
if a[L + 32] < x then L := L + 32;
if a[L + 16] < x then L := L + 16;
if a[L + 8] < x then L := L + 8;
if a[L + 4] < x then L := L + 4;
if a[L + 2] < x then L := L + 2;
if a[L + 1] < x then L := L + 1;

    Взято из методического пособия по программированию - отрывок из алгоритма бинарного поиска (реализация для сходимости в 9 шагов)

    diok, 10 Января 2011

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

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

    +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
    procedure TForm1.Button1Click(Sender: TObject);
var i,i2,p,g,gg3: integer;
gg:string;
gg2: Real;
begin
g:=0;
gg:=intTOstr((Length(Memo1.Lines.Text)));
gg2:=StrToFloat(gg)/4;
gg3:=Trunc(gg2);
gg:=Memo1.Lines.Text;
for i2:=1 to gg3 do begin
  p:=pos('котэ',gg);
  if p>0 then begin
  Delete(gg,p,4);
  g:=g+1;
  Label1.Caption:=IntToStr(g);
  end;
  end;
end;

    Алгоритм поиска слова - "котэ" в Memo1.
    УжОс...

    firerap, 09 Января 2011

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

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

    +109

    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
    procedure TfmLab3.mmVesClick(Sender: TObject);
var
  sngVes, sngFlag: single;
  intFlag: integer;
begin
  try
    sngVes:=StrToFloat(InputBox('Ввод исходных данных','Введите вес от 40 до 170',''));
    sngFlag:=sqrt(sngVes-40);
    if sngVes>170 then
      begin
        sngFlag:=1/intFlag;
        //ShowMessage(FloatToStr(sngFlag));
      end;
    edWeight.Text:=FloatToStr(sngVes);
  except
    on EConvertError do ShowMessage('Вводить можно только действительные числа!');
    on EInvalidOp do ShowMessage('Минимальный вес 40кг');
    on EZeroDivide do ShowMessage('Максимальный вес 170кг');
  end;
 
end;

    Брутальненькая лаба с венгеркой и исключениями.

    bugmenot, 07 Января 2011

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

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

    +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
    dats:=datetostr(DateTimePicker1.Date);
datp:=datetostr(DateTimePicker2.Date);
datsc:=copy(dats,1,2);
datsm:=copy(dats,4,2);
datsg:=copy(dats,7,4);
datpc:=copy(datp,1,2);
datpm:=copy(datp,4,2);
datpg:=copy(datp,7,4);
idatsc:=strtoint(datsc);
idatsm:=strtoint(datsm);
idatsg:=strtoint(datsg);
idatpc:=strtoint(datpc);
idatpm:=strtoint(datpm);
idatpg:=strtoint(datpg);
tdatc:=strtoint(copy(p[i,6],1,2));
tdatm:=strtoint(copy(p[i,6],4,2));
tdatg:=strtoint(copy(p[i,6],7,4)); 
if not ((idatsg>tdatg) or ((idatsg=tdatg) and (idatsm>tdatm)) or ((idatsc>tdatc) and (idatsm>=tdatm)) or (idatpg<tdatg) or ((idatpg=tdatg) and (idatpm<tdatm)) or ((idatpc<tdatc) and (idatpm<=tdatm))) then

    Проверка или дата с массива включена в диапазон дат с DateTimePicker'ов (еще и с ошибкой в условии)
    И вся эта фигня в цикле... Как это увидел, валерьянкой отпаивали меня долго

    Nikitiy_II, 04 Января 2011

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

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

    +106

    1. 1
    2. 2
    if not FileExists(aFileName) then
    raise Exception('Не удалось загрузить тесты. Файл "' + aFileName + '" не найден.');

    Долго думал почему возникает Access violation, а не то, что нужно.

    AK-47, 30 Декабря 2010

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