Форум: "Прочее";
Текущий архив: 2006.03.12;
Скачать: [xml.tar.bz2];
ВнизКак молоды мы были, или смешные исходники :D Найти похожие ветки
← →
VictorT © (2006-02-13 18:10) [0]А давайте тут делится соббстевнными смешными исходниками?
Я вот тут чистку на компе проводил, нашёл функцию фиг знает какой давности.
Собствено, вот :DCString IntToStr(unsigned long n)
{
CString temp = "";
char m;
while(n != 0) {
m = n % 10;
n -= m;
temp = (m + "0") + temp;
}
return temp;
}
Это ж надо было додуматься :D
← →
Ega23 © (2006-02-13 18:12) [1]IncDay не моя, но она любой дебильный исходник переплюнет... :о)
← →
Игорь Шевченко © (2006-02-13 18:14) [2]http://www.delphimaster.ru/forums.shtml - 12 форумов со смешными исходниками в каждом.
← →
McSimm © (2006-02-13 18:19) [3]
> VictorT ©
Как и при игре на музыкальном инструменте, так и при работе на компьютере, когда скорость пальцев переходит определенную черту, необходимо начинать сдерживать скорость, упирая на качество :)
← →
Nikolay M. © (2006-02-13 18:24) [4]
> Ega23 © (13.02.06 18:12) [1]
> IncDay не моя, но она любой дебильный исходник переплюнет.
Поддерживаю. Плюс она еще и с глюками была, помнится :)))
← →
VictorT © (2006-02-13 18:45) [5]Одно дело было смотреть на чужой IncDay и прикаліваться, и совсем другое, когда я увидел у себя такую штуку :D Скатился под стол :D
← →
Andy BitOff © (2006-02-13 18:54) [6]А я вот что нашел =)
getnum:
...
e:=1;
try Fnum:=StrToInt(Trim(str));except e:=0;end;
if e=0 then goto getnum;
=)))
← →
VictorT © (2006-02-16 19:14) [7]А вот что в файле локализации phpMyAdmin нашёл :D
$strMaximumSize = "Минимальный размер: %s%s";
← →
TUser © (2006-02-17 12:18) [8]А я у себя Блокнот нашел. Даже забыл уже, что писал такое. В исходниках
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
New1Click(Sender);
end;
:))
← →
Igorek © (2006-02-17 14:52) [9]А я сразу серьезно писал.
← →
Ega23 © (2006-02-17 14:57) [10]А, ещё один шедевр вспомнил:
if Fl=True then
begin
Fl:=False;
end
else
if Fl=False then
begin
Fl:=True;
end;
← →
kaZaNoVa © (2006-02-17 15:31) [11]вычисление Pi методом Монте-Карло, прога была написана под впечатлением одной книги , еще оч давно ..
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
var N, t, m: Longint;
W, d, g: Extended; k: byte;
begin Randomize; Writeln;
N := 100000;
for k := 1 to 25 do begin
n := n * 2;
t := 0; Randomize;
for m := 1 to n do begin
W := Random; D := Random; if (w * w + d * d) < 1 then T := t + 1 else
end;
G := (4 * t / n); Writeln(g: 8: 7, " n=", n, " k=", k + 1);
end;
end.
← →
antonn © (2006-02-17 15:40) [12]
var tmp_min, tmp_max:TDateTime;
begin
tmp_max:=tmp_min-encodedate(1,1,2)+ encodedate(1,1,1);
end;
ЗЫ Это нужно было сутки отнять :/
идитотизм, хотя и знал, что дататайм - число. просто лень было переправлять.
← →
VictorT © (2006-02-17 16:07) [13]
> antonn © (17.02.06 15:40) [12]
А у меня вот такое было :DCTime t(timedlg.m_Time.GetYear(), timedlg.m_Time.GetMonth(), timedlg.m_Time.GetDay(), timedlg.m_Time.GetHour(), timedlg.m_Time.GetMinute(), timedlg.m_Time.GetSecond());
http://deep.webest.net/forum/77488/1/
← →
Yanis © (2006-02-17 16:39) [14]MFC - это уже само по себе смешно.
← →
Marser © (2006-02-17 16:59) [15]> [12] antonn © (17.02.06 15:40)
> var tmp_min, tmp_max:TDateTime;
> begin
> tmp_max:=tmp_min-encodedate(1,1,2)+ encodedate(1,1,1);
> end;
>
> ЗЫ Это нужно было сутки отнять :/
> идитотизм, хотя и знал, что дататайм - число. просто лень
> было переправлять.
У меня тоже похожее есть. Недописанное, к счастью:const ms:array[1..12]of byte=(31,28,31,30,31,30,31,31,
30,31,30,31);
...
function f29s(st,fin:integer):integer;
var c:=0,
i:integer;
begin
for i:=st to fin do
begin
if i mod 100>0 then
if (i mod 4 = 0) theh inc(c)
else if (i mod 100)mod 4 = 0 then inc(c)
end;
result:=c;
end;
← →
Andy BitOff © (2006-02-17 17:10) [16]Marser © (17.02.06 16:59) [15]
А у меня во как;
Function days (Year:integer; Month:integer):Integer;
begin
Case month of
1: Result:=31;
2: If (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)) then Result:=29 else Result:=28;
3: Result:=31;
4: Result:=30;
5: Result:=31;
6: Result:=30;
7: Result:=31;
8: Result:=31;
9: Result:=30;
10: Result:=31;
11: Result:=30;
12: Result:=31;
end;
end;
← →
Marser © (2006-02-17 17:28) [17]> [16] Andy BitOff © (17.02.06 17:10)
Тоже круто :-)
З.Ы. Тот код был написан четыре года назад. Меньше чем через год я познал прелести TDateTime и ухохатывался со своей изобретательности :-)
← →
Ученик чародея © (2006-02-17 17:29) [18]
function DecToHex(num:byte):string;
var High,Low:byte;
var HexStr:string;
begin
HexStr:="";
High:=num div $10;
Low:=num-High*$10;
//текстовое отображение
case (High) of
0:HexStr:=HexStr+"0";
1:HexStr:=HexStr+"1";
2:HexStr:=HexStr+"2";
3:HexStr:=HexStr+"3";
4:HexStr:=HexStr+"4";
5:HexStr:=HexStr+"5";
6:HexStr:=HexStr+"6";
7:HexStr:=HexStr+"7";
8:HexStr:=HexStr+"8";
9:HexStr:=HexStr+"9";
$0A:HexStr:=HexStr+"A";
$0B:HexStr:=HexStr+"B";
$0C:HexStr:=HexStr+"C";
$0D:HexStr:=HexStr+"D";
$0E:HexStr:=HexStr+"E";
$0F:HexStr:=HexStr+"F";
end;
case (Low) of
0:HexStr:=HexStr+"0";
1:HexStr:=HexStr+"1";
2:HexStr:=HexStr+"2";
3:HexStr:=HexStr+"3";
4:HexStr:=HexStr+"4";
5:HexStr:=HexStr+"5";
6:HexStr:=HexStr+"6";
7:HexStr:=HexStr+"7";
8:HexStr:=HexStr+"8";
9:HexStr:=HexStr+"9";
$0A:HexStr:=HexStr+"A";
$0B:HexStr:=HexStr+"B";
$0C:HexStr:=HexStr+"C";
$0D:HexStr:=HexStr+"D";
$0E:HexStr:=HexStr+"E";
$0F:HexStr:=HexStr+"F";
end;
DecToHex:=HexStr;
end;
Я выиграл?
← →
Игорь Шевченко © (2006-02-17 17:29) [19]Yanis © (17.02.06 16:39) [14]
Ты это фирме Oracle расскажи, вместе посмеетесь
← →
Marser © (2006-02-17 17:37) [20]> Я выиграл?
:-)
Круче [10] в разных его вариантах, придумать сложно :-)
← →
TUser © (2006-02-17 18:11) [21]И все-таки самый дебильный исходник был у меня. Крестики-нолики на форме 3х3. Примерно так
10 if newX = 0 and newY = 0 then gosub aaa
20 if newX = 0 and newY = 1 then gosub bbb
...
aaa gosub ccc " получаем новое
aaa+10 if newX = 0 and newY = 1 then gosub ddd
...
Шедевр, увы, не сохранился.
Правда, мне не хватило времени в комп. классе написать все варианты.
← →
DrPass © (2006-02-17 18:46) [22]
> TUser © (17.02.06 18:11) [21]
В следующий раз попробуй написать программу для игры в шахматы
← →
Nick Denry © (2006-02-17 18:51) [23]DrPass © (17.02.06 18:46) [22]
LOL :)
← →
Джо © (2006-02-17 19:04) [24]Не знаю, кого как, а меня больше печалит в своих старых исходниках несколько иное. Смешение визуальной части с логикой, не соответствие имен методов их назначению, методы на 500 строк... и тому подобная каша. Тяжело от всего этого избавляться, утешаю себя тем, что самоучка и тем, что, в конце концов, в свое время я не знал, что можно по-другому. Последние пару лет пытаюсь избавляться от дурацкого стремления сделать "побыстре шоб работало, а потом забыть и никому не показывать" :)
← →
Igorek © (2006-02-17 19:11) [25]А меня печалит, что старые исходники лучше новых. :(
← →
Fay © (2006-02-17 19:19) [26]Мой любимый код, правда не мой :
case c of
"0" : n := 0;
"1" : n := 1;
"2" : n := 2;
"3" : n := 3;
"4" : n := 4;
"5" : n := 5;
"6" : n := 6;
"7" : n := 7;
"8" : n := 8;
"9" : n := 9;
end;
← →
Sergey Masloff (2006-02-17 19:19) [27]Джо © (17.02.06 19:04) [24]
Знаешь вся эта тема плохая. Детский сад "Вот какой я был глупенький (произносится с умилением и намеком что не такой уж глупый) а теперь вот какой умненький.
А на самом деле любой из участников дай достаточно большой код боевого кода из самых последних - и я 100% таких перлов понахожу что хоть плачь хоть смейся. (У меня тоже найдут - можешь не сомневаться)
Сейчас как раз провожу аудит одного немаленького и вполне приличного проекта писаного вполне грамотными людьми. И такое эпизодически встречается что я поседею наверное преждевременно (правда полысею раньше).
А тема эта, повторюсь, детский сад...
← →
kaZaNoVa © (2006-02-17 19:25) [28]Джо © (17.02.06 19:04) [24]
"побыстре шоб работало, а потом забыть и никому не показывать" :)
гениально))
← →
VictorT © (2006-02-17 19:28) [29]
> TUser © (17.02.06 18:11) [21]
У моего друга круче было. Код дословно не помню, смысл постараюсь передать. На бейсике это ещё было. Он писал что-то типа обучалки таблице умножения.
Было что-то типа такого:
Если 1х1=1 то "правильно" иначе "неправильно"
Если 1х2=2 то "правильно" иначе "неправильно"
Если 2х1=2 то "правильно" иначе "неправильно"
Если 2х2=4 то "правильно" иначе "неправильно"
...
Если 100х100=10000 то "правильно" иначе "неправильно"
:))
← →
Джо © (2006-02-17 19:28) [30]> [27] Sergey Masloff (17.02.06 19:19)
Согласен.
Одно дело грамотно спроектировать и продумать парочку-другую классов, тут за пару лет можно насобачиться в этом деле, а совсем другое — сделать что-то работающее "прямо сейчас" в условиях, когда проект нужно было сдать "уже вчера". По крайней мере, говорю за себя. Таких перлов можно понаходить у себя любимого, что просто тошно.
← →
kaZaNoVa © (2006-02-17 19:28) [31]кстати, оцените плиз мою Лучшуб функцию посылки данных в сокет, написал очень давно, с тех пор не переделывал :)
Function SendCmd(Var q:string; Var s:TSocket):Boolean;
Const snd=1024;
Var z1,z2,z3,z4,z5:integer;
buf2: array[0..1023] of char;
Begin
Result:=True;
z1:=0;z2:=0;
z3:=length(q);z4:=length(q);
while true do begin
fillchar(buf2,sizeOf(buf2),0);
if z3>snd then begin
for z5:=0 to snd-1 do
buf2[z5]:=q[z2+z5+1];
z1:=send(S,buf2,snd,0); end else begin
for z5:=0 to z3-1 do
buf2[z5]:=q[z2+z5+1];
z1:=send(S,buf2,z3,0); end;
z2:=z2+z1;
z3:=z3-z1;
if (not(z1>0))then begin
Result:=False;
break;
end;
if (z2>=z4) then break;
if z1=-1 then q:="";
end;
End;
← →
VictorT © (2006-02-17 19:34) [32]
> Детский сад "Вот какой я был глупенький (произносится
> с умилением и намеком что не такой уж глупый) а теперь
> вот какой умненький.
Да, честно, говоря, ещё когда завёл тему, подумал, что чем-то таким попахивает.
В общем, я и сейчас глупый, но был ещё глупее :D
А вообще, завёл тему под влиянием импульса, когда увидел у себя сабжевый код.
← →
kaZaNoVa © (2006-02-17 19:35) [33]VictorT © (17.02.06 19:34) [32]
ветка как раз - "что бы внести в орешник ))"
← →
VictorT © (2006-02-17 19:41) [34]
> kaZaNoVa ©
Вполне может быть.
Но я не оправдываюсь :P
И не считаю, что зря завёл ветку.
← →
atruhin © (2006-02-17 19:52) [35]>> [27] Sergey Masloff (17.02.06 19:19)
У меня многие перлы появляются не в процессе проектирования, а в процессе срочного "латания дыр" и доработки. Когда находишь ошибку исправляешь и нет времени проанализировать весь метод, класс и увидеть, что это же можно сделать намного проще. Потом это накапливается. И когда добираешься до полного рефракторинга, такое находишь ... :)
← →
Странный (2006-02-17 20:12) [36]И что это вы хвалитесь своим буд-то бы смешным кодом? Если бы вы увидели то, что я понаписывал - неделю из под стола не вылазили бы. И так кодирую уже лет эдак двадцать с хвостиком. Самое странное в том, что всё работает и даже без всяких исключений и т.д. Но ни кому не покажу. :))
Корову свою не продам не кому, такая корова нужна самому (С) мультик
← →
Дмитрий Белькевич © (2006-02-18 04:48) [37]
> Одно дело грамотно спроектировать и продумать парочку-другую
> классов, тут за пару лет можно насобачиться в этом деле,
> а совсем другое — сделать что-то работающее "прямо сейчас"
> в условиях, когда проект нужно было сдать "уже вчера". По
> крайней мере, говорю за себя. Таких перлов можно понаходить
> у себя любимого, что просто тошно.
Есть такое страшное слово - refucktoring ;)
← →
Ученик чародея © (2006-02-18 04:56) [38]>>Sergey Masloff (17.02.06 19:19) [27]
>> А на самом деле любой из участников дай достаточно большой код боевого кода из самых последних - и я 100% таких перлов понахожу что хоть плачь хоть смейся. (У меня тоже найдут - можешь не сомневаться)
Такой, например:Procedure ShowFax(MessageId:integer;var Page: TfrPage;var ShowFaxQuery:TSDQuery;LowQualityPreview:boolean);
var F1:TFileStream;
Var BlobStream:TStream;
var Attr,Filename:Pchar;
var i,j:longword;
var p:PByteArray;
var b,TinyB:TBitMap;
var Tif:Pointer;
var w,h,bw,bh,iw:longword;
var raster:array of longword;
var frpic:TfrPictureView;
var XRes,Yres:single;
var Ypos:longword;
var ReadResult:integer;
var CurrentPageNumber:integer;
var TinyRect:TRect;
procedure WritePageNumberOnBitmap(var SBitmap:TBitMap;SPageNumber,FaxOrientation:integer);
var PSize:TSize;
var TextPageNumber:string;
var LB:Tbitmap;
var Rect:TRect;
begin
if SystemVariables.PrintPositionPageNumber<>"0" then
begin
LB:=Tbitmap.Create;
//297 высота
//210 ширина
//20 отступ снизу
LB.Canvas.Font.Size:=16;
//
TextPageNumber:=IntToStr(SPageNumber);
PSize:=LB.Canvas.TextExtent(TextPageNumber);
//
LB.Height:=PSize.cy;
LB.Width:=PSize.cx;
LB.Canvas.TextOut(0,0,TextPageNumber);
if (FaxOrientation=0) or (FaxOrientation=2) then
begin
//сверху страницы
if (SystemVariables.PrintPositionPageNumber="1") then
Rect.Top:=Trunc((SBitmap.Height/DYmm)*StrToInt(SystemVariables.ShiftNumberEdit){мм}+1);
//снизу страницы
if (SystemVariables.PrintPositionPageNumber="2") then
Rect.Top:=SBitmap.Height-(Trunc((SBitmap.Height/DYmm)*StrToInt(SystemVariables.ShiftNumberEdit){мм}+1)+PSize.cy*Trunc((SBitmap.H eight/DYmm)/3){отступ текста});
//
Rect.Left:=(SBitmap.Width-(PSize.cx*Trunc((SBitmap.Width/DXmm)/3))) div 2;
Rect.Right:=Rect.Left+LB.Width*Trunc((SBitmap.Width/DXmm)/3);
Rect.Bottom:=Rect.Top+LB.Height*Trunc((SBitmap.Height/DYmm)/3);
end;
//
if (FaxOrientation=1) or (FaxOrientation=3) then
begin
//сверху страницы
if (SystemVariables.PrintPositionPageNumber="1") then
Rect.Top:=Trunc((SBitmap.Height/DXmm)*StrToInt(SystemVariables.ShiftNumberEdit){мм}+1);
//снизу страницы
if (SystemVariables.PrintPositionPageNumber="2") then
Rect.Top:=SBitmap.Height-(Trunc((SBitmap.Height/DXmm)*StrToInt(SystemVariables.ShiftNumberEdit){мм}+1)+PSize.cy*Trunc((SBitmap.H eight/DXmm)/3){отступ текста});
//
Rect.Left:=(SBitmap.Width-(PSize.cx*Trunc((SBitmap.Width/DYmm)/3))) div 2;
Rect.Right:=Rect.Left+LB.Width*Trunc((SBitmap.Width/DYmm)/3);
Rect.Bottom:=Rect.Top+LB.Height*Trunc((SBitmap.Height/DXmm)/3);
end;
//
SBitmap.Canvas.StretchDraw(Rect,LB);
//
LB.Free;
end;
end;
begin
Application.ProcessMessages;
CurrentPageNumber:=0;
ShowFaxQuery.Active:=False;
ShowFaxQuery.SQL.Clear;
ShowFaxQuery.SQL.Add("select fax from faxmessages where id=:id;");
ShowFaxQuery.ParamByName("id").AsInteger:=MessageId;
ShowFaxQuery.Active:=True;
if (ShowFaxQuery.RecordCount>0) then
begin
CheckTempDir;
Filename:=Pchar(ExtractFilePath(Application.EXEName)+"temp\"+"tmp#"+IntToStr(Mes sageId)+"#tif.tif");
//загружаем в поток
BlobStream:=ShowFaxQuery.CreateBlobStream(ShowFaxQuery.FieldByName("fax"),bmRead );
F1:=TFileStream.Create(Filename,fmCreate);
F1.CopyFrom(BlobStream,0);
F1.Free;
BlobStream.Free;
← →
Ученик чародея © (2006-02-18 04:56) [39]
ShowFaxQuery.Active:=False;
ShowFaxQuery.SQL.Clear;
//открываем в бмп
Attr:="rw";
tif:=TiffOpen(Filename,Attr);
//
frpic:=TfrPictureView(Page.FindObject("Picture1"));
frpic.FillColor:=clWhite;
frpic.IsPrinting:=False;
//
if tif<>nil then
begin
repeat
TiffGetField(tif,TIFFTAG_IMAGEWIDTH,Addr(w));
TiffGetField(tif,TIFFTAG_IMAGELENGTH,Addr(h));
TiffGetField(tif,TIFFTAG_XRESOLUTION,Addr(XRes));
TiffGetField(tif,TIFFTAG_YRESOLUTION,Addr(Yres));
SetLength(raster,w*h+1);
case (FaxOrientation) of
0:ReadResult:=TIFFReadRGBAImageOriented(tif,w,h,raster,ORIENTATION_TOPLEFT,0);
1:ReadResult:=TIFFReadRGBAImageOriented(tif,w,h,raster,ORIENTATION_TOPRIGHT,0);
2:ReadResult:=TIFFReadRGBAImageOriented(tif,w,h,raster,ORIENTATION_BOTRIGHT,0);
3:ReadResult:=TIFFReadRGBAImageOriented(tif,w,h,raster,ORIENTATION_BOTLEFT,0)
else
ReadResult:=TIFFReadRGBAImageOriented(tif,w,h,raster,ORIENTATION_TOPLEFT,0);
end;
b:=TBitMap.Create;
b.pixelformat:=pf8bit;
b.Canvas.Pen.Color:=clWhite;
b.Canvas.Brush.Color:=clWhite;
b.Transparent:=false;
//
if (FaxOrientation=0) or (FaxOrientation=2) then
begin
b.width:=Trunc(A4InchWidth*Xres);
b.height:=Trunc(A4InchHeight*Yres);
end;
//
if (FaxOrientation=1) or (FaxOrientation=3) then
begin
b.width:=Trunc(A4InchHeight*Yres);
b.height:=Trunc(A4InchWidth*Xres);
end;
//
Ypos:=0;
if ReadResult<>0 then
begin
repeat
//
if ((Trunc(A4InchHeight*Yres)+Ypos)<=h) then bh:=(Trunc(A4InchHeight*Yres)-1) else bh:=h-1-Ypos;
//
if (Trunc(A4InchWidth*Xres)<=w) then bw:=(Trunc(A4InchWidth*Xres)-1) else bw:=w-1;
//
if Ypos<>0 then
b.Canvas.Rectangle(0,0,b.Width,b.Height);
//
if (FaxOrientation=0) or (FaxOrientation=2) then
begin
//
for i:=0 to bh do
begin
p:=B.ScanLine[i];
iw:=(i+Ypos)*w;
for j:=0 to bw do
p[j]:=Raster[iw+j];
end;
end;
//
if (FaxOrientation=1) or (FaxOrientation=3) then
begin
for i:=0 to bw do
begin
p:=B.ScanLine[i];
for j:=0 to bh do
p[j]:=Raster[(j+Ypos)*w+i];
end;
end;
//
inc(CurrentPageNumber);
WritePageNumberOnBitmap(b,CurrentPageNumber,FaxOrientation);
//assig low quality image to save memory usage
if LowQualityPreview then
begin
TinyB:=TBitmap.Create;
TinyB.Height:=Trunc((b.Height*50)/YRes);
TinyB.Width:=Trunc((b.Width*50)/XRes);
TinyRect.Left:=0;TinyRect.Top:=0;
TinyRect.Right:=TinyB.Width;
TinyRect.Bottom:=TinyB.Height;
TinyB.Canvas.StretchDraw(TinyRect,b);
frpic.Picture.Bitmap:=TinyB;
TinyB.Free;
end
else
begin
frpic.Picture.Bitmap:=b;
end;
//
frpic.Picture.Bitmap.Monochrome:=True;
frpic.Picture.Bitmap.PixelFormat:=pf1bit;
//
Page.ShowBandByName("MasterData1");
//
Ypos:=Ypos+Trunc(A4InchHeight*Yres);
//2 Дюйма отбрасываем
until ((Ypos+Trunc(2*Yres))>h);
end
else
begin
b.Canvas.Rectangle(0,0,b.Width,b.Height);
b.Canvas.Font.Size:=36;
b.Canvas.Pen.Color:=clBlack;
b.Canvas.TextOut(Trunc(2.5*Xres),Trunc(5*Yres),"Помилка вiдкриття сторiнки");
//
frpic.Picture.Bitmap:=b;
Page.ShowBandByName("MasterData1");
end;
//
SetLength(raster,0);
b.Free;
until (TiffReadDirectory(tif)=0);
end;
//сбрасываем ориентацию факса
FaxOrientation:=0;
//закрываем тифф
if tif<>nil then
TiffClose(tif);
//удаляем
DeleteFile(Filename);
end;
end;
← →
Джо © (2006-02-18 05:05) [40]> [37] Дмитрий Белькевич © (18.02.06 04:48)
> Есть такое страшное слово - refucktoring ;)
Ты не поверишь, я имею о нем представление. Даже знаю, кАк оно правильно пишется :)
Страницы: 1 2 вся ветка
Форум: "Прочее";
Текущий архив: 2006.03.12;
Скачать: [xml.tar.bz2];
Память: 0.59 MB
Время: 0.016 c