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

    −1

    1. 1
    2. 2
    3. 3
    Стертор, ты вообще пишешь полезный код (хотя бы на Delphi) или
занимаешься только тем, что постишь на говнокод советы по 
использованию камерунских пенисов на основании своего личного опыта?

    dm_fomenok, 07 Мая 2018

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

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

    −1

    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
    type
  TItemTag = (
    яХз,
    яКаркас,
    яИгровой,
    яЭлемент,
    яКонструкция,
    яТруба,
    яСтойка,
    // тут еще штук 15...
    яМетиз);

//........

function TItemSerializator.GetTagIdByName(
  const ATagName: string): TItemTag;
begin
  if not FNameToTagIdMap.TryGetValue(ATagName.ToLower, Result) then
    Result := яХз;
end;

//.....

function TItemSerializator.StringToTags(const ATextTags: string): TItemTags;
var
  i: Integer;
  LTag: TItemTag;
  LTextTag: string;
begin
  Result := [];
  FParser.DelimitedText := ATextTags;
  for i := 0 to FParser.Count - 1 do
    begin
      LTextTag := FParser[i].Trim;
      if not LTextTag.IsEmpty then
        begin
          LTag := GetTagIdByName(LTextTag);
          if LTag <> яХз then
            Result := Result + [LTag];
        end;
    end;
end;

    Решил воспользоваться кириллицей, потому что задолбался - тэгов двадцать штук уже.
    Привет одинэсникам!

    LabutinPA2, 06 Апреля 2018

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

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

    0

    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
    unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
...
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
GroupBox2: TGroupBox;
RadioButton5: TRadioButton;
RadioButton6: TRadioButton;
RadioButton7: TRadioButton;
RadioButton8: TRadioButton;
GroupBox3: TGroupBox;
RadioButton9: TRadioButton;
RadioButton10: TRadioButton;
...
GroupBox14: TGroupBox;
RadioButton52: TRadioButton;
RadioButton53: TRadioButton;
RadioButton54: TRadioButton;
RadioButton55: TRadioButton;
GroupBox15: TGroupBox;
RadioButton56: TRadioButton;
RadioButton57: TRadioButton;
RadioButton58: TRadioButton;
RadioButton59: TRadioButton;

... 
end;

var 
Form1: TForm1;

implementation 

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
form1.Close;
end;
procedure TForm1.Button2Click(Sender: TObject);
var s: integer;
begin
Button3.enabled:=true;

s:=0;
if Form1.RadioButton2.Checked then s:=s+1;
if Form1.RadioButton6.Checked then s:=s+1;
if Form1.RadioButton20.Checked then s:=s+1;
if Form1.RadioButton15.Checked then s:=s+1;
if Form1.RadioButton11.Checked then s:=s+1;
if Form1.RadioButton21.Checked then s:=s+1;
if Form1.RadioButton24.Checked then s:=s+1;
if Form1.RadioButton28.Checked then s:=s+1;
if Form1.RadioButton33.Checked then s:=s+1;
if Form1.RadioButton39.Checked then s:=s+1;
if Form1.RadioButton43.Checked then s:=s+1;
if Form1.RadioButton44.Checked then s:=s+1;
if Form1.RadioButton50.Checked then s:=s+1;
if Form1.RadioButton54.Checked then s:=s+1;
if Form1.RadioButton56.Checked then s:=s+1;

