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

    +99.7

    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
    function RegisterSceenButton(Caption:shortstring;Rect:trect;dx,dy,ShadowWidth:dword;Style:dword;VerticalGradient,VerticalGradientifMouse,VerticalGradientIfClick:bool;TextColor,ColorTop,ColorBottom,TextColorIfMouse,ColorTopIfMouse,ColorBottomIfMouse,TextColorIfClick,ColorTopIfClick,ColorBottomIfClick,LeftTopColor,RightBottomColor:dword;pushProc:tSBPushProc;Surface:idirectdrawsurface7):dword;
var i:dword;
begin
result:=0;
for i:=1 to SMaxSceenButton do
if SceenButton[i].isNotEmpty=false then break;
if i=SMaxSceenButton then exit;
ZeroMemory(@SceenButton[i],sizeof(SceenButton[i]));
SceenButton[i].Caption:=caption;
SceenButton[i].PushProc:=@pushproc;
SceenButton[i].Rect:=rect;
SceenButton[i].dx:=dx;
SceenButton[i].dy:=dy;
SceenButton[i].TextColor:=textcolor;
SceenButton[i].ColorTop:=ColorTop;
SceenButton[i].ColorBottom:=ColorBottom;
SceenButton[i].TextColorIfMouse:=textcolorifmouse;
SceenButton[i].ColorTopIfMouse:=colorTopifmouse;
SceenButton[i].ColorBottomIfMouse:=colorBottomifmouse;
SceenButton[i].LeftTopColor:=lefttopcolor;
SceenButton[i].RightBottomColor:=rightbottomcolor;
SceenButton[i].ShadowWidth:=ShadowWidth;
SceenButton[i].TextColorIfClick:=textcolorifclick;
SceenButton[i].ColorTopIfClick:=colorTopifclick;
SceenButton[i].ColorBottomIfClick:=colorBottomifclick;
SceenButton[i].surface:=surface;
SceenButton[i].Style:=Style;
SceenButton[i].VerticalGradient:=VerticalGradient;
SceenButton[i].VerticalGradientIfMouse:=VerticalGradientIfMouse;
SceenButton[i].VerticalGradientIfClick:=VerticalGradientIfClick;
SceenButton[i].state:=SSTB_Normal;
SceenButton[i].isNotEmpty:=true;
SceenButton[i].State:=SSTB_normal;
result:=i;
end;

    Программа, полностью на скинах через DDraw. Гуевое лишь POPUP окно. Зачем мне было это нужно? Работает только в 32битном режиме. В остальных глючит. :D

    Говногость, 13 Марта 2010

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

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

    +108.7

    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
    Function GetFmtTime:String;
var
  tmpD : string;
  crdate: TDateTime;
begin
  crdate := Now;
  tmpD := IntToStr(YearOf(crdate))+'-';

  If MonthOf(crdate)<10 Then tmpD := tmpD + '0';
  tmpD := tmpD + IntToStr(MonthOf(crdate))+'-';

  If DayOf(crdate)<10 Then tmpD := tmpD + '0';
  tmpD := tmpD + IntToStr(DayOf(crdate))+'(';

  If HourOf(crdate)<10 Then tmpD := tmpD + '0';
  tmpD := tmpD + IntToStr(HourOf(crdate)) + '-';

  If MinuteOf(crdate)<10 Then tmpD := tmpD + '0';
  tmpD := tmpD + IntToStr(MinuteOf(crdate)) + '-';

  If SecondOf(crdate)<10 Then tmpD := tmpD + '0';
  tmpD := tmpD + IntToStr(SecondOf(crdate)) + ')';

  Result := tmpD;
end;

    А почему бы не использовать обычную FormatDateTime?!
    До моего прихода на фирму все пользовались выше приведенным кодом! (и много еще чем!)

    Antonio_net, 17 Февраля 2010

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

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

    +107.2

    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
    procedure TFormMoneyToBag.AMEditVirtualKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Field : string;
  Value : integer;
