Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+110
DataModule1.QueryPlayers.Close;
DataModule1.QueryPlayers.SQL.Text:='select fp_id, fp_familiya, fp_imya, fp_otchestvo, FP_DATE_ZAKLUCHENIYA_CONTRAKTA, FP_DATE_OKONCHANIYA_CONTRAKTA,FP_OKLAD,fp_amplua,amp_nazvanie from football_player f,amplua a where f.fp_amplua=a.amp_id and f.fp_familiya like "'+ str+'%"';
DataModule1.QueryPlayers.Open;Девушка, работа с базой.
bloodye,
31 Мая 2011
+94
procedure rayxtriangle(Xa,Ya,Za, {Точка отправления луча}
X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3 : real; {Координаты полигона (триангла)}
Vx,Vy,Vz : real;{Вектор направления луча} Var Xc,Yc,Zc : real;{Точка пересечения}
bol : boolean {Для проверки пересечения триангла});
Var A,B,C,D : real;
k : real;
ac1,ac2,ac3 : real;
begin
A:=(Y2-Y1)*(Z3-Z1)-(Z2-Z1)*(Y3-Y1); //Вычисляем вектор нормали к треугольному полигону (векторное произведение)
B:=(Z2-Z1)*(X3-X1)-(X2-X1)*(Z3-Z1);
C:=(X2-X1)*(Y3-Y1)-(Y2-Y1)*(X3-X1);
D:=-A*X1-B*Y1-C*Z1;
k:=-(A*Xa+B*Ya+C*Za+D)/(A*Vx+B*Vy+C*Vz); //поскольку вектора луча (Vx Vy Vz) и вектор с даной
//точки к точке пересечения (Xc-Xa, Yc-Ya, Zc-Za) - колинеарны
//ето соотношение выведено мною, обьяснение было раньше (в предыдущем ответе)
Xc:=k*Vx+Xa; //Вычисляем точку пересечения луча с полигоном
Yc:=k*Vy+Ya;
Zc:=k*Vz+Za;
//здесь проверяем лежыт ли даная точка в треугольном полигоне
//ac1,ac2,ac3 арккосинусы углов между векторами с точки пересечения (Xc Yc Zc)
//к вершинам треугольника (из скалярного произведения)
//Для других полигонов (4,5,6... и т.д. угольных) надо побольше вычислений
ac1:=arccos(((x1-xc)*(x2-xc)+(y1-yc)*(y2-yc)+(z1-zc)*(z2-zc))/(sqrt(sqr(x1-xc)+sqr(y1-yc)+sqr(z1-zc))*sqrt(sqr(x2-xc)+sqr(y2-yc)+sqr(z2-zc))));
ac2:=arccos(((x2-xc)*(x3-xc)+(y2-yc)*(y3-yc)+(z2-zc)*(z3-zc))/(sqrt(sqr(x2-xc)+sqr(y2-yc)+sqr(z2-zc))*sqrt(sqr(x3-xc)+sqr(y3-yc)+sqr(z3-zc))));
ac3:=arccos(((x3-xc)*(x1-xc)+(y3-yc)*(y1-yc)+(z3-zc)*(z1-zc))/(sqrt(sqr(x3-xc)+sqr(y3-yc)+sqr(z3-zc))*sqrt(sqr(x1-xc)+sqr(y1-yc)+sqr(z1-zc))));
if (ac1+ac2+ac3=pi) then bol:=true else bol:=false; //Если сума етих углов=360 градусов значит точка в треугольнике
//Если точка пересечения найдена тогда bol=true и ее координаты Xc Yc Zc
end;
А всё потому, что векторную алгебру надо знать, любить и уважать, ибо иначе такая хрень выходит.
Источник: http://www.gamedev.ru/code/forum/?id=148128
TarasB,
31 Мая 2011
+114
procedure TForm1.Button1Click(Sender: TObject);
var
a,b,c,x:integer;
chas, nedel1,nedel2,nedel3:integer;
begin
a:=0;
b:=0;
c:=0;
repeat
chas:= strtoint (edit1.text);
nedel1:= strtoint (edit2.text);
nedel2:= strtoint (edit3.text);
nedel3:= strtoint (edit4.text);
x:=((nedel1*a)+(nedel2*b)+(nedel3*c));
if chas<>((nedel1*a)+(nedel2*b)+(nedel3*c)) then
a:=a+1;
if chas<>((nedel1*a)+(nedel2*b)+(nedel3*c)) then
b:=b+1;
if chas<>((nedel1*a)+(nedel2*b)+(nedel3*c)) then
c:=c+1;
until chas=x;
label1.Caption:=inttostr (a);
label2.Caption:=inttostr (b);
label3.Caption:=inttostr (c);
end;
end.евклид плачет
bugmenot,
27 Мая 2011
+87
procedure TForm1.Edit1Change(Sender: TObject);
begin
if Edit1.Text='515' then
Form1.Caption:='Пароль взломан!'
else Form1.Caption:='неправельно!';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text:='1';
if Edit1.Text='1' then
begin
if Form1.Caption='неправельно!' then
Edit1.Text:='2';
if Edit1.Text='2' then
begin
if Form1.Caption='неправельно!' then
Edit1.Text:='3';Личинка человека решила сделать брутфорс паролей. Когда нажимается кнопка идёт беспощадный перебор без цикла на предмет совпадения пароля
memnek,
23 Мая 2011
+107
function HexToInt(s: string): integer;
label
gte;
var
tempt: string;
i: integer;
begin
tempt := '';
if s = '' then
begin
HexToInt := 0;
goto gte;
end;
for i := 1 to Length(s) do
begin
tempt := tempt + IntToHex(Ord(s[i]), 2);
end;
HexToInt := StrToInt('$' + tempt);
gte:
end;
Ряд гениальных решений из-за незнания особенностей языка.
Честно взято с: http://www.delphisources.ru/pages/faq/base/hex_to_int.html
Честно написано автором: Перегинец Иваном ( [email protected] )
miLord-Corwin,
17 Мая 2011
+112
while (FilePos(SrcFile) <> FileSize(SrcFile)) do begin
BlockRead(SrcFile,Res,1);
...
Пытаюсь одному объяснить кое-что из основ. Мне плохо от его перлов.
Нехорошо смеяться над новичками, но я уже не выдержал...
http://www.gamedev.ru/flame/forum/?id=147021&page=10#m148
TarasB,
15 Мая 2011
+103
function TForm1.getyoutube(ss: string): string;
var
//Вылавливаем ссылку
i:integer;
pos:integer;
length1:integer;
ssylka:string;
pos_str:string;
//Удаляем ненужные символы
pos_str2:string;
pos2,pos23:integer;
ssc:char;
begin
//Вылавливаем ссылку если это ютубовская ссылка
if isitok('youtube.com',ss)=true then
begin
protect;
memo1.lines.Text:=idhttp1.Get(ss);
for i:=0 to memo1.Lines.Count do
begin
pos_str:=' img.src = '+#39;
pos:=AnsiPos(pos_str,memo1.Lines.Strings[i]);
if pos=1 then
begin
length1:=length(memo1.Lines.Strings[i])-length(pos_str)-2;
ssylka:=copy(memo1.Lines.Strings[i],pos+length(pos_str),length1);
end;
end;
ssc:=#160;
pos_str:='youtube.com';
pos:=AnsiPos(pos_str,ssylka);
delete(ssylka,pos+length(pos_str),1);
delete(ssylka,6,1);
delete(ssylka,7,1);
pos_str2:='youtube.com/';
pos2:=AnsiPos(pos_str,ssylka);
pos2:=pos2+length(pos_str2);
pos_str2:='?ip';
pos23:=AnsiPos(pos_str,ssylka);
delete(ssylka,pos2,pos2-pos23);
insert('videoplayback',ssylka,pos2);
result:=ssylka;
end
else
begin
protectoff;
form2.show;
form1.enabled:=false;
end;
protectoff;
end;Очень старый способ скачать видео с YouTube
KapoeD,
10 Мая 2011
+78
procedure TForm1.WSocket1DataAvailable(Sender: TObject; ErrCode: Word);
var
msg,msg1: string;
begin
msg:=Wsocket1.ReceiveStr;
Memo1.Lines.add(UTF8DECODE(msg));
if copy(msg,0,8)='HAAAPSI ' then
begin
msg1:=Copy(msg,8,pos(msg,#20));
WSocket1.SendStr(':ru IDENT 34 -1 4030 :GALA'+#13#10);
if Edit1.Text='' then
exit;
WSocket1.SendStr('RECOVER ' +Edit1.Text+#13#10)
end
else if Copy(msg,0,9)='REGISTER ' then
begin
msg1:=copy(msg,9,length(msg));
WSocket1.SendStr('USER '+msg1+#13#10);
end
else if Copy(msg,0,5)='LBS 1' then
WSocket1.SendStr('GETPL'+#13#10)
else if Copy(msg,0,3)='822' then
begin
WSocket1.SendStr('JOIN'+#13#10);
WSocket1.SendStr('ADDONS'+#13#10);
WSocket1.SendStr('MYADDONS'+#13#10);
end
else if Copy(msg,0,4)='PING' then
WSocket1.SendStr('PONG'+#13#10);
end;
procedure TForm1.WSocket1DnsLookupDone(Sender: TObject; ErrCode: Word);
begin
WSocket1.Port:='6667';
WSocket1.Proto:='tcp';
WSocket1.Addr:=WSocket1.DnsResult;
WSocket1.Connect;
con:=true;
end;Говно код подкл. к чату галактика знакомств да еще по 34 протоколу его скоро закроют....
megaruliz,
08 Мая 2011
+147
procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
with ARichEdit do
begin
SelStart := Length(Text);
SelAttributes.Color := AColor;
SelAttributes.Size := 8;
SelAttributes.Name := 'MS Sans Serif';
Lines.Add(AText);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AddColoredLine(RichEdit1, 'Govnokoder уебок', clRed);
AddColoredLine(RichEdit1, 'Govnocoder уебок', clGreen);
end;говнокодер уебак разными цветами
megaruliz,
07 Мая 2011
+147
Program n_a;
uses crt;
Var c:char; k: byte;
BEGIN
clrscr; k:=0;
Write(‘Введите текст:'); read(c);
Repeat
While(c=' ') and Not eoln Do Read(c);
inc(k);
While(c<>' ') and Not eoln Do Read(c);
Until eoln;
WriteLn('k= ',k:3);
END.так физматы находят сколько слов в тексте
megaruliz,
07 Мая 2011
Follow us!