Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−1
TServerThread = class(TThread)
private
procedure DoReadData;
protected
ThreadOwner: TIPCServer;
procedure Execute; override;
constructor Create(AThreadOwner: TIPCServer);
destructor Destroy; override;
public
end;Мы кодили, кодили и наконец накодили!
antipattern,
27 Июня 2017
0
procedure TForm1.ProcListAdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
TP:TprocessInfo;
xColor: TColor;
xRect: TRect;
xBitmap: TBitmap;
I, L, R: Integer;
begin
DefaultDraw:=False;
TP:=TProcessInfo(Item.SubItems.Objects[0]);
if (Item.Selected) then
begin
if Sender.Focused then
begin
if (FItemAtCursor <> -1) and (Item.Index = FItemAtCursor) then
xColor:=clNavy
else
xColor:=$00C56A31;
end
else
xColor:=$00D8E9EC
end
else
begin
if (TP.New<2) or (TP.Terminated<2) or (TP.Hidden) then
begin
if ShowDangerousProcesses then
if TP.Hidden then
xColor:=$00DBDBDB;
if ShowNewProcesses then
if TP.New <2 then
xColor:=$001DEB2D;
if ShowTerminatedProcesses then
if TP.Terminated < 2 then
xColor:=$001D2DEB;
end
else
if (Item.Index mod 2 = 1) then
xColor:=RGB(245,245,255)
else
xColor:=clWindow;
end;
Sender.Canvas.Brush.Color:=xColor;
DefaultDraw:=True;
if (Item.Selected) and Sender.Focused
then Sender.Canvas.Font.Color:=clWindow
else Sender.Canvas.Font.Color:=clWindowText;
Sender.Canvas.FillRect(Item.DisplayRect(drLabel));
DefaultDraw:=True;
Exit;
xRect:=Item.DisplayRect(drLabel);
Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.Caption);
for I:=0 to TListView(Sender).Columns.Count-1 do
begin
if TListView(Sender).Columns[TListView(Sender).Columns[I].ID].Width<=0 then Continue;
if (I=0) and (TListView(Sender).Columns[I].ID <> 0) then
begin
xRect.Left:=0;
xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
Sender.Canvas.FillRect(xRect);
Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.SubItems[TListView(Sender).Columns[I].ID-1]);
end
else
begin
if I>0 then
begin
xRect.Left:=xRect.Right+1;
xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
Sender.Canvas.FillRect(xRect);
if TListView(Sender).Columns[I].ID >0 then
Sender.Canvas.TextRect(xRect,xRect.Left+5,xRect.Top,Item.SubItems[Pred(TListView(Sender).Columns[I].ID)])
else
begin
L:=(Item.DisplayRect(drIcon).Right-Item.DisplayRect(drIcon).Left)+6;
Sender.Canvas.TextRect(xRect,xRect.Left+L,xRect.Top, Item.Caption)
end;
end;
end;
end;
Sender.Canvas.Brush.Color:=clWindow;
Sender.Canvas.FillRect(Item.DisplayRect(drIcon));
if Item.ImageIndex=-1 then Exit;
xBitmap:=TBitmap.Create;
TListView(Sender).SmallImages.GetBitmap(Item.ImageIndex,xBitmap);
ListView - великий и ужасный! - в режиме OwnerDraw.
Писал диспетчер процессов. Когда я разрешил прятать столбцы и включил свойство FullDrag, моя жизнь круто изменилась.
antipattern,
19 Июня 2017
−1
(багрепорт)
http://www.alphaskins.com/forum/index.php?app=core&module=attach§ion=attach&attach_rel_module=post&attach_id=8330Сергох Гончаров с AlphaSkins.com шалит )Сергох Гончаров с AlphaSkins.com шалит )
antipattern,
06 Июня 2017
0
function IsExecutablePacked(FileName: WideString): Boolean;
var
i: Cardinal;
CompressionRatio: Double;
Count: Cardinal;
MathX: array [0 .. 255] of Integer;
FileStream: TFileStream;
Buffer: PAnsiChar;
FileHandle: THandle;
begin
Result := False;
try
FileHandle := 0;
FileHandle := CreateFileW(PWideChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if (FileHandle <> 0) and FileExists(FileName) then
begin
try
FileStream := TFileStream.Create(FileHandle);
Count := FileStream.Seek(0, soFromEnd);
try
GetMem(Buffer, Count);
FileStream.Seek(0, soFromBeginning);
FileStream.Read(Buffer^, Count);
CompressionRatio := 0;
FillChar(MathX, Sizeof(MathX), 0);
for i := 0 to Count - 1 do
Inc(MathX[Windows.PByte(DWORD(Buffer) + (i))^]);
for i := 0 to 255 do
if MathX > 0 then
CompressionRatio := CompressionRatio - Log2(MathX / Count) * MathX;
finally
FreeMem(Buffer, Count);
end;
CompressionRatio := (Count * 8) / CompressionRatio;
CompressionRatio := 100 / CompressionRatio;
if CompressionRatio > 97 then
Result := True;
finally
FileStream.Free;
end;
end;
finally
end;
end;"Ис Эксекутабле Пуцкед" - форматирование сохранено.
antipattern,
04 Июня 2017
−1414
function Unescape(const s: AnsiString): widestring;
var
i: Integer;
j: Integer;
c: Integer;
begin
// Make result at least large enough. This prevents too many reallocs
SetLength(Result, Length(s));
i := 1;
j := 1;
while i <= Length(s) do begin
if s[i] = '\' then begin
if i < Length(s) then begin
// escaped backslash?
if s[i + 1] = '\' then begin
Result[j] := '\';
inc(i, 2);
end
// convert hex number to WideChar
else if (s[i + 1] = 'u') and (i + 1 + 4 <= Length(s))
and TryStrToInt('$' + string(Copy(s, i + 2, 4)), c) then begin
inc(i, 6);
Result[j] := WideChar(c);
end else begin
raise Exception.CreateFmt('Invalid code at position %d', [i]);
end;
end else begin
raise Exception.Create('Unexpected end of string');
end;
end else begin
Result[j] := WideChar(s[i]);
inc(i);
end;
inc(j);
end;
// Trim result in case we reserved too much space
SetLength(Result, j - 1);
end;Это не вирус. Просто в Delphi 7 не завезли JSon.
doctor_stertor,
07 Мая 2017
−77
program LeakMem;
uses sysutils;
var
str:string;
...В седьмой делфе утекает память.
voodoodal16,
28 Сентября 2016
+8
Program L_121;
uses crt;
Var N : integer;
b,z : string;
f1 : text;
Begin
assign(f1,'Единица измерения.txt');
writeln('1 Соотношение конкретной единицы измерения длины');
writeln('2 Соотношение единиц измерения длины');
writeln('3 Обозначение единиц измерения длины');
writeln('4 Назначение единиц измерения длины');
read(N);clrscr;
reset(f1);
case N of
1:begin
write('Введите единицу измерения : ');
read(b);clrscr;
readln(f1,z);writeln(z);
if b='миллиметр' then begin readln(f1,z);writeln(z); end;
if b='сантиметр' then begin readln(f1,z);readln(f1,z);writeln(z); end;
if b='дециметр' then begin readln(f1,z);readln(f1,z);readln(f1,z);writeln(z);end;
if b='метр' then begin readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);writeln(z);end;
if b='километр' then begin readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);writeln(z); end;
end;
2:begin
readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);
end;
3:begin
readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);
writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);
end;
4:begin
readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);
readln(f1,z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);
end;
end;
End.4 года назад я так писал код)
Genome,
07 Сентября 2016
+1873
function translate_a_name_of_the_winter_to_the_foreign_language(language: String): String;
begin
if language = 'авестийский' Result := 'zimō'
else if language = 'белорусский' Result := 'зіма'
else if language = 'болгарский' Result := 'зима'
else if language = 'верхнелужицкий' Result := 'zyma'
else if language = 'греческий' Result := 'χειμώνας'
else if language = 'древнепрусский' Result := 'semo'
else if language = 'латинский' Result := 'hiems'
else if language = 'латышский' Result := 'ziema'
else if language = 'литовский' Result := 'žiema'
else if language = 'македонский' Result := 'зима'
else if language = 'нижнелужицкий' Result := 'zyma'
else if language = 'осетинский' Result := 'зымӕг'
else if language = 'польский' Result := 'zima'
else if language = 'русский' Result := 'зима'
else if language = 'санскрит' Result := 'hima'
else if language = 'сербский' Result := 'зима'
else if language = 'словацкий' Result := 'zima'
else if language = 'словенский' Result := 'zima'
else if language = 'талышский' Result := 'зымыстон'
else if language = 'таджикский' Result := 'зимистон'
else if language = 'украинский' Result := 'зима'
else if language = 'хорватский' Result := 'zima'
else if language = 'чешский' Result := 'zima'
end;Из одного очень серьёзного проекта.
Amayak_Akopyan,
20 Августа 2016
+2
case ((((parametr[3, 1] - parametr[1, 1]) / parametr[4, 2] = (parametr[3, 2] - parametr[1, 2]) / parametr[4, 2]) and ((parametr[3, 2] - parametr[1, 2]) / parametr[4, 2] = (parametr[3, 3] - parametr[1, 3]) / parametr[4, 3])) xor
((parametr[4, 1] = 0) and (parametr[1, 1] = parametr[2, 1]) and (parametr[2, 1] = parametr[3, 1]) and ((parametr[3, 2] - parametr[1, 2]) / parametr[4, 2] = (parametr[3, 3] - parametr[1, 3]) / parametr[4, 3])) xor
((parametr[4, 2] = 0) and (parametr[1, 2] = parametr[2, 2]) and (parametr[2, 2] = parametr[3, 2]) and ((parametr[3, 1] - parametr[1, 1]) / parametr[4, 1] = (parametr[3, 3] - parametr[1, 3]) / parametr[4, 3])) xor
((parametr[4, 3] = 0) and (parametr[1, 3] = parametr[2, 3]) and (parametr[2, 3] = parametr[3, 3]) and ((parametr[3, 1] - parametr[1, 1]) / parametr[4, 1] = (parametr[3, 2] - parametr[1, 2]) / parametr[4, 2])) xor
((parametr[4, 3] <> 0) and (parametr[4, 1] = 0) and (parametr[4, 2] = 0) and (parametr[3, 1] = parametr[2, 1]) and (parametr[3, 2] = parametr[2, 2])) xor
((parametr[4, 2] <> 0) and (parametr[4, 1] = 0) and (parametr[4, 3] = 0) and (parametr[3, 1] = parametr[2, 1]) and (parametr[3, 3] = parametr[2, 3])) xor
((parametr[4, 1] <> 0) and (parametr[4, 2] = 0) and (parametr[4, 3] = 0) and (parametr[3, 2] = parametr[2, 2]) and (parametr[3, 3] = parametr[2, 3])) xor
((parametr[4, 1] = 0) and (parametr[4, 2] = 0) and (parametr[4, 3] = 0))) of true:
writeln('Все точки лежат на одной прямой. Такой треугольник не существует.');Проверка треугольника в декартовой системе координат
Meliodas,
04 Октября 2015
+5
Commission:= Commission/100*StrToInt(Label8.Caption); //Вычисление комиссииТерминальщики :|
Dego1n,
23 Сентября 2015
Follow us!