- 1
- 2
- 3
i:=1;
if i=1 then i:=1;
else i:=1;
Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+142
i:=1;
if i=1 then i:=1;
else i:=1;
+95
cbZoom.Items.AddObject('125%', TObject(125));
cbZoom.Items.AddObject('120%', TObject(120));
cbZoom.Items.AddObject('115%', TObject(115));
cbZoom.Items.AddObject('110%', TObject(110));
cbZoom.Items.AddObject('105%', TObject(105));
cbZoom.Items.AddObject('100%', TObject(100));
cbZoom.Items.AddObject('95%', TObject(95));
cbZoom.Items.AddObject('90%', TObject(90));
cbZoom.Items.AddObject('85%', TObject(85));
cbZoom.Items.AddObject('80%', TObject(80));
cbZoom.Items.AddObject('75%', TObject(75));
cbZoom.Items.AddObject('70%', TObject(70));
cbZoom.Items.AddObject('65%', TObject(65));
cbZoom.Items.AddObject('60%', TObject(60));
cbZoom.Items.AddObject('55%', TObject(55));
cbZoom.Items.AddObject('50%', TObject(50));
cbZoom.Items.AddObject('45%', TObject(45));
cbZoom.Items.AddObject('40%', TObject(40));
cbZoom.Items.AddObject('35%', TObject(35));
cbZoom.Items.AddObject('30%', TObject(30));
cbZoom.Items.AddObject('25%', TObject(25));
cbZoom.Items.AddObject('20%', TObject(20));
cbZoom.Items.AddObject('15%', TObject(15));
cbZoom.Items.AddObject('10%', TObject(10));
cbZoom.ItemIndex := 5; //100%
вот кто-то так решил набить комбобокс...
+94
var
one, two, free, four:string;
begin
one:=sLabel14.Caption+slabel14.caption;
two:=sLabel1.Caption+slabel15.caption;
free:=sLabel10.Caption+slabel16.caption;
four:=sLabel7.Caption+slabel17.caption;
if ((one = two) or (one = free) or (one = four)
or (two = one) or (two = free) or (two = four)
or (free = one) or (free = two) or (free = four)
or (four = one) or (four = two) or (four = free))
then begin
showmessage('Значения должны быть различными');
end
else begin
showmessage('Успешно сохранено');
end;
Ну не лол?
+89
procedure TRashetDate_Form.Button1Click(Sender: TObject);
var a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, aa, ee: real;
res1: real;
res2: real;
res3: real;
res4: real;
res5: real;
res6: real;
res7: real;
res8: real;
res9: real;
res10: real;
res11: real;
res12: real;
res13: real;
res14: real;
res15: real;
res16: real;
res17: real;
res18: real;
res19: real;
res20: real;
res21: real;
res22: real;
res23: real;
Field: real;
<...>
Брал отсюда и рыдал...
http://www.cyberforum.ru/delphi-beginners/thread527956.html#post2835591
+81
type
TString=string[20];
TInputRec=record //Inputable record type - тип вводимой информации
FCol: TString; //первый, второй, третий столбец
SCol: TString;
TCol: TString;
end;
TInputRecArray=array [1..127]of TInputRec;
<...>
procedure InFile (var n0,k0:byte); //процедура формирования файлов
Var
InRec0 :TInputRec;
BufChar :char;
BufString:TString;
C,CharCheck,DigitCheck,DelBool,IncorBool:Boolean;
begin
n0:=0;
repeat
InRec0.FCol:='';
InRec0.SCol:='';
InRec0.TCol:='';
BufString:='';
IncorBool:=true;
DelBool:=false;
Inc(n0);
Writeln(n0:20);
while IncorBool do
begin
repeat
BufChar:=readkey;
StringDel(DelBool);
ExitCond(k0,C,CharCheck,DigitCheck,BufChar);
If C then Break;
If CharCheck then
begin
write(bufchar);
BufString:=BufString+BufChar;
end;
if DelBool then BufString:='';
DelBool:=false;
until BufChar=' ';
If C then Break;
InRec0.FCol:=Trim(BufString);
BreakProc(n0,IncorBool,InRec0.FCol);
end;
Writeln;
BufString:='';
IncorBool:=true;
if (k0=1) or (k0=2) then Break;
while IncorBool do
begin
repeat
BufChar:=readkey;
StringDel(DelBool);
ExitCond(k0,C,CharCheck,DigitCheck,BufChar);
If C then Break;
If DigitCheck or (BufChar='-') or (BufChar='/') or (BufChar='.') then
begin
Write(bufchar);
BufString:=BufString+BufChar;
end;
if DelBool then BufString:='';
DelBool:=false;
until BufChar=' ';
If C then Break;
InRec0.SCol:=Trim(BufString);
BreakProc(n0,IncorBool,InRec0.SCol);
end;
Writeln;
BufString:='';
DelBool:=false;
IncorBool:=true;
while IncorBool do
begin
repeat
BufChar:=readkey;
StringDel(DelBool);
ExitCond(k0,C,CharCheck,DigitCheck,BufChar);
If C then Break;
If DigitCheck or (BufChar='-') or (BufChar='/') or (BufChar='.') then
begin
Write(bufchar);
BufString:=BufString+BufChar;
end;
if DelBool then BufString:='';
DelBool:=false;
until BufChar=' ';
If C then Break;
InRec0.TCol:=Trim(BufString);
BreakProc(n0,IncorBool,InRec0.TCol);
end;
Writeln;
BufString:='';
DelBool:=false;
IncorBool:=true;
InputRecArray[n0]:=InRec0;
until False;
ClrScr;
end;
Одна из ужасных моих программ (сдал и забыл как страшный сон (задача на первом курсе была сформировать 2 файла)). Тогда даже не знал про оператор continue...
+89
// пароль как при входе в Win XP
Edit1.Font.Name:='Wingdings';
Edit1.PasswordChar:='l'; // символ "точка"
//
j:=78575;
j1:=j;
Edit6.Text:='1234567890АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюяABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz~ .,:;"-=+\/|!?@#$%^&*_№<>()[]{}`';
try
RichEdit2.Lines.LoadFromFile('conf.ps');
except
MessageDlg('Файл "conf.ps" не найден!',mtError,[mbOK],0);
Close;
end;
st:='1234567890АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюяABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz~ .,:;"-=+\/|!?@#$%^&*_№<>()[]{}`';
a:=RichEdit2.Lines.Strings[0];
x:=length(a);
try
for i:=1 to x do
begin
if pos(a[i],Edit6.Text)<>0 then
begin
Edit6.SelStart:=pos(a[i],Edit6.Text)-1;
n:=Edit6.SelStart;
s1:=n+1;
j:=j1;
s:=s1-j;
if ((s<=159) and (s>=0)) then
begin
s:=s1-j;
a[i]:=st[s];
goto M;
end;
j:=j1-n-1;
repeat
tt:=j-159;
s:=abs(tt);
j:=s;
until (s<=159);
s:=159-s;
a[i]:=st[s];
M:
end
else
end;
shif_str:=a;
except
MessageDlg('Ошибка открытия пароля!',mtError,[mbOK],0);
end;
вот такая процедура "проверки" пароля попалась)))
+88
function gethours: integer;
var
s: string;
h: integer;
begin
s := timetostr(time);
h := strtoint(s[1] + s[2]);
Result := h;
end;
function getmins: integer;
var
s: string;
h: integer;
begin
s := timetostr(time);
h := strtoint(s[4] + s[5]);
Result := h;
end;
function getsecs: integer;
var
s: string;
h: integer;
begin
s := timetostr(time);
h := strtoint(s[7] + s[8]);
Result := h;
end;
+78
implementation
uses import; { в юните import import_sel = class(TThread)}
var
ImportProcess: import_sel;
.......
procedure TDS150.btnImportClick(Sender: TObject);
begin
ImportProcess := import_sel.Create(True);
ImportProcess.priority := tphigher;
ImportProcess.FreeOnTerminate := True;
ImportProcess.Resume;
end;
+87
procedure makeWord(var str : string; var word : string);
var j, p,tp : integer;
begin
j:= 1;
p := pos(' ', str);
if (p = 0) then p:= length(str);
word := copy(str, 0, p);
delete(str, 0, p);
while (str[j] = ' ') or (str[j] = ''#9'') do begin
Inc(j);
end;
if (j > 0) then begin
delete(str,0,j-1);
end;
end;
var i,p,n : integer;
str, word : string;
begin
str := 'I want to tell you!';
readln(n);
for i:= 1 to n do begin
makeWord(str,word);
writeln(word);
end;
readln;
end.
Программа выводит первые n слов строки
+87
var
x,y,R:real;
l11,l12,l1,l21,l22,l2,l3,l41,l42,l4,l51,l52,l5,l6,l71,l72,l7:boolean;
begin
x:= StrToFloat(edit1.text);
y:= StrToFloat(edit2.text);
R:=StrToFloat(edit3.text);
l11:=(y<x) and (x*x+y*y<R*R) and (y>0);
l12:=(x*x+y*y<r*r) and (x<0)and (y>0);
l1:=l11 or l12;
l21:=(y>0) and (x*x+y*y<R*R)and (y>x);
l22:= ( x*x+y*y<R*R)and (y>x) and (x<0);
l2:= l21 or l22;
l3:=(y<0) and ( x*x+y*y<R*R)and (y>x);
l41:= (x>0) and ( x*x+y*y<R*R)and (y<x);
l42:= (x<-1) and ( x*x+y*y>R*R)and (y>x);
l4:= l41 or l42;
l51:= (x>1) and ( x*x+y*y>R*R)and (y<x);
l52:= (x>-1) and ( x*x+y*y>R*R)and (y<x);
l5:= l51 or l52;
l6:= (y>0) and ( x*x+y*y<R*R)and (y>x);
l71:= (x>0) and (x*x+y*y>R*R) and (y<0);
l72:= (y<0) and (x*x+y*y>R*R) and (y<x) and (x<0);
l7:= l71 or l72;
if l1= true then
begin
edit4.text:='T принадлежит 1 области';
end
else
begin
edit4.text:='T не принадлежит 1 области';
end;
if l2= true then
begin
edit4.text:='T принадлежит 2 области';
end
else
begin
edit4.text:='T не принадлежит 2 области'
end;
if l3= true then
begin
edit4.text:='T принадлежит 3 области'
end
else
begin
edit4.text:='T не принадлежит 3 области'
end;
if l4= true then
begin
edit4.text:='T принадлежит 4 области'
end
else
begin
edit4.text:='T не принадлежит 4 области'
end;
if l5= true then
begin
edit4.text:='T принадлежит 5 области'
end
else
begin
edit4.text:='T не принадлежит 5 области'
end;
if l6= true then
begin
edit4.text:='T принадлежит 6 области'
end
else
begin
edit4.text:='T не принадлежит 6 области'
end;
if l4= true then
begin
edit4.text:='T принадлежит 7 области'
end
else
begin
edit4.text:='T не принадлежит 7 области'
end;
end;
end.
...