Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+107
procedure delonefromend(var p:TPointer);
var i,n:integer; t:TPointer;
begin
i:=1;
t:=p;
while p<>nil do
begin
t:=t^.next;
i:=i+1;
end;
for n:=1 to i do p:=p^.next;
dispose(p^.next);
end;Для того чтобы добраться до последнего элемента в списке, сначала циклом подсчитывается в i их количество, а потом другим циклом от 1 до I указатель p перемещается на i элементов, тобишь в конец.
anigon,
03 Марта 2011
+128
uses crt;
var
d,m,k:integer;
begin
write('Введите день - ');readln(d);
write('Введите месяц - ');readln(m);
case m of
1: k:=365-d;
2: k:=365-(31+d);
3: k:=365- (31+28+d);
4: k:=365- (31+28+31+d);
5: k:=365- (31+28+31+30+d);
6: k:=365- (31+28+31+30+31+d);
7: k:=365- (31+28+31+31+30+30+d);
8: k:= 365-(31+28+31+31+30+30+31+d);
9: k:= 365- (31+28+31+31+30+31+30+31+d);
10: k:=365- (31+28+31+31+30+31+31+30+30+d);
11: k:=365- (31+28+31+31+30+31+31+30+30+31+d);
12: k:=365- (31+28+31+31+30+31+31+30+31+30+30+d);
end;
writeln('До конца года осталось ',k,' дн.');
end.
Juris_Kabanis,
03 Марта 2011
+98
Procedure TreeNodeBuilding(Tree: TTreeView; Query: TZQuery; DestinationNode: TTreeNode;
IdColumn, NameColumn, FilterColumn, TableType: String; Filtering:Boolean; ImageIndex:Integer);
//-------------------------------------------------//
Function AddOrNot:Boolean; //Фильтрация по ИД
var
Add: Boolean;
begin
Add:=False;
If Filtering=False then Add:=True else
begin
if DestinationNode=nil then Add:=True else
begin
MyNodeParamPtr:=DestinationNode.Data;
if MyNodeParamPtr^.id=Query.FieldValues[FilterColumn] then Add:=True;
end;
end;
Result:=Add;
end;
//-------------------------------------------------//
Procedure AddTreeNodeToViewer; //Добавление ветки
var
MyNode: TTreeNode;
begin
//Добавляем новую запись в массив и заполняем её
// Inc(ArrMyNodeParamLength);
// SetLength(ArrMyNodeParam, ArrMyNodeParamLength);
New(MyNodeParamPtr);
MyNodeParamPtr^.id:=Query.FieldValues[IdColumn];
MyNodeParamPtr^.table:=TableType;
//Добавляем новый узел дерева и указатель на соотв запись
if DestinationNode=nil then
MyNode:=Tree.Items.AddObject(DestinationNode, VarToStr(Query.FieldValues[NameColumn]), MyNodeParamPtr)
else MyNode:=Tree.Items.AddChildObject(DestinationNode, VarToStr(Query.FieldValues[NameColumn]), MyNodeParamPtr);
MyNode.ImageIndex:=ImageIndex;
MyNode.SelectedIndex:=ImageIndex;
end;
//-------------------------------------------------//
begin
//
Query.First;
if AddOrNot=True then AddTreeNodeToViewer;
Query.Next;
while not Query.Eof do
begin
if AddOrNot=True then AddTreeNodeToViewer;
Query.Next;
end;
end;Добавление ветки в TreeView. Я тут явно перемудрил
nikitasnv,
02 Марта 2011
+96
procedure TForm1.RegHttpRedirect(Sender: TObject; var dest: String;
var NumRedirect: Integer; var Handled: Boolean;
var VMethod: TIdHTTPMethod);
begin
Log('Redirect № ' + IntToStr(NumRedirect)+ ' - '+ Dest , true, MainClr);
end;
procedure TForm1.HTTPCoreStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
begin
Log('Статус: '+ AStatusText, true, MainClr);
end;
{procedure TForm1.RegHttpW0rk(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
end;}лошарский код
megaruliz,
28 Февраля 2011
+92
type BOOK= record
Name:string[20];
Avtor:string[20];
Price:integer;
end;
BOOKS=Array[1..100] of BOOK;
F= File of BOOK;
procedure Vvod(var biblioteka: books; var File_tBIBL:F; var n:integer);
Procedure AVTOR_KN(VAR File_tBIBl:F; VAR File_tBIBl_AVTOR:text);
Procedure TIP_TEXT(VAR File_tBIBl:F; VAR File_tBIBl_text:text);
Function MIN_CENA( var File_tBIBl:F ; n:integer ):integer;
procedure Vvod(var biblioteka: books; var File_tBIBL:F; var n:integer);
var i:integer;
begin
rewrite(File_tBIBL);
FOR i:=1 to n do begin
Writeln(' Vvedite nazvanie knigi');
readln(biblioteka[i].Name);
Writeln(' Vvedite avtora');
readln(biblioteka[i].Avtor);
Writeln(' Vvedite cenu');
readln(biblioteka[i].Price);
Write(File_tBIBL,biblioteka[i]);
writeln;
end;
close(File_tBIBL);
end;
Procedure TIP_TEXT(VAR File_tBIBl:F; VAR File_tBIBl_text:text);
var BIBLIOTEKA:BOOk;
BEGIN
reset(File_tBIBl);
rewrite(File_tBIBl_text);
WHILE not eof(File_tBIBl) do begin
read(File_tBIBl,BIBLIOTEKA);
writeln(File_tBIBl_text,BIBLIOTEKA.Name);
writeln(File_tBIBl_text,BIBLIOTEKA.Avtor);
writeln(File_tBIBl_text,BIBLIOTEKA.Price);
writeln(File_tBIBl_text);
writeln(File_tBIBl_text);
end;
close(File_tBIBl);
close(File_tBIBl_text);
end;
Procedure AVTOR_KN(VAR File_tBIBl:F; VAR File_tBIBl_AVTOR:text);
var BIBLIOTEKA:BOOk; Av:string;
BEGIN
reset(File_tBIBl);
rewrite(File_tBIBl_AVTOR);
Writeln('Vvedite iskomogo avtora');
readln(Av);
WHILE not eof(File_tBIBl) do begin
read(File_tBIBl,BIBLIOTEKA);
if BIBLIOTEKA.Avtor = Av then begin
writeln(File_tBIBl_AVTOR,BIBLIOTEKA.Name);
writeln(File_tBIBl_AVTOR,BIBLIOTEKA.Avtor);
writeln(File_tBIBl_AVTOR,BIBLIOTEKA.Price:4);
writeln(File_tBIBl_AVTOR);
end;
end;
close(File_tBIBl);
close(File_tBIBl_AVTOR);
end;
var nomer,i,min:integer;BIBLIOTEKA:BOOks; SIZE:integer;
begin
reset(File_tBIBl);
size:=1;
while not eof(File_tBIBl) do
with BIBLIOTEKA[size] do
begin
readln(File_tBIBl , BIBLIOTEKA.name);
Readln(File_tBIBl,BIBLIOTEKA.Avtor);
readln(File_tBIBl,BIBLIOTEKA.Price);
inc(size);
end;
dec(size);
min:=BIBLIOTEKA[1].Price;
for i:=1 to size do
if BIBLIOTEKA[i].Price< min then begin
min:=BIBLIOTEKA[i].Price;
nomer:=i;
end;
Juris_Kabanis,
27 Февраля 2011
+131
if (Edit40.Text<>t1) and (Edit38.Text<>t1) and (Edit36.Text<>t1) and (Edit34.Text<>t1) and (Edit32.Text<>t1) and (Edit30.Text<>t1) and (Edit28.Text<>t1) and (Edit26.Text<>t1) and (Edit24.Text<>t1) and (Edit22.Text<>t1) and (Edit20.Text<>t1) and (Edit18.Text<>t1) and (Edit16.Text<>t1) and (Edit14.Text<>t1) and (Edit12.Text<>t1) and (Edit10.Text<>t1) and (Edit8.Text<>t1) and (Edit6.Text<>t1) and (Edit4.Text<>t1) and (edit2.Text<>t1) ...
Старый мем с форума:
"Здрасте, вообщем такая проблемка:
У меня Unit10.pas занимает 13378 КБ (13.0 МБ)
И при работе в коде 10 формы после 5-10 изменений делфи начинает виснуть на 5-20 сек. (приходится вырезать весь текс кроме нужной процедуры и т.д, вставлять в блокнот, писать процедуру и затем обратно вставлять в делфи вырезанный текст из блокнота).
И компелируется тож долговато.
Всего 59988 строк.
На строчке 400-500 знаков (эт только там где условие, но часть условия(для удобства) переходит на 2 строчку (если все вместить, то будет примерно 35000 строк))
____________________________________
Постараюсь нормально сформулировать что хочу сделать.
Есть часть условия:
(код выше. прим. ReallyBugMeNot)
____________________________________
Оно повторяется если быть точным 4200 раз.
Изменяются только "номера\имена" эдитов (только четные от 2 до 240) и "t1" (t2, t3, t4, .. ,t35).
Хотелось бы задать переменную (Например "Z") и присвоить ей это условие, но так чтобы переменные "t1, t2, t3, .. ,t35)" и "имена\номера" эдитов задавались в каждой процедуре (всего 6 процедур), где находится оставшееся часть условия.
Можите подсказать как мне это реализовать?
Зарание спс."
Остается только удивлятся терпеливости человека, который позволил исходнику разростись до тринадцати мегов, прежде чем заметил, что что то не так.
ReallyBugMeNot,
25 Февраля 2011
+85
// ComPort1: TComPort; компонент для работы RS-232
type
Tst5=string[5];
var
Form1: TForm1;
lastcnl:byte;
CommonShiftTT:integer;
roundtt:integer;
Start_Proces:boolean;
intN,intdg0,intdg50:integer;
cerr,cerr0,cerr50:integer;
intdg:integer;
cnl:integer;
b:array [1..5]of byte;
s,sdg50,sdg0,ss:Tst5;
tt,realdg:real;
implementation
{$R *.dfm}
procedure TForm1.ComPort1RxBuf(Sender: TObject; const Buffer;
Count: Integer);
var
i:integer;
p:pointer;
begin
for i:=1 to 5 do b[i]:=0;
ListBox1.Items.clear;
if ComPort1.Connected then begin
p:=@Buffer;
b[1]:=byte(p^);
end
else begin
exit;
end;
cnl:=b[1];
if cnl=0 then begin
Start_Proces:=true;
end;
ListBox1.Items.Add(inttostr(cnl));
if Start_Proces=true then begin
b[2]:=Byte(pointer(longint(p)+1)^);
b[3]:=Byte(pointer(longint(p)+2)^);
b[4]:=Byte(pointer(longint(p)+3)^);
b[5]:=Byte(pointer(longint(p)+4)^);
if (b[2] and $20)>0 then ss[1]:='+' else ss[1]:='-';
if (b[2] and $40)>0 then ss[2]:='0' else ss[2]:='1';
FOR i:=3 TO 5 DO begin
case b[i] of
$82:ss[i]:='0';
$CF:ss[i]:='1';
$A4:ss[i]:='2';
$85:ss[i]:='3';
$C9:ss[i]:='4';
$91:ss[i]:='5';
$90:ss[i]:='6';
$C7:ss[i]:='7';
{min}$80:ss[i]:='8';
$81:ss[i]:='9';
$FF:ss[i]:='x'
else ss[i]:=chr(b[i]);
end;
ss[0]:=#5;
case cnl of
0:begin
vaL(ss,intdg0,cerr0);
stR(intdg0,sdg0);
Label1.Caption:=inttostr(intdg0);
end;
1:begin
vaL(ss,intdg50,cerr50);
stR(intdg50,sdg50);
Label2.Caption:=inttostr(intdg50);
end;
2..26:begin
vaL(ss,intN,cerr);
intN:=intN-intdg0+CommonShiftTT;
realdg:=intN/((intdg50-intdg0)/500);{real type}
intdg:=SMALLINT(round(realdg));{integer type}
tt:=intdg/10;
roundtt:=SMALLINT(round(tt));{integer}
stR(roundtt:5,s);
end;
end;
end;
ListBox1.Items.Add('float='+floattostr(tt));
ListBox1.Items.Add(inttostr(cnl)+'='+ss+' = '+inttostr(roundtt));
end;
end;
Процедура приема и обработки Кодов АЦП с контроллера. Контроллер обрабатывает данные полученные с температурных (аналоговых) датчиков и передает на COM в цифровом виде.
Сделано для АКГУП Индустриальный г. Барнаул
zak,
25 Февраля 2011
+107
procedure proc(a, b: integer);
begin
end;
proc(1, 2,); // лишняя запятая после 2 !!!!11на Delphi7 компилится и работает!!! Я в шокенах, 8 лет на Делфи и не знал...
StriderMan,
14 Февраля 2011
+103
glpushmatrix;
if ((commandflat=2)and((commandaxis=2) or(commandaxis=3)))or((commandflat=1)and(commandaxis=1)) then
glrotatef(faza,rotation[0],rotation[1],rotation[2]);
glcolor3f(kubcol[Y[2,1,1]].R,kubcol[Y[2,1,1]].G,kubcol[Y[2,1,1]].B);
glbegin(gl_quads);
glvertex3f(-1.5,1.5,1.5);
glvertex3f(-1.5,1.5,0.5);
glvertex3f(-0.5,1.5,0.5);
glvertex3f(-0.5,1.5,1.5);
glend;
glcolor3f(kubcol[X[1,1,1]].R,kubcol[X[1,1,1]].G,kubcol[X[1,1,1]].B);
glbegin(gl_quads);
glvertex3f(-1.5,1.5,1.5);
glvertex3f(-1.5,1.5,0.5);
glvertex3f(-1.5,0.5,0.5);
glvertex3f(-1.5,0.5,1.5);
glend;
glcolor3f(kubcol[Z[2,1,1]].R,kubcol[Z[2,1,1]].G,kubcol[Z[2,1,1]].B);
glbegin(gl_quads);
glvertex3f(-1.5,1.5,1.5);
glvertex3f(-0.5,1.5,1.5);
glvertex3f(-0.5,0.5,1.5);
glvertex3f(-1.5,0.5,1.5);
glend;
glcolor3f(0.5,0.5,0.5);
glbegin(gl_quads);
glvertex3f(-1.5,0.5,1.5);
glvertex3f(-1.5,0.5,0.5);
glvertex3f(-0.5,0.5,0.5);
glvertex3f(-0.5,0.5,1.5);
glend;
glcolor3f(0.5,0.5,0.5);
glbegin(gl_quads);
glvertex3f(-0.5,1.5,1.5);
glvertex3f(-0.5,1.5,0.5);
glvertex3f(-0.5,0.5,0.5);
glvertex3f(-0.5,0.5,1.5);
glend;
glcolor3f(0.5,0.5,0.5);
glbegin(gl_quads);
glvertex3f(-1.5,1.5,0.5);
glvertex3f(-0.5,1.5,0.5);
glvertex3f(-0.5,0.5,0.5);
glvertex3f(-1.5,0.5,0.5);
glend;
glpopmatrix;
///////112Захотел как то кубик рубика накодить, это фрагмент модуля из 1214 строк который выводит 26 кубиков. Цвет лицевых граней берется из массива, остальные - серые.
Dent,
14 Февраля 2011
+101
type Table = record
f1, f2, f3, f4, f5: integer;
end;
procedure Sort(a: array of Table; L, R: integer; Shift: integer);
begin
// что-то там...
// сравнение элементов:
if pinteger(size_t(@a[i])+Shift)^ < pinteger(size_t(@a[j])+Shift)^
end;
Использование: Sort(a, 0, Length(a) - 1, size_t(@a[0].f4) - size_t(@a[0]))
сортировка по полю f4.
chaoswithin,
13 Февраля 2011
Follow us!