if s=15 then Label3.Caption:=' Молодец, ты ответил на все вопросы!(Твоя оценка 5)';
if s=14 then Label3.Caption:=' Молодец, ты ответил на четырнадцать вопросов!(Твоя оценка 5)';
if s=13 then Label3.Caption:=' Молодец, ты ответил на 13 вопросов!(Твоя оценка 5)';
if s=12 then Label3.Caption:=' Хорошо, ты ответил на 12!(Твоя оценка 4)';
if s=11 then Label3.Caption:=' Ты ответил на все 11!(Твоя оценка 4)';
if s=10 then Label3.Caption:='10 парвильных ответов молодец!(Твоя оценка 4)";
if s=9 then Label3.Caption:='9 ПРАВИЛЬНЫХ ОТВЕТОВ!(Твоя оценка 3)';
if s=8 then Label3.Caption:='Отлично! Ты ответил на 8 вопрос(Твоя оценка 3)';
if s=7 then Label3.Caption:='Молодец! Ты ответил на 7 вопрос(Твоя оценка 3)';
if s=6 then Label3.Caption:='6 Вопросов? Ты не плох!(Твоя оценка 3)';
if s=5 then Label3.Caption:='5 правильных вопросов! ура!(Твоя оценка 2)';
if s=4 then Label3.Caption:='Учи предмет лучше! Всего 4 правильных вопроса!(Твоя оценка 2)';
if s=3 then Label3.Caption:=' Слабо! Всего 3 правильных ответа!(Твоя оценка 2)';
if s=2 then label3.Caption:=' Всего 2 правильных ответа!( Твоя оценка 2)';
if s=1 then label3.Caption:=' Тебе не быть программистом! Всего 1 правильный ответ!(Твоя оценка 2)';
if s=0 then label3.Caption:=' Давай заново!(Твоя оценка 2)';

end;

    Автор пытается сделать тест по информатике. Вроде бы для диплома.

    Alex11223, 03 Апреля 2018

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

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

    0

    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
    procedure ustbet;
begin
if (200*GCtrl.CurLines>coins.realBalance) then  begin
if (150*GCtrl.CurLines>coins.realBalance) then  begin
if (100*GCtrl.CurLines>coins.realBalance) then  begin
if (50*GCtrl.CurLines>coins.realBalance) then  begin
    if (40*GCtrl.CurLines>coins.realBalance) then  begin
       if (30*GCtrl.CurLines>coins.realBalance) then  begin
         if (20*GCtrl.CurLines>coins.realBalance) then  begin
           if (15*GCtrl.CurLines>coins.realBalance) then  begin
             if (10*GCtrl.CurLines>coins.realBalance) then  begin
              if (5*GCtrl.CurLines>coins.realBalance) then  begin
                 if (4*GCtrl.CurLines>coins.realBalance) then  begin
                   if (3*GCtrl.CurLines>coins.realBalance) then  begin
                     if (2*GCtrl.CurLines>coins.realBalance) then  begin
                       if (1*GCtrl.CurLines>coins.realBalance) then  begin
 end else Coins.CurBet:=1
 end else Coins.CurBet:=2;
 end else Coins.CurBet:=3;
 end else Coins.CurBet:=4;
 end else Coins.CurBet:=5;
 end else Coins.CurBet:=10;
 end else Coins.CurBet:=15;
 end else Coins.CurBet:=20;
 end else Coins.CurBet:=30;
 end else Coins.CurBet:=40;
 end else Coins.CurBet:=50;
 end else Coins.CurBet:=100;
 end else Coins.CurBet:=150;
 end else Coins.CurBet:=200;
 coins.AllBet:=Coins.CurBet*gctrl.curlines;
end;

    Предположительно, установка текущей ставки в слотовой игре. Но это ещё далеко не самый трэш в этом говнопроекте.

    SadButTrue, 03 Апреля 2018

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

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

    +1

    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
    program bio;
uses crt, graphABC;
const y1=200; r1=20;
var
x2,x3,r:real;

procedure del (x1,x11:integer);
begin
circle (x1,y1,r1); 
sleep(1000); 
ClearWindow();
r:=r1/2;
x2:=x1-(r);
circle (Trunc(x2),y1,Trunc(r));
x3:=x11+(r);
circle (Trunc(x3),y1,Trunc(r));
sleep(1000); 
r:=r*2;
x2:=x1-(r);
circle (Trunc(x2),y1,Trunc(r));
x3:=x11+(r);
circle (Trunc(x3),y1,Trunc(r));
del(Trunc(x2),Trunc(x3));
end;