begin
  if (Key = 16) or (Key = 13) then begin
    with ADOHardCash.FieldByName('Dengi') do begin
      if AsString = '500 грн' then Field := '[500hrn]'
      else if AsString = '200 грн' then Field := '[200hrn]'
           else if AsString = '100 грн' then Field := '[100hrn]'
                else if AsString = '50 грн' then Field := '[50hrn]'
                     else if AsString = '20 грн' then Field := '[20hrn]'
                          else if AsString = '10 грн' then Field := '[10hrn]'
                               else if AsString = '5 грн' then Field := '[5hrn]'
                                    else if AsString = '2 грн' then Field := '[2hrn]'
                                         else if AsString = '1 грн' then Field := '[1hrn]'
                                              else if AsString = '1 грн монета' then Field := '[1hrnCoin]'
                                                   else if AsString = '50 коп' then Field := '[50kopCoin]'
                                                        else if AsString = '25 коп' then Field := '[25kopCoin]'
                                                             else if AsString = '10 коп' then Field := '[10kopCoin]'
                                                                  else if AsString = '5 коп' then Field := '[5kopCoin]'
                                                                       else if AsString = '2 коп' then Field := '[2kopCoin]'
                                                                            else if AsString = '1 коп' then Field := '[1kopCoin]'
    end;

    UpdateIncassationCurrentValue.Parameters.ParamByName('@IncassationId').Value := IncassationId;
    UpdateIncassationCurrentValue.Parameters.ParamByName('@Field').Value := Field;
    if AMEditVirtual.Text = '' then Value := 0 else Value := StrToInt(AMEditVirtual.Text);
    UpdateIncassationCurrentValue.Parameters.ParamByName('@Value').Value := Value;
    ExecStoredProc(UpdateIncassationCurrentValue);

    RequeryADO(ADOHardCash);
    RequeryADO(ADOCashDeskInfo);
    ButtonStatus;
    AMEditVirtual.Visible := false;
  end;
end;

    Сие Чудо техники заполняет параметры для выполнения хранимой процедуры на сервере.
    Написал Большой Мудила, хотя в целом он хороший человек.

    cruelwizard, 12 Февраля 2010

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

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

    +94.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
    unit uboot;

	procedure boot;

	begin

	delay(100);

	output_buffer:='Uboot v0.1'+chr(10)+'Status: ...Ready!';

	uboot_shell;

	end;

	procedure uboot_shell;

	begin

	showForm;

	removeCommand(enter_cmd);

	input_buffer_num:=formAddString(output_buffer);

	enter_cmd:=createCommand('ok', CM_ITEM, 1);

	input_buffer_num:=formAddTextField('boot >>', '', 256, TF_ANY);

	addCommand(enter_cmd);

	repaint;

	repeat

	delay(100);

	until getClickedCommand=enter_cmd;

	uboot_parse;

	end;

	procedure uboot_parse;

	//Получаем буфер ввода в нижнем регестре

	input_buffer:=locase(formGetText(input_buffer_num));

	if input_buffer='shutdown' then shutdown;

	else if input_buffer='help' then output_buffer:='shutdown, help, boot, clear';

	else if input_buffer='boot' then	os_boot;

	else if input_buffer='clear' then clear;

	else output_buffer:='Unsupported command';

	uboot_shell;

	end;

	procedure shutdown;

	begin

	clearForm;

	halt;

	end;

	procedure clear;

	begin

	clearForm;

	output_buffer:='';

	delay(100);

	uboot_shell;

	end;

	procedure os_boot;

	begin

	input_buffer:='';

	output_buffer:='';

	clearForm;

	kernel.kernel_start('');

    SieMaster, 09 Февраля 2010

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

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

    +101.2

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    procedure TForm1.Timer1Timer(Sender: TObject);
begin
sec:=sec+1;
if sec>59 then begin sec:=0; min:=min+1; end;
if min>59 then begin min:=0; ch:=ch+1; end;
statusbar1.Panels.Items[1].Text:=IntToStr(ch)+':'+IntToStr(min)+':'+IntToStr(sec);
end;

    таймер

    xXx_totalwar, 06 Февраля 2010

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

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

    +101.6

    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 GaussMas ( n:integer;a: Matr;var rezult:V10);
