1. 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)

  2. 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)

  3. 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)

  4. 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)

  5. 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)

  6. 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)

  7. 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)

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

    +106

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

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

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

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

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

    +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
    var sum,x1,x2,y1,y2,i,k,l,m,n:longint;
a:array[1..1000,1..2] of longint;
b:array[1..100,1..100] of longint;

procedure ws(x,y,c:longint);
var k:longint;
begin
  if (not((x-2<1)or(y-1<1)or(x-2>n)or(y-1>N))and(b[x-2,y-1]=0)) then begin inc(m);a[m,1]:=x-2;a[m,2]:=y-1;b[x-2,y-1]:=b[x,y]+1;end;
  if (not((x+2<1)or(y-1<1)or(x+2>n)or(y-1>N))and(b[x+2,y-1]=0)) then begin inc(m);a[m,1]:=x+2;a[m,2]:=y-1;b[x+2,y-1]:=b[x,y]+1;end;
  if (not((x-1<1)or(y-2<1)or(x-1>n)or(y-2>N))and(b[x-1,y-2]=0)) then begin inc(m);a[m,1]:=x-1;a[m,2]:=y-2;b[x-1,y-2]:=b[x,y]+1;end;
  if (not((x+1<1)or(y-2<1)or(x+1>n)or(y-1>N))and(b[x+1,y-2]=0)) then begin inc(m);a[m,1]:=x+1;a[m,2]:=y-2;b[x+1,y-2]:=b[x,y]+1;end;
  if (not((x-2<1)or(y+1<1)or(x-2>n)or(y+1>N))and(b[x-2,y+1]=0)) then begin inc(m);a[m,1]:=x-2;a[m,2]:=y+1;b[x-2,y+1]:=b[x,y]+1;end;
  if (not((x+2<1)or(y+1<1)or(x+2>n)or(y+1>N))and(b[x+2,y+1]=0)) then begin inc(m);a[m,1]:=x+2;a[m,2]:=y+1;b[x+2,y+1]:=b[x,y]+1;end;
  if (not((x-1<1)or(y+2<1)or(x-1>n)or(y+2>N))and(b[x-1,y+2]=0)) then begin inc(m);a[m,1]:=x-1;a[m,2]:=y+2;b[x-1,y+2]:=b[x,y]+1;end;
  if (not((x+1<1)or(y+2<1)or(x+1>n)or(y+2>N))and(b[x+1,y+2]=0)) then begin inc(m);a[m,1]:=x+1;a[m,2]:=y+2;b[x+1,y+2]:=b[x,y]+1;end;
end;

begin
reset(input,'input.txt');
rewrite(output,'output.txt');
read(n);
read(x1,y1);
read(x2,y2);
b[1,1]:=0;
a[1,1]:=x1;a[1,2]:=y1;
i:=0;m:=1;l:=1;
while i<=m do begin inc(i);
  ws(a[i,1],a[i,2],i);
end;
write(b[x2,y2]);
close(input);
close(output);
end.

    вот он, венец человеческого ума - рабочий поиск в ширину без использования рекурсии, написал сам, меня очень просили запостить тут))

    faraon124, 24 Декабря 2010

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

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

    +92

    1. 1
    2. 2
    Result := not FExecuting;
if not Result then Exit;

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

    ageron, 23 Декабря 2010

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