begin
SetWindowSize(600,400);
setBrushColor(clGreen);
del(300,300);
end.

    Симулятор деления клеток на паскале, который не работает.

    SewerSurfer, 17 Марта 2018

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

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

    +10

    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
    var
 DPen: TGPPen;
 Drawer: TGPGraphics;
 DBrush: TGPSolidBrush;
 DFntFam: TGPFontFamily;
 DPath: TGPGraphicsPath;
 IC,BC:Integer;
 ICL, BCL:TGPColor;
 W:WideString;
 si:TGPRectF;
 rt:TGPRectF;
 GP:TGPPoint;
begin
  W:=FWaterMark.Text;
  IC:=ColortoRGB(FWaterMark.Font.Color);
  BC:=ColorToRGB(FWaterMark.CircuitColor);
  ICl:=MakeColor(GetRValue(IC), GetGValue(IC), GetBValue(IC));
  BCL:=MakeColor(GetRValue(BC), GetGValue(BC), GetBValue(BC));
  Drawer:=TGPGraphics.Create(FBitMap.Canvas.Handle);
  Drawer.SetCompositingQuality(CompositingQualityHighQuality);
  Drawer.SetSmoothingMode(SmoothingModeAntiAlias);
  Drawer.SetTextRenderingHint(TextRenderingHintAntiAlias);
  DPath:=TGPGraphicsPath.Create;
  DPen:=TGPPen.Create(BCL, FWaterMark.FCircuitWidth);
  DBrush:=TGPSolidBrush.Create(ICL);
  DFntFam:=TGPFontFamily.Create(FWaterMark.Font.Name);

  RT.X:=0;
  RT.Y:=0;
  RT.Width:=FBitMap.Width;
  RT.Height:=FBitMap.Height;
  
  DPath.AddString(W, Length(W), DFntFam, FontStyleBold, FWaterMark.Font.Size, GP, TGPStringFormat.Create()); 
  DPath.GetBounds(RT, nil, DPen);
  DPath.Reset; 

//В общем, хз, как узнать ширину и высоту нарисованного.
//MeasureString/MeasureCharacterRanges не подходят,а в доке такая муть, что я чуть не спился.

    Нежнейший аромат...

    Exception, 04 Марта 2018

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

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

    −1

    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
    program voynasharov;
uses crt, graphABC;

type shar = class
 col, x, y, r: integer;
 pm: byte;
 constructor Create (ccol, cx, cy, cr: integer);
  begin
  col:=ccol;
  x:=cx;
  y:=cy;
  r:=cr;
  end;
 procedure make;
  begin
  setbrushcolor (col);
  circle (x,y,r);
  end;
 procedure mov;
 begin
 pm:=random(5);
 case pm of
 1: x:=x+20;
 2: x:=x-20;
 3: y:=y-20;
 4: y:=y+20;
 end;
 end;
end;

var first, second:shar;

begin
 setwindowsize(1280,720);
 first:=shar.Create(666,550,400,60);
 second:=shar.Create(1488,740,300,60);
 first.make;
 second.make;
 repeat
 //clrscr;
 first.mov;
 second.mov;
 first.make;
 second.make;
 delay(50);
 until first.x=70;
end.

    Лёгкий способ наколдовать перекатывание кругов в паскале

    SewerSurfer, 09 Января 2018

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

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

    0

    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
    program sharokat;
uses crt, graphABC;

type shar = class
 col, x, y, r: integer;
 constructor Create (ccol, cx, cy, cr: integer);
  begin
  col:=ccol;
  x:=cx;
  y:=cy;
  r:=cr;
  end;
 procedure make;
  begin
  setbrushcolor (col);
  circle (x,y,r);
  end;
end;

var my:shar;

begin
 my:=shar.Create(666,100,100,60);
 my.make;
end.

    Лёгкий способ наколдовать круг в паскале

    SewerSurfer, 09 Января 2018

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

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

    −1

    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
    uses crt;
