Pascal — Говнокод.ру

Pascal / Говнокод #4249

+101

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

type
  // смотрите, как не надо делать и почему придумали ООП
  TProc = procedure;
  TGoProc = function: boolean;
  TSizeProc = function: integer;
  TGetConfigProc = function: string;
  TApplyConfigProc = procedure(SM: PStringMap);

  TDeviceProc = record
    InitControls: TProc;
    MoveControls: TProc;
    Go: TGoProc;
    MaxH, MinH: TSizeProc;
    GetConfig: TGetConfigProc;
    ApplyConfig: TApplyConfigProc;
  end;

const
  DeviceProcs: array [TDevice] of TDeviceProc = (
    (InitControls: ETR.InitControls; MoveControls: ETR.MoveControls; Go: ETR.Go; MaxH: ETR.MaxH; MinH: ETR.MinH; GetConfig: ETR.GetConfig; ApplyConfig: ETR.ApplyConfig),
    (InitControls: TS_NSH.InitControls; MoveControls: TS_NSH.MoveControls; Go: TS_NSH.Go; MaxH: TS_NSH.MaxH; MinH: TS_NSH.MinH; GetConfig: TS_NSH.GetConfig; ApplyConfig: TS_NSH.ApplyConfig),
    (InitControls: TS_IND.InitControls; MoveControls: TS_IND.MoveControls; Go: TS_IND.Go; MaxH: TS_IND.MaxH; MinH: TS_IND.MinH; GetConfig: TS_IND.GetConfig; ApplyConfig: TS_IND.ApplyConfig),
    (InitControls: TP_NSH.InitControls; MoveControls: TP_NSH.MoveControls; Go: TP_NSH.Go; MaxH: TP_NSH.MaxH; MinH: TP_NSH.MinH; GetConfig: TP_NSH.GetConfig; ApplyConfig: TP_NSH.ApplyConfig),
    (InitControls: TP_IND.InitControls; MoveControls: TP_IND.MoveControls; Go: TP_IND.Go; MaxH: TP_IND.MaxH; MinH: TP_IND.MinH; GetConfig: TP_IND.GetConfig; ApplyConfig: TP_IND.ApplyConfig)
  );

Вот до чего доводит ненависть к ООП.
ОПП - это хорошо, ООП не надо ненавидеть.

TarasB, 14 Сентября 2010

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

Pascal / Говнокод #4232

+105

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

implementation
uses Unit1,Unit2,Unit3,Unit4,Unit5,Unit6,Unit7,Unit8;
{$R *.dfm}
var
k,Zst,zk,Vm12,Vm23,Vm34,Vm45,Vm56,Z2pr,Z3pr,Z4pr,Z5pr,Z6pr,Lm12,Lm23,Lm34,Lm45,Lm56,Vk,Vst,Q,q11,q2ob,q3ob,q4ob,q5ob,q6ob,
Sst,P1st,P2st,p0k,p12k,p23k,p34k,p45k,p56k,L0,Dk,Dst,H,Hst: real;
J0,j, i: integer;
const a=1.1; g=9.81; Y=0.03; x1=605; Y1=48; X2=772; Y2=104;
x3=627; Y3=107; X4=646; Y4=379;
x5=X3; Y5=194; X6=576; Y6=200;
x7=582; Y7=193; X8=576;
x9=X3; Y9=285; X10=526; Y10=291;
x11=532; Y11=284; X12=X10;
x13=650; Y13=380; X14=395; Y14=399;
x15=479; Y15=377; X16=473;
x17=394; Y17=Y13; X18=314; Y18=Y14;
x19=398; Y19=Y15; X20=392;
x21=314; Y21=Y13; X22=233; Y22=Y14;
x23=317; Y23=Y15; X24=311;
x25=233; Y25=Y13; X26=152; Y26=Y14;
x27=235; Y27=Y15; X28=229;
x29=152; Y29=Y13; X30=70; Y30=Y14;
x31=154 ; Y31=Y15; X32=148;
X33=70;Y33=Y13;X34=3;Y34=Y14;
X35=72;Y35=Y15;X36=66;
procedure TForm9.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form9.visible:=false;
end;

куча Паскаля

bugmenot, 12 Сентября 2010

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

Pascal / Говнокод #4191

+105

01
02
03
04
05
06
07
08
09
10
11
12
13

type
  THackImage = class(TGraphicControl)
  public
    property Canvas;
  end;

