- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
with TfmVersionUpdate.Create(Application) do
begin
try
Init;
except
end;
Free;
end;
Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+4
with TfmVersionUpdate.Create(Application) do
begin
try
Init;
except
end;
Free;
end;
Такой код 100500% отработает без ошибок. Зачем вообще сообщения о них выводить...
+1000
procedure PP.Execute;
begin inherited;
(Sender as TIndusImage).KOT;
end;
В Delphi XE, не знаю с какой версии начиная (в XE7 и XE8 точно) крупные проблемы с TGifImage, а если точнее - если быстро и много их менять, то рано или поздно вываливается тупо всё вместе с интерфейсом (100% где-то в потоках налажали), причем если быстро менять BMP, то всё ОК.
Пришла в голову идея в потоке самому менять кадры анимации, подгружая их как BMP, и дабы затестить сработает ли вообще, начал писать тестовую прогу.
Писал особо не заботясь ни о чем, а потом заметил вот таких индусских котов.
+7
function variant (x0, y0, x1, y1, x2, y2, x3, y3:real):integer;
begin
if (x0<=x1) and (y0<=y1) and (x1<=x2) and (y1<=y2) and (x2<=x3) and (y2<=y3) or
(x0>=x1) and (y0<=y1) and (x1>=x2) and (y1<=y2) and (x2>=x3) and (y2<=y3) or
(x0>=x1) and (y0>=y1) and (x1>=x2) and (y1>=y2) and (x2>=x3) and (y2>=y3) or
(x0>=x1) and (y0<=y1) and (x1>=x2) and (y1<=y2) and (x2>=x3) and (y2<=y3) then variant:=1;
if (x0<=x1) and (y0<=y1) and (x1<=x3) and (y1<=y3) and (x3<=x2) and (y3<=y2) or
(x0>=x1) and (y0<=y1) and (x1>=x3) and (y1<=y3) and (x3>=x2) and (y3<=y2) or
(x0>=x1) and (y0>=y1) and (x1>=x3) and (y1>=y3) and (x3>=x2) and (y3>=y2) or
(x0>=x1) and (y0<=y1) and (x1>=x3) and (y1<=y3) and (x3>=x2) and (y3<=y2) then variant:=2;
if (x1<=x0) and (y1<=y0) and (x0<=x2) and (y0<=y2) and (x2<=x3) and (y2<=y3) or
(x1>=x0) and (y1<=y0) and (x0>=x2) and (y0<=y2) and (x2>=x3) and (y2<=y3) or
(x1>=x0) and (y1>=y0) and (x0>=x2) and (y0>=y2) and (x2>=x3) and (y2>=y3) or
(x1>=x0) and (y1<=y0) and (x0>=x2) and (y0<=y2) and (x2>=x3) and (y2<=y3) then variant:=3;
if (x1<=x0) and (y1<=y0) and (x0<=x3) and (y0<=y3) and (x3<=x2) and (y3<=y2) or
(x1>=x0) and (y1<=y0) and (x0>=x3) and (y0<=y3) and (x3>=x2) and (y3<=y2) or
(x1>=x0) and (y1>=y0) and (x0>=x3) and (y0>=y3) and (x3>=x2) and (y3>=y2) or
(x1>=x0) and (y1<=y0) and (x0>=x3) and (y0<=y3) and (x3>=x2) and (y3<=y2) then variant:=4;
if (x0<=x3) and (y0<=y3) and (x3<=x1) and (y3<=y1) and (x1<=x2) and (y1<=y2) or
(x0>=x3) and (y0<=y3) and (x3>=x1) and (y3<=y1) and (x1>=x2) and (y1<=y2) or
(x0>=x3) and (y0>=y3) and (x3>=x1) and (y3>=y1) and (x1>=x2) and (y1>=y2) or
(x0>=x3) and (y0<=y3) and (x3>=x1) and (y3<=y1) and (x1>=x2) and (y1<=y2) then variant:=5;
if (x0<=x3) and (y0<=y3) and (x3<=x2) and (y3<=y2) and (x2<=x1) and (y2<=y1) or
(x0>=x3) and (y0<=y3) and (x3>=x2) and (y3<=y2) and (x2>=x1) and (y2<=y1) or
(x0>=x3) and (y0>=y3) and (x3>=x2) and (y3>=y2) and (x2>=x1) and (y2>=y1) or
(x0>=x3) and (y0<=y3) and (x3>=x2) and (y3<=y2) and (x2>=x1) and (y2<=y1) then variant:=6;
if (x0<=x2) and (y0<=y2) and (x2<=x1) and (y2<=y1) and (x1<=x3) and (y1<=y3) or
(x0>=x2) and (y0<=y2) and (x2>=x1) and (y2<=y1) and (x1>=x3) and (y1<=y3) or
(x0>=x2) and (y0>=y2) and (x2>=x1) and (y2>=y1) and (x1>=x3) and (y1>=y3) or
(x0>=x2) and (y0<=y2) and (x2>=x1) and (y2<=y1) and (x1>=x3) and (y1<=y3) then variant:=7;
if (x0<=x2) and (y0<=y2) and (x2<=x3) and (y2<=y3) and (x3<=x1) and (y3<=y1) or
(x0>=x2) and (y0<=y2) and (x2>=x3) and (y2<=y3) and (x3>=x1) and (y3<=y1) or
(x0>=x2) and (y0>=y2) and (x2>=x3) and (y2>=y3) and (x3>=x1) and (y3>=y1) or
(x0>=x2) and (y0<=y2) and (x2>=x3) and (y2<=y3) and (x3>=x1) and (y3<=y1) then variant:=8;
if (x1<=x2) and (y1<=y2) and (x2<=x0) and (y2<=y0) and (x0<=x3) and (y0<=y3) or
(x1>=x2) and (y1<=y2) and (x2>=x0) and (y2<=y0) and (x0>=x3) and (y0<=y3) or
(x1>=x2) and (y1>=y2) and (x2>=x0) and (y2>=y0) and (x0>=x3) and (y0>=y3) or
(x1>=x2) and (y1<=y2) and (x2>=x0) and (y2<=y0) and (x0>=x3) and (y0<=y3) then variant:=9;
if (x1<=x3) and (y1<=y3) and (x3<=x0) and (y3<=y0) and (x0<=x2) and (y0<=y2) or
(x1>=x3) and (y1<=y3) and (x3>=x0) and (y3<=y0) and (x0>=x2) and (y0<=y2) or
(x1>=x3) and (y1>=y3) and (x3>=x0) and (y3>=y0) and (x0>=x2) and (y0>=y2) or
(x1>=x3) and (y1<=y3) and (x3>=x0) and (y3<=y0) and (x0>=x2) and (y0<=y2) then variant:=10;
if (x2<=x0) and (y2<=y0) and (x0<=x1) and (y0<=y1) and (x1<=x3) and (y1<=y3) or
(x2>=x0) and (y2<=y0) and (x0>=x1) and (y0<=y1) and (x1>=x3) and (y1<=y3) or
(x2>=x0) and (y2>=y0) and (x0>=x1) and (y0>=y1) and (x1>=x3) and (y1>=y3) or
(x2>=x0) and (y2<=y0) and (x0>=x1) and (y0<=y1) and (x1>=x3) and (y1<=y3) then variant:=11;
if (x2<=x1) and (y2<=y1) and (x1<=x0) and (y1<=y0) and (x0<=x3) and (y0<=y3) or
(x2>=x1) and (y2<=y1) and (x1>=x0) and (y1<=y0) and (x0>=x3) and (y0<=y3) or
(x2>=x1) and (y2>=y1) and (x1>=x0) and (y1>=y0) and (x0>=x3) and (y0>=y3) or
(x2>=x1) and (y2<=y1) and (x1>=x0) and (y1<=y0) and (x0>=x3) and (y0<=y3) then variant:=12;
end;
Источник: http://e-olimp.blogspot.com/2013/08/12.html
+139
s:=0; k:=1;
while s<200 do begin
s:=s+3*k;
end;
if s<200 then begin
k:=k+1;
end;
Ничего такого..
+144
Unit Web;
interface
uses System, System.Drawing, System.Windows.Forms;
var f: Form;
type
WebBro = class(Form)
procedure button1_Click(sender: Object; e: EventArgs);
{$region FormDesigner}
private
{$resource Web.WebBro.resources}
button1: Button;
webBrowser1: WebBrowser;
{$include Web.WebBro.inc}
{$endregion FormDesigner}
public
constructor;
begin
InitializeComponent;
end;
end;
implementation
Procedure FindForm();
begin
var i:=0;
while i < Application.OpenForms.Count do
begin
f := Application.OpenForms.Item[i];
if f.Name = 'TwiGen_News' then exit
else inc(i);
end;
end;
procedure WebBro.button1_Click(sender: Object; e: EventArgs);
begin
WebBro.ActiveForm.Hide();
FindForm;
f.Show();
end;
end.
//----------------
Unit Unit1;
interface
uses System, System.Drawing, System.Windows.Forms, Web;
var NewsForm: WebBro;
type
TwiGen_News = class(Form)
procedure News_Click(sender: Object; e: EventArgs);
{$region FormDesigner}
private
{$resource Unit1.TwiGen_News.resources}
LogIn: Button;
News: Button;
Reg: Button;
{$include Unit1.TwiGen_News.inc}
{$endregion FormDesigner}
public
constructor;
begin
InitializeComponent;
end;
end;
implementation
procedure TwiGen_News.News_Click(sender: Object; e: EventArgs);
begin
TwiGen_News.ActiveForm.Hide();
NewsForm := new WebBro;
NewsForm.Show;
end;
end.
Друг писал, но мне он говорил, что переписывал говнокод.
Pascal ABC.NET.
+142
type
TForm1 = class(TForm)
IBDB1: TIBDatabase;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
IBTransaction1: TIBTransaction;
Pochtamt: TIBQuery;
DSOPS: TDataSource;
Detal: TIBQuery;
DSDetal: TDataSource;
IBQuery1: TIBQuery;
ListBox1: TListBox;
N3: TMenuItem;
RabMesto: TIBQuery;
DSRabMesto: TDataSource;
IdIPWatch1: TIdIPWatch;
DBGrid2: TDBGrid;
Panel1: TPanel;
Button2: TButton;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Label6: TLabel;
Edit4: TEdit;
Button3: TButton;
PMOPS: TPopupMenu;
N6: TMenuItem;
N7: TMenuItem;
PMRabMesto: TPopupMenu;
N9: TMenuItem;
N10: TMenuItem;
ListBox2: TListBox;
Label14: TLabel;
Label15: TLabel;
Button6: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Panel2: TPanel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Button4: TButton;
Memo1: TMemo;
Button5: TButton;
Edit6: TEdit;
DBGrid1: TDBGrid;
Label1: TLabel;
DBMemo1: TDBMemo;
Label16: TLabel;
// DBGrid2: TDBGrid;
TabSheet3: TTabSheet;
N11: TMenuItem;
Label18: TLabel;
Label9: TLabel;
Edit7: TEdit;
Label10: TLabel;
MaskEdit1: TMaskEdit;
MaskEdit2: TMaskEdit;
TabSheet5: TTabSheet;
N12: TMenuItem;
LSostav: TIBQuery;
DSLSostav: TDataSource;
DBGrid4: TDBGrid;
ListBox3: TListBox;
PMLSostav: TPopupMenu;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
Panel3: TPanel;
Label22: TLabel;
Edit2: TEdit;
Label23: TLabel;
Edit8: TEdit;
Label24: TLabel;
MaskEdit3: TMaskEdit;
MaskEdit4: TMaskEdit;
MaskEdit5: TMaskEdit;
Label25: TLabel;
Label26: TLabel;
MaskEdit6: TMaskEdit;
Label27: TLabel;
Button7: TButton;
Button8: TButton;
Label28: TLabel;
Edit9: TEdit;
Label29: TLabel;
Edit10: TEdit;
UpDown1: TUpDown;
Label30: TLabel;
Edit11: TEdit;
Edit12: TEdit;
Label31: TLabel;
Label32: TLabel;
Button9: TButton;
N16: TMenuItem;
Там еще 400 строк объявления компонентов формы и процедур и функций с аналогичными названиями...
+141
function GetArgs(const str:string):string;
begin
result:=strpas(pathgetargs(pchar(str))); //UB
end;
result:=strpas(pathgetargs(pchar(str))); //UB
Плохой мальчик.
+143
function CopyEx(s:string; index,count:integer):string;
var
len,ln:integer;
begin
ln:=0;
if index <1 then index:=1;
len:=length(s);
ln:=len-count;
dec(ln);
dec(len,(index+ln));
result:=copy(s,index,len);
end;
+144
cs_zagl.Edit;
cs_zagl.fieldbyname('count_z').asinteger:=cs_tab.RecordCount;
cs_zagl.Post;
cs_mk.Edit;
cs_mk.FieldByName('med_kart_id').Asinteger:=select_row_Form.ClientDataSet1.FieldByName('id_kart').asinteger;
cs_mk.FieldByName('id_kart_public').Asinteger:=select_row_Form.ClientDataSet1.FieldByName('id_kart_public').asinteger;
cs_mk.FieldByName('id_pac').Asinteger:=select_row_Form.ClientDataSet1.FieldByName('id_pac').asinteger;
cs_mk.FieldByName('type_kart').asinteger:=select_row_Form.ClientDataSet1.FieldByName('type_kart').asinteger;
cs_mk.post;
IF (cs_mk.FieldByName('med_kart_id').Value=0) or (cs_mk.FieldByName('type_kart').asinteger<>27) then begin
cmd := VarArrayCreate([0,20],varVariant);
cmd[1] := 6832;
cmd[2] := 17;
cmd[5] := 1;
cmd[6] := 0;
ProvOptions := [grMetadata, grReset];
cmd[7] := dsp_mk.GetRecords(-1, RecsOut, Byte(ProvOptions));
try
rez := MainFormInterface.EXT_call_server('spr_read', cmd);
cs_tab.Edit;
cs_tab.FieldByName('med_kart_id').Asinteger:=rez[3];
cs_tab.Post;
if rez[1] < 0 then begin
debug_sql('Ошибка: ' + varastype(rez[1], varstring), 2);
MessageDlg('Ошибка: '+ #10 + #13 +
varastype(rez[1],varstring),mtError,[mbok],0);
Exit;
end;
except
on e:exception do
begin
MessageDlg(ERROR_MESS_5 + 'Исключение:' + E.ClassName + 'Mess:' + E.Message, mterror, [mbok], 0);
debug_sql('Ошибка записи документа!', 2);
debug_all('Err при записи документа тип=' + varastype(cmd[1], varstring)+
' id=' + inttostr(id_doc) + 'Исключение:' + E.ClassName + 'Mess:' + E.Message,2);
end;
end;
end;
end else begin
end;
end
else exit;
end else
begin
id_pac:=rez[3];
id_med_kart:=rez[2];
Application.MessageBox(pchar('Ошибка: '+#10+#13+
'Даный пациент не найден!!!'),pchar(application_title_short),MB_OK+MB_ICONERROR);
exit;
end;
end;
Это называется стиль
+142
TCompareType = (ctGT, ctGE, ctLT, ctLE, ctEQ, ctNE, ctIsIn, ctNIsIn,
ctLike, ctNLike, ctNull, ctNNull, ctBetween, ctNotBetween, ctExists,
ctNotExists);
Преклоняюсь перед истинным ниндзя. Ходил не обращал на ...код, но видимо я осознал глубокий смысл этого пути).