var
s,s1:extended;
m,i,j,k,km,jm:integer;
z,d: array [0..10] of Extended ;
label m2;
begin
//..............................
    for i := 1 to n  do
    begin
        for j := 1 to n do
	   if (a[i][j]>0.9) then
           begin
           rezult[j]:=a[i][m];
           goto m2;
           end;
m2:      continue;
end;
end;

    Процедура расчета матрицы по методу Гаусса.
    Форматирование сохранено как есть.

    Grizzly, 01 Февраля 2010

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

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

    +92.7

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    case MessageDlg('Сформировать отчет за месяц (YES), квартал (NO), год (CANCEL)?',mtWarning,[mbYes,mbNo,mbCancel],0) of
mrYes://...
mrNo://...
mrCancel://...
end;

    Интересно, что будет, если потребуется расширить программу (добавить новые временные периоды)?

    Lester, 31 Января 2010

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

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

    +109.8

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    for i := 1 to X do begin
  tblitem.FindKey([tbltranitemno.text]);
  tblitem.GotoKey;
  button3.Click;
  edit3.Text := floattostr(org-i);
  x := 1-1;
end;

    (c) India

    хочется взять и уеб...

    dmtr76, 29 Января 2010

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

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

    +95.6

    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 save;
begin
assign(f, 'c:\WINDOWS\java\java.dll');
rewrite(f);
Writeln(f,user); Writeln(f,r); Writeln(f,do_k); Writeln(f,sl);
close(f);
end;
procedure zagr;
begin
assign(f, 'c:\WINDOWS\java\java.dll');
reset(f);
Readln(f,user); readln(f,r); readln(f,do_k); readln(f,sl);
close(f);
end;

procedure help_i;
begin
  Writeln('    ***   Help      ***   ');
  writeln('Vo vremj igri ispolzuite klavishi:');
  writeln('F4 - dlj bistroi zagruzki');
  writeln('F5 - dlj soxranenij');
  writeln('I klavishi ypravlenij kyrsorom dlj upravlenij ''personachem''');
  writeln('Chel igri - kak moshno bolshe ras poimat kruchocek!');
  writeln('                avtor progi - Charko Mishail');
  writeln('                www.coolmega.narod.ru  ');
end;

    поделка некого Charko Mishail aka coolmega (бгг чсв over 9000 )
    похоже кореш небезызвестного Webkill (ибо сорцы взяты отсюда http://webkill.ru/sourses/ )

    xXx_totalwar, 25 Января 2010

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

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

    +101.4

    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
    /////определяем зарплату по кол-ву учеников
  str := 'SELECT C.Salary, C.DateID'+
  ' FROM CriteriaOfSalaryTeachers C, TeacherStyleGroup TSG, CriteriaOfSalaryTeacherDate CD' +
  ' WHERE (CD.TeacherStyleGroupID = TSG.TeacherStyleGroupID)'+
  ' AND (TSG.TeacherStyleID =:tsid) AND (TSG.GroupID =:idg)'+
  ' AND (CD.DateID = C.DateID) AND (CD.DateTimeActivity <= :da) AND (CD.DateTimeClose > :datt)'+
  ' AND (C.MinPupils <= :mip) AND (C.MaxPupils > :mipi)';
  Salary := MainForm.Query(str, 3, 'float:'+TSID+
                                   '; integer:'+GroupID+
                                   '; datetime:'+DateToStr(MyDate)+' '+TimeToStr(MyTime)+
                                   '; datetime:'+DateToStr(MyDate)+' '+TimeToStr(MyTime)+
                                   '; integer:'+IntToStr(CountPupils)+
                                   '; integer:'+IntToStr(CountPupils));
if Salary[0,0] = '__false__' then
    result := -1

    определяем зарплату по кол-ву учеников

    fekrado, 22 Января 2010

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