procedure TColorPicker.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  {$IFDEF HACKS}
  Assert(Sender is TImage, 'в Sender всегда передается экземпляр класса TImage');
  FSelectedColor := THackImage(Sender).Canvas.Pixels[X, Y];
  {$ELSE}
  (* то, что было лень писать сразу *)

Говнистая работа с библиотекой VCL. Не притрагивался к проекту около года, потом загрузил и почти час втыкал, за каким этот грёбаный хак здесь нужен.

bugmenot, 07 Сентября 2010

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

Pascal / Говнокод #4004

+92

1
2
3
4

if (x>13)or(x<13)or(x=13) then begin writeln('введено невероное значение X');halt end else begin
//Расчёт уравнения
..........
end;

в лабе в студента увидел o_O
конечно он получил 2 за лабу
но ка пример какокода супер

adli__82, 17 Августа 2010

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

Pascal / Говнокод #3864

+98

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

procedure TfmAllParams.NInsertParamSelebrationClick(Sender: TObject);
var
  str: string;
begin
  str := //Новый год
    ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '01.01.' + IntToStr(YearOf(GetServerDate)) + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,selebration_state,text_selebration,selebration_year)' +
    ' values(1,1,null,null,null) ' +
        //День св. Валентина
  ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '14.02.' + IntToStr(YearOf(GetServerDate)) + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,selebration_state,text_selebration,selebration_year)' +
    ' values(14,2,null,null,null) ' +
        //8 марта
  ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '08.03.' + IntToStr(YearOf(GetServerDate)) + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,selebration_state,text_selebration,selebration_year)' +
    ' values(8,3,' + #39 + 'жін.' + #39 + ',null,null) ' +
        //1 мая
  ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '01.05.' + IntToStr(YearOf(GetServerDate)) + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,selebration_state,text_selebration,selebration_year)' +
    ' values(1,5,null,null,null) ' +
        //Пасха
  ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '04.04.2010' + #39 + ' and text_selebration=' + #39 + 'Pasha' + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,text_selebration,selebration_year)' +
    ' values(4,4,' + #39 + 'Pasha' + #39 + ',2010) ' +

  ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '24.04.2011' + #39 + ' and text_selebration=' + #39 + 'Pasha' + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,text_selebration,selebration_year)' +
    ' values(24,4,' + #39 + 'Pasha' + #39 + ',2011) ' +

   // И 10 таких же запросов на каждый год!

  ' if not exists (select id from sta_param_selebration ' +
    '            where date_selebration=' + #39 + '24.04.2022' + #39 + ' and text_selebration=' + #39 + 'Pasha' + #39 + ')' +
    ' insert into sta_param_selebration (selebration_day, selebration_month ,text_selebration,selebration_year)' +
    ' values(24,4,' + #39 + 'Pasha' + #39 + ',2022) ' +

stokito, 03 Августа 2010

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

Pascal / Говнокод #3831

+94

1
2
3
4
5
6
7
8

if MessageDlg('Удалить проводку №'+srcTransact.DataSet.FieldByName('Trans_ID').AsString+' и ее спецификацию?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    CMD.SQL.Add('EXEC dbo.asp_DelTransact '+srcTransact.DataSet.FieldByName('Trans_ID').AsString );
    CMD.Execute;
    _refresh(srcTransact.DataSet);
  end;
end;

Из реального проекта (учётная система).
При определённых условиях можно удалить не только то что пользователь собирался удалить :).
Да и вообще, сам код - говно.

Fes, 30 Июля 2010

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

Pascal / Говнокод #3764

+120

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

begin
   if not directoryexists('input') then createdir('input');
   if not directoryexists('output') then createdir('output');
   if not directoryexists('temp') then createdir('temp');
   if not directoryexists('temp\temp') then createdir('temp\temp');
   if not directoryexists('temp\temp_') then createdir('temp\temp_');
   if not directoryexists('temp\temp__') then createdir('temp\temp__');
   if not directoryexists('temp\temp___') then createdir('temp\temp___');
   if not directoryexists('temp\temp____') then createdir('temp\temp____');
   if not directoryexists('temp\temp_____') then createdir('temp\temp_____');
   if not directoryexists('temp\temp______') then createdir('temp\temp______');
   if not directoryexists('temp\temp_______') then createdir('temp\temp_______');
   if not directoryexists('temp\temp________') then createdir('temp\temp________');
   if not directoryexists('temp\temp_________') then createdir('temp\temp_________');
   if not directoryexists('temp\temp__________') then createdir('temp\temp__________');
   if not directoryexists('temp\temp___________') then createdir('temp\temp___________');
   if not directoryexists('temp\temp____________') then createdir('temp\temp____________');
   if not directoryexists('temp\temp_____________') then createdir('temp\temp_____________');
   if not directoryexists('temp\temp______________') then createdir('temp\temp______________');
   if not directoryexists('temp\temp_______________') then createdir('temp\temp_______________');
   if not directoryexists('temp\temp________________') then createdir('temp\temp________________');
   print_('Вас приветствует программа для сортировки слвоарей True Sort');
   print_('Если у вас есть какие-то вопросы по её работе - нажмите Help');
   turbo:=false;
