Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+81
Если ты имеешь в виду, что появляются полосы прокрутки и
уродуют окно или stringgrid, то просто оставляй "запас" в
несколько пикселей, т.к. на разных системах может быть разная
ширина краев формы и прочих элементов.
А что, я еще и код писать должен чтобы какие-то экзотичные
темы винды поддерживать? Нет уж, я лучше несколько
пикселей оставлю запаса.
Вся суть дельфинов
http://www.gamedev.ru/code/forum/?id=168899
Topacer,
11 Ноября 2012
+100
procedure TDetailForm.GridPanel1Click(Sender: TObject);
var
i: Integer;
s: String;
begin
//set title and subtitle
if Pos('Item', TControl(Sender).Name) > 0 then begin
if Sender.ClassName = 'TImage' then begin
i := Length(TControl(Sender).Name) - Length('ItemImage') - 1;
s := Copy(TControl(Sender).Name, Length(TControl(Sender).Name) - i, Length(TControl(Sender).Name));
ItemTitle.Caption := TLabel(DetailForm.FindComponent('ItemTitle' + s)).Caption;
ItemSubtitle.Caption := TLabel(DetailForm.FindComponent('ItemSubTitle' + s)).Caption;
end else if Pos('ItemSubTitle', TControl(Sender).Name) > 0 then begin
ItemSubtitle.Caption := TLabel(Sender).Caption;
i := Length(TControl(Sender).Name) - Length('ItemSubTitle') - 1;
s := Copy(TControl(Sender).Name, Length(TControl(Sender).Name) - i, Length(TControl(Sender).Name));
ItemTitle.Caption := TLabel(DetailForm.FindComponent('ItemTitle' + s)).Caption;
end else if Pos('ItemDescription', TControl(Sender).Name) > 0 then begin
i := Length(TControl(Sender).Name) - Length('ItemDescription') - 1;
s := Copy(TControl(Sender).Name, Length(TControl(Sender).Name) - i, Length(TControl(Sender).Name));
ItemTitle.Caption := TLabel(DetailForm.FindComponent('ItemTitle' + s)).Caption;
ItemSubtitle.Caption := TLabel(DetailForm.FindComponent('ItemSubTitle' + s)).Caption;
end else begin
ItemTitle.Caption := TLabel(Sender).Caption;
i := Length(TControl(Sender).Name) - Length('ItemTitle') - 1;
s := Copy(TControl(Sender).Name, Length(TControl(Sender).Name) - i, Length(TControl(Sender).Name));
ItemSubTitle.Caption := TLabel(DetailForm.FindComponent('ItemSubTitle' + s)).Caption;
end;
end;
end;Код из шаблона New Metropolis UI Application в новом Delphi XE3. Рефлексия так и прет.
kipar,
23 Сентября 2012
+106
function ReplaceUrl(txt: WideString): WideString;
var
i, j: integer;
tmp, Url: WideString;
begin
Result := '';
I := 1;
while I <= Length(txt) do
begin
tmp := '';
if WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5]+txt[i+6], 'http://') or
WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5]+txt[i+6], 'ed2k://') or
WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5], 'ftp://') or
WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3], 'www.') or
WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5]+txt[i+6]+txt[i+7], 'https://') then
begin
Url := '';
for j := I to Length(txt) do
begin
if (txt[j] <> ' ') and (ord(txt[j]) < 255) then
Url := Url + txt[J]
else
Break;
end;
Result := Result + Format(C_HTML_URL, [Url, Url]);
I := J;
end else
begin
Result := Result + txt[I];
Inc(I);
end;
end;
end;http://www.bvbcode.com/code/vhk2e8rb-1638045
63F45EF45RB65R6VR,
21 Августа 2012
+96
function InterlockedExchangePointer(var Target: Pointer; Value: Pointer): Pointer;
begin
Result := Pointer(InterlockedExchange(Integer(Target), Integer(Value)));
end;
Windows.pas
facepalm.jpg
Delphi, такой Delphi.
HaskellGovno,
14 Августа 2012
+89
procedure TClickerAdvertising.Start(Item: TTaskItem);
procedure StartTask(AURL: string);
procedure SearchInYandex(Keywords, Domen: string);
procedure SendSearchRequest;
procedure CheckSearchRequest;
procedure SearchLinkAndClick;
function FindLinkInList: IHTMLElement;
procedure CheckValidateTransition;
procedure MoveAndGoBack(Domen: string; MoveCount, MoveDelay: Integer);
function GetRandomElement: IHTMLElement;
procedure FindAdvertLinkAndClick(AdvertType: TAdvertType; var AdvertLink: string);
procedure ClickFromLinkToAdvert;
procedure ClickFromGoogleAds;
procedure SendReport(AURL: string);
function GetIP: string;
begin
//...
end;А як, Ви, ставитись до вкладених процедур?
ADR,
14 Июля 2012
+99
// Получение имени выполняемого метода, вызывать можно только из Published-методов класса.
// Для обычных методов: FindClassMethodNames(ClassType()), для статических методов FindClassMethodNames(self).
{$optimization OFF}
function FindClassMethodNames(obj: TClass): string;
var _AdrPtr: Pointer;
begin
asm
mov eax, obj
mov edx, dword ptr [esp + 272]
push ebx
push esi
push edi
push $7FFFFFFF
xor edi, edi
jmp @@haveVMT
@@outer:
mov eax, dword ptr [eax]
@@haveVMT:
mov esi, dword ptr [eax].vmtMethodTable
test esi, esi
je @@parent
movzx ecx, word ptr [esi]
add esi, 2
@@inner:
pop ebx
push edx
sub edx, dword ptr [esi + 2]
jl @@no1
cmp edx, ebx
jg @@no1
mov ebx, edx
mov edx, dword ptr [esi + 2]
mov edi, edx
@@no1:
pop edx
push ebx
movzx ebx, word ptr [esi]
add esi, ebx
dec ecx
jnz @@inner
@@parent:
mov eax, dword ptr [eax].vmtParent
test eax, eax
jne @@outer
mov _AdrPtr, edi
pop edi
pop esi
pop ebx
end;
Result := obj.MethodName(_AdrPtr);
end;
{$optimization ON}
// пример использования
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FindClassMethodNames(ClassType()));
end;А есть нормальный способ получить имя выполняемого метода, и строку кода заодно?
ctm,
11 Июля 2012
+102
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if ((Edit1.Text <> '') or (Edit4.Text <> '')) then
begin
Button1.Enabled:=true;
end;
if ((Edit1.Text = '') or (Edit4.Text = '')) then
begin
Button1.Enabled:=false;
end;
end;Таким образом настоящий ветеран говнокода защищает свое детище от "кривых" рук.
CyberKiller,
08 Июля 2012
+94
function Dist(dx, dy: integer): integer;
begin
//result := trunc(sqrt(sqr(dx)+sqr(dy)));
dx := abs(dx);
dy := abs(dy);
if dx>dy then begin
dy := dy shr 1 - dx shr 3;
if dy >= 0 then result := dx+dy else result := dx;
end else begin
dx := dx shr 1 - dy shr 3;
if dx >= 0 then result := dx+dy else result := dy;
end;
end;Ещё по теме приближённых расчётов в игровом движке.
TarasB,
02 Июля 2012
+99
program lab;
usescrt
var
a:array [1..20] of shortint;
s:byte;
g,b:real;
begin
clrscr
randomize;
for s:=1 to 20 do
begin
a[s]:=random (40);
a[s]:=a[s]-20;
write (a [s]4);
end;
g:=0
for s:=1 to 20 do
if a[s]>0 , then g= g+a [s];
writelnc(summa pol ',g);
b:=0;
for s:=1 to 20 do
if a[s]<0 then b:=b+a[s];
writeln (srednee',b);
b:=(b)/20;
repeat until keypressed;
end.http://rghost.ru/38741341
dos_,
01 Июля 2012
+110
if (M[1]<>M[2]) and (M[1]<>M[3]) and (M[1]<>M[4]) and (M[1]<>M[5]) and (M[1]<>M[6]) then
begin
if (M[1]<>M[7]) and (M[1]<>M[8]) and (M[1]<>M[9]) and (M[1]<>M[10]) then
write(' ',M[1],' ');
end;
if (M[2]<>M[1]) and (M[2]<>M[3]) and (M[2]<>M[4]) and (M[2]<>M[5]) and (M[2]<>M[6]) then
begin
if (M[2]<>M[7]) and (M[2]<>M[8]) and (M[2]<>M[9]) and (M[2]<>M[10]) then
write(' ',M[2],' ');
end;
if (M[3]<>M[1]) and (M[3]<>M[2]) and (M[3]<>M[4]) and (M[3]<>M[5]) and (M[3]<>M[6]) then
begin
if (M[3]<>M[7]) and (M[3]<>M[8]) and (M[3]<>M[9]) and (M[3]<>M[10]) then
write(' ',M[3],' ');
end;
if (M[4]<>M[1]) and (M[4]<>M[2]) and (M[4]<>M[3]) and (M[4]<>M[5]) and (M[4]<>M[6]) then
begin
if (M[4]<>M[7]) and (M[4]<>M[8]) and (M[4]<>M[9]) and (M[4]<>M[10]) then
write(' ',M[4],' ');
end;
if (M[5]<>M[1]) and (M[5]<>M[2]) and (M[5]<>M[3]) and (M[5]<>M[4]) and (M[5]<>M[6]) then
begin
if (M[5]<>M[7]) and (M[5]<>M[8]) and (M[5]<>M[9]) and (M[5]<>M[10]) then
write(' ',M[5],' ');
end;
if (M[6]<>M[1]) and (M[6]<>M[2]) and (M[6]<>M[3]) and (M[6]<>M[4]) and (M[6]<>M[5]) then
begin
if (M[6]<>M[7]) and (M[6]<>M[8]) and (M[6]<>M[9]) and (M[6]<>M[10]) then
write(' ',M[6],' ');
end;
if (M[7]<>M[1]) and (M[7]<>M[2]) and (M[7]<>M[3]) and (M[7]<>M[4]) and (M[7]<>M[5]) then
begin
if (M[7]<>M[6]) and (M[7]<>M[8]) and (M[7]<>M[9]) and (M[7]<>M[10]) then
write(' ',M[7],' ');
end;
readln;
if (M[8]<>M[1]) and (M[8]<>M[2]) and (M[8]<>M[3]) and (M[8]<>M[4]) and (M[8]<>M[5]) then
begin
if (M[8]<>M[6]) and (M[8]<>M[7]) and (M[8]<>M[9]) and (M[8]<>M[10]) then
write(' ',M[8],' ');
end;
if (M[9]<>M[1]) and (M[9]<>M[2]) and (M[9]<>M[3]) and (M[9]<>M[4]) and (M[9]<>M[5]) then
begin
if (M[9]<>M[6]) and (M[9]<>M[7]) and (M[9]<>M[8]) and (M[8]<>M[10]) then
write(' ',M[9],' ');
end;
if (M[10]<>M[1]) and (M[10]<>M[2]) and (M[10]<>M[3]) and (M[10]<>M[4]) and (M[10]<>M[5]) then
begin
if (M[10]<>M[6]) and (M[10]<>M[7]) and (M[10]<>M[8]) and (M[10]<>M[9]) then
write(' ',M[10],' ');
end;Циклы? Не, не слышал...
HighPredator,
19 Июня 2012
Follow us!