var
n, c, d:text;//текстовые переменный сохранений
name:string;//имя игрока
namet, cot, dit:string;//имена файлов 
co,di:real;//переменные в игре
cdi:integer;//переменные с курсом
dif:string;//комманды
pm:byte;//+-курс
col:integer;//выбор количества для продажи
procedure cur; //вывод курса
begin
writeln ('Курс алмаза - ',cdi,' монет(ы)');
end;
procedure newr; //изменение курса
begin
pm:=random(2);//курс алмазов +- в промежутке 5,10
if pm=1 then cdi:=cdi+random(5)+5 else cdi:=cdi-(random(5)+5); 
cur();
end;
procedure buyco;
begin
write ('Сколько алмазов вы обменяете на монеты: ');
readln (col);
if col>di then 
 begin
 writeln ('У вас нет такого количества алмазов, введите меньше');
 write ('Сколько алмазов вы обменяете на монеты: ');
 col:=0;  readln (col);
 end 
 else 
  begin
  co:=co+(di*cdi);  di:=di-col;
  writeln ('Монет: ',co);  writeln ('Алмазов: ',di);
  end;
end;
procedure buydi;
begin
write ('Сколько монет вы обменяете на алмазы: ');
readln (col);
if col>co then 
 begin
 writeln ('У вас нет такого количества монет, введите меньше');
 write ('Сколько монет вы обменяете на алмазы: ');
 col:=0;
 readln (col);
 end 
 else 
  begin
  di:=di+((col*co)/cdi); co:=co-col;  
  writeln ('Монет: ',co); writeln ('Алмазов: ',di);  
  end;
end;
procedure buy;
begin
Writeln ('Введиде "co", если хотите купить монеты'); Writeln ('Введиде "di", если хотите купить алмазы');
Write ('Ввод: '); Readln (dif);
if dif = 'co' then buyco(); if dif = 'di' then buydi();
end;
procedure save;
begin
   assign(n, namet);
   rewrite (n);//cоздаём имена файлов   
   cot:=concat(name,'co.txt');
   dit:=concat(name,'di.txt');   
   {создаём сохранения}assign (c, cot); rewrite(c); co:=5; write(c,co);
   assign (d, dit); rewrite(d); di:=1; write(d,di);
   writeln ('Монет: ',co); writeln ('Алмазов: ',di); writeln ('Игра ',name,' сохранена');      
end;
begin
cdi:=random(20)+10; //Задаём начальный курс
write ('Введите ваше имя: '); readln (name); 
namet:=concat(name,'.txt');
if FileExists(namet) then
  begin
     writeln ('Сохранение ',name,' обнаружено');
     writeln ('Загружается сохранение...');
     assign (n, namet);
     reset(n);     
     cot:=concat(name,'co.txt');
     dit:=concat(name,'di.txt');//"вспомиаем" имена файлов     
     assign (c, cot); reset(c); read(c,co);
     assign (d, dit); reset(d); read(d,di);//загрузка сохранений     
     writeln ('Монет: ',co);
     writeln ('Алмазов: ',di);  //вывод данных из сохранений
  end  
  else 
   begin
   //создаём файл с именем игрока
   writeln ('Сохранение ',name,' не обнаружено'); writeln ('Создаётся сохранение...');   
   save();
   end;
   repeat //бесконечный репит
   write('Введите комманду: ');
   readln(dif);
     case dif of
    'new' : newr(); 'cur' : cur(); 'buy' : buy();'save' : save();   
    else Writeln ('Такой команды нет'); end;  
   until dif='end'; close(n);close(c);close(d);

    Ну вот. Одна из моих первых программ на паскале. Про переводы из одной валюты в другую с учётом курса. Есть даже сохранения.
    Чёрт ногу сломит, я сам уже не понимаю, что тут написал.

    SewerSurfer, 24 Декабря 2017

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

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

    −9

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    {получить I}
function getSafeItoDBID(TEmployer e):Integer;
begin
  if (e<>nil) and (e.getIdentificator()<>nil) and (e.getIdentificator().getID()<>nil) and (e.getIdentificator().getID().getID()<>nil)
    then result:= e.getIdentificator().getID().getID().getValue().i;
    else result:= 0;
end;

    Получить без ERROR ID для записи в MySQL

    AlCodel, 07 Сентября 2017

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