end;

Кинул знаковый в асю=\

BlincAttack, 23 Июля 2010

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

Pascal / Говнокод #3750

+108

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

...
var
 fileName  :string;                // имя файла
 mes       :string;                // текст мессаги
 capt      :string;                // заголовок мессаги
 f         :thandle;
 fils      :integer;
 BytesRead :D WORD;
 c         :byte;
begin
 writeln('enter filename:');      // просим ввести имя файла
 readln(fileName);                // в fileName заносим имя файла
 if not fileexists(fileName) then // если он несуществует
  begin
  writeln('file not found :( ');   // виводит предупреждение
  readln;
  exit;                           // закриваем прогу
  end;
 writeln('');                              // просим ввесли текст мессаги
 writeln('enter message text (max 10):');  // максмальна длина 10 символов(так как в Project1.exe для нее зарезирвировано 10 байт) потому что длина HelloWorld=10
 readln(mes);
 writeln('');                                 // просим ввести заголовок мессаги
 writeln('enter message caption (max 10):');  // опять максимальная длина 10 символов
 readln(capt);

 f:=fileopen(fileName,fmOpenReadWrite);  // откриваем fileName
 fils:=Windows.GetFileSize(f,nil);       // получаем размер
 writeln('size = '+inttostr(fils)+'b');  // виводим размер

 // патчим байти для мессаги
 // $2848,$2849,$284A,$284B,$284C,$284D,$284E,$284F,$2850,$2851
 c:=ord(char(pchar(mes[1])));             // патчим первий байт
 SetFilePointer(f, $2848, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[2])));             // патчим второй (2) байт
 SetFilePointer(f, $2849, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[3])));             // патчим 3 байт
 SetFilePointer(f, $284A, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[4])));             // патчим 4 байт;
 SetFilePointer(f, $284B, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[5])));             // патчим 5 байт
 SetFilePointer(f, $284C, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[6])));             // патчим 6 байт
 SetFilePointer(f, $284D, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[7])));             // патчим 7 байт
 SetFilePointer(f, $284E, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[8])));             // патчим 8 байт
 SetFilePointer(f, $284F, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[9])));             // патчим 9 байт
 SetFilePointer(f, $2850, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(mes[10])));             // патчим 10 байт
 SetFilePointer(f, $2851, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 // патчим байти для заголовка мессаги
 // адреса с $283C до $2845
 c:=ord(char(pchar(capt[1])));            // патчим первий байт
 SetFilePointer(f, $283C, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(capt[2])));            // патчим второй байт
 SetFilePointer(f, $283D, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(capt[3])));            // третий символ и так дальше
 SetFilePointer(f, $283E, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(capt[4])));
 SetFilePointer(f, $283F, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);

 c:=ord(char(pchar(capt[5])));
 SetFilePointer(f, $2840, nil, 0);
 WriteFile(f, c, SizeOf(c), BytesRead, nil);
...

Где-то нашёл =(

BlincAttack, 21 Июля 2010

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

Pascal / Говнокод #3729

+115

1
2
3
4
5
6
7
8
9

Function isEQ(x,y : Real) : Boolean;
Begin
if(x = y) Then isEQ := True Else isEQ := False;
End;


Begin
{...}
End.

Не выспался...

x0wl, 18 Июля 2010

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

Pascal / Говнокод #3721

+97

01
02
03
04
05
06
07
08
09
10
11
12
13

procedure TStdMessageInfo.Build(pMessage: String; pKind: Integer);
var List: TStringList;
begin
  List := TStringList.Create;
  try {!!! это такой хитрый способ заменить #13 на #13#10}
    List.Text := pMessage;
    if List.Count = 1 then FMessage := List[0]
    else FMessage := List.Text;
  finally
    List.Free;
  end;
  FKind := pKind;
end;

borka, 16 Июля 2010