Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
0
if ( (sd<>5) ) and // (Material.ReadOnlySklad =false) and
(
( Material.TypeSkladId <> 4 ) and
(
// (Material.UserBuh = true ) or (Material.UserAdmin = true) or
(Material.DisunionByOssSb=true ) or ( credit_operation = true )
)
)
then
Baiumka,
10 Января 2022
0
procedure TForm9.FormShow(Sender: TObject);
var i_vx,o_dt,o_kt: real;
begin
Form9.Caption:='Èòîãî ïî æóðíàëó';
r_:='select sum(sma) as ism from '+t_ss;
with DM.ZQ_all do
begin
Close;
SQL.Clear;
SQL.Add(r_);
SQL.Add('where ch=1 and gd*100+ms<:rgd*100+:rms');
Params.ParamByName('rgd').Value :=t_gd;
Params.ParamByName('rms').Value :=t_ms;
Open;
first;
if Eof=true then i_vx:=0 else i_vx:=Fieldbyname('ism').asfloat;
Close;
SQL.Clear;
SQL.Add(r_);
SQL.Add('where ch=2 and gd*100+ms<:rgd*100+:rms');
Params.ParamByName('rgd').Value :=t_gd;
Params.ParamByName('rms').Value :=t_ms;
Open;
first;
if not Eof=true then i_vx:=i_vx - Fieldbyname('ism').asfloat;
LEdit1.Text:=Format('%10.2f',[i_vx]);
Close;
SQL.Clear;
SQL.Add(r_);
SQL.Add('where ch=1 and gd*100+ms=:rgd*100+:rms');
Params.ParamByName('rgd').Value :=t_gd;
Params.ParamByName('rms').Value :=t_ms;
Open;
first;
if Eof=true then o_dt:=0 else o_dt:=Fieldbyname('ism').asfloat;
LEdit2.Text:=Format('%10.2f',[o_dt]);
Close;
SQL.Clear;
SQL.Add(r_);
SQL.Add('where ch=2 and gd*100+ms=:rgd*100+:rms');
Params.ParamByName('rgd').Value :=t_gd;
Params.ParamByName('rms').Value :=t_ms;
Open;
first;
if Eof=true then o_kt:=0 else o_kt:=Fieldbyname('ism').asfloat;
Close;
LEdit3.Text:=Format('%10.2f',[o_kt]);
LEdit4.Text:=Format('%10.2f',[i_vx+o_dt-o_kt]);
end;
end;
Baiumka,
06 Января 2022
−8
Program print_numbers_twice;
Procedure give(p: pptrint);
begin
if pptrint(p^) <> nil then begin
give(pptrint(p^));
writeln((p-1)^)
end
end;
Procedure take;
var n: ptrint;
begin
if not SeekEof then begin
read(n);
take
end else begin
n := (pptrint(@n)+1)^;
give(pptrint(n));
give(pptrint(n))
end
end;
Begin
take
End.
На входе программа получает неизвестное заранее количество целых чисел, разделенных пробельными символами, а затем выводит их два раза в том же порядке по одному числу в строке.
Очень простая и короткая программа. Я думаю, вам не составит труда понять, как она работает. Пишите в комментариях!
Threadwalker,
22 Декабря 2021
−2
// Подгрузка аватаров пользователей.
Bmp:=TBitMap.Create; // Нет более изящного спооба узнать тип изображения, не колупаясь в заголовках. Расширение файлов картинок зачастую фиктивное.
try // Зная, что ава может быть только двух типов - jpg и png, я решил пойти конём.
Bmp.PixelFormat:=pf32Bit;
Bmp.Width:=16;
Bmp.Height:=16;
ImgConv:=True;
Png:=TPngObject.Create;
try
try
Comm.RawAvatar.Position:=0;
Png.LoadFromStream(Comm.RawAvatar);
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Png);
except
ImgConv:=False; // Ошибка конвертирования. Не совпал формат - идем дальше, пробуем jpg...
end;
finally
Png.Free; // нет смысла раскручивать стек, ибо исключение в любом случае отловится try..except
end;
if not ImgConv then
begin
Jpg:=TJPEGImage.Create;
try
try
Comm.RawAvatar.Position:=0;
Jpg.LoadFromStream(Comm.RawAvatar);
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Jpg);
except
end;
finally
Jpg.Free;
end;
end;
CommentList.Items[I].ImageIndex:=Images.AddMasked(Bmp, clWhite);
finally
Bmp.Free;
end;
end;
"Тут всюду густая вонь, то жаркая и приятная, то теплая и противная, но одинаково волнующая, особая, пароходная, мешающаяся с морской свежестью"
@ Бунин.
Теперь минусатор умеет подгружать авы.
https://dropmefiles.com/USQKW
Support,
05 Ноября 2021
−1
function ReplaceHTMLSpec(First, Last, RepTo, RepEd:string):string;
var
I, P, St:Integer;
SS, Temp:string;
begin
Temp:='';
ST:=0;
while True do
begin
P:=Pos(First, Result);
if P = 0 then Break;
SS:=Copy(Result, ST, P-1)+RepTo;
Temp:=Temp+SS;
ST:=P+Length(First);
Result:=Copy(Result, ST, MaxInt);
P:=Pos(Last, Result);
if P > 0 then
begin
SS:=Copy(Result, 1, P-1)+RepEd;
Temp:=Temp+SS;
ST:=P+Length(Last);
SS:=Copy(Result,ST, MaxInt);
Temp:=Temp+SS;
end;
Result:=Temp;
end;
end;
function DecorateText(S:string):string;
const
Arr:array[0..3] of string=('<br>','"','<','>');
var
I, P, St:Integer;
SS, Temp:string;
begin
Result:=S;
for I:=0 to 3 do
Result:=StringReplace(Result, Arr[I], '',[rfreplaceall]);
Result:=StringReplace(Result,'<br />',#13#10,[rfreplaceall]);
Result:=StringReplace(Result,'<i>','[i]',[rfreplaceall]);
Result:=StringReplace(Result,'</i>','[/i]',[rfreplaceall]);
Result:=StringReplace(Result,'<b>','[b]',[rfreplaceall]);
Result:=StringReplace(Result,'</b>','[/b]',[rfreplaceall]);
Temp:='';
ST:=0;
{ while True do
begin
P:=Pos('<span style="font-size:10px;">', Result);
if P = 0 then Break;
SS:=Copy(Result, ST, P-1)+'[size=10]';
Temp:=Temp+SS;
ST:=P+Length('<span style="font-size:10px;">');
Result:=Copy(Result, ST, MaxInt);
P:=Pos('</span>', Result);
if P > 0 then
begin
SS:=Copy(Result, 1, P-1)+'[/size]';
Temp:=Temp+SS;
ST:=P+Length('</span>');
SS:=Copy(Result,ST, MaxInt);
Temp:=Temp+SS;
Result:=Temp;
end;
end; }
Result:=ReplaceHTMLSpec('<span style="color:white;">','</span>','[color=white]','[/color]');
Result:=ReplaceHTMLSpec('<span style="color:red;">','</span>','[color=red]','[/color]');
Result:=ReplaceHTMLSpec('<span style="color:blue;">','</span>','[color=blue]','[/color]');
Result:=ReplaceHTMLSpec('<span style="color:green;">','</span>','[color=green]','[/color]');
Result:=ReplaceHTMLSpec('<pre><code class="">','</code></pre>','[code]','[/code]');
Result:=ReplaceHTMLSpec('<span style="font-size:10px;">','</span>','[size=10]','[/size]');
Result:=ReplaceHTMLSpec('<span style="font-size:15px;">','</span>','[size=15]','[/size]');
Result:=ReplaceHTMLSpec('<span style="font-size:20px;">','</span>','[size=20]','[/size]');
Result:=ReplaceHTMLSpec('<span style="text-decoration:underline;">','</span>','[u]','[/u]');
Result:=ReplaceHTMLSpec('<span style="text-decoration:line-through;">','</span>','[s]','[/s]');
Result:=ReplaceHTMLSpec('<span style="text-decoration:blink;">','</span>','[blink]','[/blink]');
end;Пахнет селёдкой. Ой блять, забыл подмыться.
Support,
16 Октября 2021
+1
Ой, девачьки, я 5 лет не заходило. Почему нет говнокодов на Дульфи? Я десять страниц промотал! Неужели все дульфисты впали
в старческий маразм и не могут больше срать на этом недоязыке? Почему? Он же изначально создавался для даунов.
Что стало с Тарасом? Что стало с поняшей-ассемблеристом?Только одфаги меня вспомнят.
DelphiGovno,
28 Сентября 2021
+4
#!/usr/bin/env instantfpc
program PrintCharTable;
const
space = ' '; { }
point = '.'; {.}
caret = '^'; {^}
vline = '|'; {│}
hline = '-'; {─}
cross = '+'; {┼}
hex_0 = ord('0');
hex_a = ord('A')-10;
function tohex(d: integer): char;
begin
if d < 10 then
tohex := chr(d+hex_0)
else
tohex := chr(d+hex_a)
end;
var
i, j: integer;
code: integer;
begin
write(space, space, vline);
for i := 0 to 15 do
write(space, point, tohex(i));
writeln;
write(hline, hline, cross);
for i := 0 to 15 do
write(hline, hline, hline);
writeln;
for i := 0 to 15 do begin
write(tohex(i), point, vline);
for j := 0 to 15 do begin
code := i * 16 + j;
if code < 32 then
write(space, caret, chr(code+64))
else if code = 127 then
write(space, caret, chr(code-64))
else
write(space, space, chr(code))
end;
writeln
end
end.
{
$ ./print_ascii.pas | iconv -f koi8-r
| .0 .1 .2 .3 .4 .5 .6 .7 .8 .9 .A .B .C .D .E .F
--+------------------------------------------------
0.| ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O
1.| ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_
2.| ! " # $ % & ' ( ) * + , - . /
3.| 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
4.| @ A B C D E F G H I J K L M N O
5.| P Q R S T U V W X Y Z [ \ ] ^ _
6.| ` a b c d e f g h i j k l m n o
7.| p q r s t u v w x y z { | } ~ ^?
8.| ─ │ ┌ ┐ └ ┘ ├ ┤ ┬ ┴ ┼ ▀ ▄ █ ▌ ▐
9.| ░ ▒ ▓ ⌠ ■ ∙ √ ≈ ≤ ≥ ⌡ ° ² · ÷
A.| ═ ║ ╒ ё ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞
B.| ╟ ╠ ╡ Ё ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ©
C.| ю а б ц д е ф г х и й к л м н о
D.| п я р с т у ж в ь ы з ш э щ ч ъ
E.| Ю А Б Ц Д Е Ф Г Х И Й К Л М Н О
F.| П Я Р С Т У Ж В Ь Ы З Ш Э Щ Ч Ъ
}Печатает таблицу нужной кодировки. Пример использования в комменте после end.
Threadwalker,
20 Июля 2021
+1
program square;
var sep, input: string;
i, j, n, m : integer;
begin
write('sep:');
readln(sep);
write('str:');
readln(input);
for i:=1 to length(input) do write(input[i], ' ');
writeln();
for i:=2 to length(input)-1 do begin
write(input[i]);
for j:=1 to length(input)*2-3 do write (sep);
writeln(input[length(input) - i + 1]);
end;
for i:=0 to length(input)-1 do
write(input[length(input)-i], ' ');
end.
Написала на скучной лекции программку на телефоне, чтобы распечатывать
Х У Й
У У
Й У Х
KoWe4Ka_l7porpaMMep,
28 Марта 2021
0
type
.....
TSyncParamsPasser = class
PassedJSON:String;
constructor Create(RJS:String);
procedure ProcessExternalCmd;
end;
.....
.....
procedure TForm1.TCPServerExecute(AContext: TIdContext);
begin
.....
SyncParamsPasser:=TSyncParamsPasser.Create(CustomData);
TIdSync.SynchronizeMethod(SyncParamsPasser.ProcessExternalCmd);
FreeAndNil(SyncParamsPasser);
.....
end;
.....
constructor TSyncParamsPasser.Create(RJS:String);
begin
PassedJSON:=RJS;
end;
procedure TSyncParamsPasser.ProcessExternalCmd;
var
JSON:TJSONObject;
begin
JSON:=TJSONObject.ParseJSONValue(PassedJSON) as TJSONObject;
.....
Событие OnExecute компонента TCPServer вызывается из рабочего потока, в котором обрабатывается входящее подключение.
Способ передачи параметров в процедуру, выполняющуюся внутри Synchronize, с помощью класса.
Говно или сойдёт?
SmseR,
16 Марта 2021
−2
procedure ProgramRestart(Sender: TObject);
begin
Application.Terminate;
ShellExecute(0,'open',Application.ExeName,'','',SW_NORMAL); // ))
end;Неделю когда-то пытался понять почему этот код не работает: "Я же программу вырубил? - вырубил... Я же ее запускаю? - запускаю... А че она не запускается?)))..."
vovka3003,
13 Января 2021
Follow us!