Знатоки PASCAL сюда!
Страница 1 из 1
#1
Отправлено 01 July 2012 - 17:34
и так ,у меня резко возникла потребность в небольшом мозговом штурме ,но друзей кодеров у меня нет .
Дано: Borland Pascal 7(именно паскаль,рекомендации про дельфи и прочую херню не рассматриваются),ноги ,руки ,голова , моцк...
Цель: 3d рендер обьектов таких как цилиндры кубы и плоскости(я не прошу огромных масштабов и охеренного качества) + небольшой AI(реализую сам)
от вас требуются идеи по реализации и много энтузиазма
Дано: Borland Pascal 7(именно паскаль,рекомендации про дельфи и прочую херню не рассматриваются),ноги ,руки ,голова , моцк...
Цель: 3d рендер обьектов таких как цилиндры кубы и плоскости(я не прошу огромных масштабов и охеренного качества) + небольшой AI(реализую сам)
от вас требуются идеи по реализации и много энтузиазма
icq 597801501
<span style="font-size:16pt;">I'm The Gogibeet</span>
<img src="http://img651.imageshack.us/img651/8753/soft725.gif" border="0" alt=""/>
<span style="font-size:16pt;">I'm The Gogibeet</span>
<img src="http://img651.imageshack.us/img651/8753/soft725.gif" border="0" alt=""/>
#2
Отправлено 03 July 2012 - 15:34
у меня работает вот это
uses vcl,utils,aboutbox,functions; const osi=200; dmax=10; rmax=700; rlmax=120; trasb=1000; tbegin=0; tend=100; dt=0.1; type MyTrackBar=class(panel) TB:TrackBar; DV,Value,Name:TextLabel; constructor create(parent:ContainerControl;h,l,t,min,max:integer;caption:string;tbc:procedure(sender:Component);dvc:procedure(Sender:Component;Shift:ShiftState;x,y:Integer)); begin inherited create(parent);parent:=self; bevelinner:=bvnone; bevelouter:=bvnone; Width:=30;height:=h;Left:=l;Top:=t; name:=TextLabel.create(parent);name.setpos(1,t);name.caption:=caption; TB:=TrackBar.Create(parent); TB.orientation:=orVertical;TB.TickMarks:=tmTopLeft; TB.SetPos(1,t+name.height);TB.SetSize(Width-4,h-name.height*3); TB.MarkerSize:=15;TB.Max:=Max;TB.Min:=Min;TB.Frequency:=round((Max-Min)/(h/5)); TB.OnChangeExt:=tbc; Value:=TextLabel.create(parent); Value.setpos(2,tb.top+tb.height-2);Value.Caption:=inttostr(min); DV:=TextLabel.create(parent); DV.setpos(2,Value.top+Value.height);DV.Caption:='0.0';dv.onmousedownExt:=dvc; end; function getPosition:Integer; begin result:=tb.Position;end; procedure setPosition(v:Integer); begin tb.Position:=v;value.caption:=inttostr(v);end; property Position:Integer Read GetPosition write SetPosition; end; var f1,foptions:Form; fabout:FormAboutBox; field:PaintBox3D; figures:list3D; menu:mainmenu; NFunc3D,NFunc3D2:NaturalFunction3D; PFunc3D:ParamFunction3D; l,lshag,lsat:TextLabel; shagedit:edit; bshag,babout:button; t1,t2:timer; satuhanieb:trackbar; tba,tbb,tbg,tbd,tbr:mytrackbar; pncase,nrgb:panel; setkab,osib,rotateb:checkbox; activefcase,nfcase,pfcase:combobox; nfcaseb,pfcaseb,dfcaseb:radiobutton; satuhanie,shag,t0,tt,da,db,dg,bda,bdb,bdg,dd,mx,my,x,y,z,dx,dy,a,b,d,rpx,rpy,rpz,cordmax:real; setka,showosi,moveleft,moveright,frotate:boolean; fpsc,fps,i,playicon,pauseicon:integer; fpsp:string; StatusB:StatusBar; toolB:toolbar; toolbt,playstopbt:toolbutton; // frames:ObjectArray; dynimgindex:integer; function rotate:boolean; begin result:=frotate; end; procedure setrotate(v:boolean); begin if v<>frotate then begin frotate:=v; rotateb.checked:=v; tba.tb.enabled:=not v; tbb.tb.enabled:=not v; tbg.tb.enabled:=not v; tbd.tb.enabled:=not v; tbr.tb.enabled:=not v; if rotate then begin da:=bda;db:=bdb;dg:=bdg; playstopbt.setImage('PAUSE'); end else begin bda:=da;bdb:=db;bdg:=dg; playstopbt.setImage('PLAY'); end; end; end; procedure f1resize; begin if field<>nil then begin field.centerx:=field.Width/2; field.centery:=field.Height/2; end; end; procedure createcub; var i:integer; c,cm,dm:integer;x1,x2,y1,y2,z1,z2:real; begin cm:=4000;dm:=200; for i:=1 to 200 do begin x1:=random(cm)-cm/2; y1:=random(cm)-cm/2; z1:=random(cm)-cm/2; x2:=random(dm)-dm/2; y2:=random(dm)-dm/2; z2:=random(dm)-dm/2; c:=rgb(random(255),random(255),random(255)); figures.addfigure3d(rectangle3d.create(c,x1,y1,z1,x1+x2,y1+y2,z1+z2)); end; end; procedure OnMouseDownm(Sender:Component;Shift:ShiftState;x,y:Integer); begin dx:=x;dy:=y; moveleft:=ssLeft in Shift; moveright:=ssRight in Shift; // field.savetofile('nj*'); end; procedure OnMouseMoveField(x,y,button:Integer); begin if moveleft then begin da:=x-dx;db:=y-dy; if abs(da)>dmax then da:=sign(da)*dmax; if abs(db)>dmax then db:=sign(db)*dmax; end; if moveright then begin dd:=y-dy; dg:=-x+dx; if abs(dg)>dmax then dg:=sign(dg)*dmax; if abs(dd)>dmax then dd:=sign(dd)*dmax; end; dx:=x;dy:=y; if f1.borderstyle=bsnone then begin if (y<20)and(not toolb.visible) then toolb.visible:=true; if (y>20)and(toolb.visible)then toolb.visible:=false; end; end; procedure OnMouseUpField(x,y,button:Integer); begin moveleft:=false; moveright:=false; end; procedure MenuItem1Click; begin f1.close; end; procedure MenuItem2Click; begin fabout.show; end; procedure MenuItem3Click; begin Execute('notepad graph3d.txt'); end; procedure ShowOptions; begin FOptions.show; end; procedure WaitMessage; begin foptions.caption:='Построение...'; Application.ProcessMessages; end; procedure ldclick(Sender:Component;Shift:ShiftState;x,y:Integer); var pr:^real; begin if sender=tba.dv then pr:=@da; if sender=tbb.dv then pr:=@db; if sender=tbg.dv then pr:=@dg; if sender=tbd.dv then pr:=@dd; if ssleft in shift then pr^:=-pr^; if ssright in shift then pr^:=0; end; procedure updatefps; begin fpsc:=fpsc+1; if fpsp<>formatdatetime('ss',now) then begin fps:=fpsc;fpsc:=0; fpsp:=formatdatetime('ss',now); end;{} end; procedure setdcaption(l:TextLabel;d:real); begin l.caption:=formatstr('%1.1f',d); with l.font do if abs(d)>dmax/2 then color:=clred else if d>0 then color:=clgreen else if d<0 then color:=clblue else color:=clblack; end; procedure ontimer; var vx,vy,vz:real; s:string; begin if moveleft or rotate then begin field.alpha:=field.alpha+da;field.beta:=field.beta+db; end; if moveright or rotate then field.gamma:=field.gamma+dg; if moveright or rotate then field.dist:=field.dist+dd;//sign(dd)*field.dist*0.01; if moveleft or moveright or rotate then begin tba.position:=round(field.alpha); tbb.position:=round(field.beta); tbg.position:=round(field.gamma); tbd.position:=round(field.dist); if nfunc3d.getfunction<>nil then tbr.position:=round(nfunc3d.rasbienie); if pfunc3d.getfunction<>nil then tbr.position:=round(pfunc3d.rasbienie); end; if rotate then begin if (abs(da)<dmax)or(satuhanie<1) then da:=da*satuhanie; if (abs(db)<dmax)or(satuhanie<1) then db:=db*satuhanie; if (abs(dg)<dmax)or(satuhanie<1) then dg:=dg*satuhanie; if (abs(dd)<dmax)or(satuhanie<1) then dd:=dd*satuhanie; field.Line(0,0,0,rpx,rpy,rpz,rgb(100,100,100)); end else begin da:=0;db:=0;dg:=0; if (nfunc3d.getfunction<>nil)and(nfunc3d.rasbienie<>tbr.position) then begin t1.stop;WaitMessage;nfunc3d.rasbienie:=tbr.position;t1.start; end; if (pfunc3d.getfunction<>nil)and(pfunc3d.rasbienie<>tbr.position) then begin t1.stop;WaitMessage;pfunc3d.rasbienie:=tbr.position;t1.start; end; end; if dfcaseb.checked then begin t:=t+dt; field.font.color:=cllime; field.textout(1,1,FormatStr('%1.2f',t)); nFunc3D.func:=nil; nfunc3d.func:=umf;{} {field.setlist3d(list3d(frames[dynimgindex])); dynimgindex:=dynimgindex+1; if dynimgindex>trasb then dynimgindex:=1;} end; field.show; updatefps; setdcaption(tba.dv,da);setdcaption(tbb.dv,db);setdcaption(tbg.dv,dg);setdcaption(tbd.dv,dd); end; procedure onchangetb(sender:Component); var l:TextLabel; begin if moveleft or moveright then exit; if sender=tba.tb then tba.value.caption:=inttostr(trackbar(sender).position); if sender=tbb.tb then tbb.value.caption:=inttostr(trackbar(sender).position); if sender=tbg.tb then tbg.value.caption:=inttostr(trackbar(sender).position); if sender=tbd.tb then tbd.value.caption:=inttostr(trackbar(sender).position); if sender=tbr.tb then tbr.value.caption:=inttostr(trackbar(sender).position); if sender=satuhanieb then begin satuhanie:=1+satuhanieb.position/1000; lsat.caption:=formatstr('%1.3f',satuhanie); with lsat.font do if satuhanie<>1 then color:=rgb(abs(satuhanieb.position*5),128-abs(satuhanieb.position)*2,0) else color:=clgreen; end; if not rotate then begin field.alpha:=tba.position; field.beta:=tbb.position; field.gamma:=tbg.position; field.dist:=tbd.position; end; end; procedure rotateclick; begin setrotate(not rotate); end; procedure pcheckboxclick(sender:Component); var cb:checkbox; begin cb:=checkbox(sender); if cb=rotateb then setrotate(cb.checked); if cb=osib then begin showosi:=cb.checked; t1.stop;WaitMessage; figures.clear; figures.addfigure3d(nfunc3d); figures.addfigure3d(nfunc3d2); figures.addfigure3d(pfunc3d); if showosi then begin figures.addfigure3d(line3d.create(clred, 0,0,0,osi,0,0)); figures.addfigure3d(line3d.create(clgreen,0,0,0,0,osi,0)); figures.addfigure3d(line3d.create(clblue, 0,0,0,0,0,osi)); end; t1.start; end; if cb=setkab then begin t1.stop; WaitMessage; setka:=cb.checked; if setka then tbr.tb.max:=rlmax else tbr.tb.max:=rmax; // onchangetb(tbr); nfunc3d.setka:=setka; nfunc3d2.setka:=setka; pfunc3d.setka:=setka; t1.start; end; end; procedure MenuItemNewClick; begin nfunc3d.func:=nil;pfunc3d.func:=nil;nfunc3d2.func:=nil; pcheckboxclick(osib); field.centerx:=f1.ClientWidth/2;field.centery:=f1.ClientHeight/2; field.Pen.color:=clGreen; field.Brush.Color:=f1.color; field.setrotatepoint(rpx,rpy,rpz); nfcase.enabled:=false;pfcase.enabled:=false; nfcaseb.checked:=false;pfcaseb.checked:=false; end; procedure ChangeFigure(sender:Component); var i:integer; dt:real; begin t1.stop; WaitMessage; if sender=nfcaseb then begin nfcase.enabled:=true; pfcase.enabled:=false; pFunc3D.func:=nil; foptions.activecontrol:=nfcase; ChangeFigure(nfcase); end; if sender=pfcaseb then begin pfcase.enabled:=true; nfcase.enabled:=false; nFunc3D.func:=nil; foptions.activecontrol:=pfcase; ChangeFigure(pfcase); end; if sender=dfcaseb then begin pfcase.enabled:=false; nfcase.enabled:=false; pFunc3D.func:=nil; { frames.clear; dt:=(tend-tbegin)/trasb;t:=tbegin; nfunc3d.func:=umf; for i:=1 to trasb do begin frames.add(list3d.create); field.setlist3d(list3d(frames[frames.size])); list3d(frames[frames.size]).AddFigure3d(nfunc3d); t:=t+dt; writeln('creating...',i) end; pFunc3D.func:=nil; nfunc3d.func:=umf;} end; if sender=pfcase then begin activefcase:=pfcase; pfunc3d.func:=func_param[pfcase.itemindex].func; end; if sender=nfcase then begin activefcase:=nfcase; nfunc3d.func:=func_norm[nfcase.itemindex].func; end; t:=t0;dt:=0.1; t1.start; end; procedure Form1Close; begin end; procedure FullScreen; begin if f1.borderstyle=bssizeable then begin f1.borderstyle:=bsnone; f1.windowstate:=wsMaximized; f1.menu:=nil; toolb.visible:=false; toolb.Align:=alnone; end else begin f1.windowstate:=wsNormal; f1.borderstyle:=bssizeable; f1.autoscroll:=false; toolb.Align:=alTop; f1.menu:=menu; end; end; procedure fullscrclick; begin FullScreen; end; procedure osiclick; begin osib.checked:=not osib.checked; pcheckboxclick(osib); end; procedure setkaclick; begin setkab.checked:=not setkab.checked; pcheckboxclick(setkab); end; procedure optionsclick; begin foptions.show; end; procedure f1closeclick; begin f1.close; end; procedure updatetime; begin statusb[2].text:=FormatDateTime('hh:nn:ss',now); statusb.caption:=FormatDateTime('dd.mm.yyyy',now); foptions.caption:=inttostr(fps)+' fps'; end; Procedure InitComponents; var i:integer; begin f1:=Form.Create(170,70,800,665);//f1.show; f1.color:=clblack; f1.caption:=vcl_info+', версия '+vcl_version; f1.autoscroll:=false; f1.onclose:=Form1Close; f1.onresize:=f1resize; { f1.alphablend:=true; f1.alphablendvalue:=100;{} { f1.TransparentColor:=true; f1.TransparentColorValue:=f1.color;{} foptions:=Form.Create(1,f1.top,170,f1.height);//foptions.show; foptions.caption:='Настройки'; foptions.borderstyle:=bssingle; foptions.bordericons:=[biSystemMenu]; {foptions.alphablend:=true; foptions.alphablendvalue:=200;{} figures:=list3d.create; setka:=false;showosi:=true;shag:=50; field:=PaintBox3d.create(f1,0,0,Screen.Width,Screen.Height); field.Brush.Color:=f1.color; field.Pen.Color:=f1.color; field.align:=alClient; field.onmousedownExt:=onmousedownm; field.onmouseup:=onmouseupfield; field.OnMouseMove:=OnMouseMoveField; field.setlist3d(figures); // field.ShowMode:=ShowMode; toolb:=toolbar.create(true);toolb.color:=clMenu;toolb.Autosize:=true; playstopbt:=toolbutton.create(toolb); playstopbt.onclick:=rotateclick; playstopbt.hint:='Вращение'; toolb.AddButton(osiclick, 'Graph3D.bmp',2); toolb[2].hint:='Оси'; toolb.AddButton(setkaclick, 'Graph3D.bmp',4); toolb[3].hint:='Сетка'; toolb.AddSeparator; toolb.AddButton(fullscrclick,'Graph3D.bmp',1); toolb[5].hint:='Полноэкранный режим'; toolb.AddButton(optionsclick,'OPTIONS'); toolb[6].hint:='Управление'; toolb.AddSeparator; toolb.AddButton(f1closeclick,'EXIT'); toolb[8].hint:='Выход'; menu:=mainMenu.create; menu.add('Файл'); //1 menu.add('Другие фигуры'); //2 menu.add('Параметры'); //3 menu.add('Помощь'); //4 menu[1].add('Новый', MenuItemNewClick,'NEW'); menu[1].add('Выход', MenuItem1Click, 'EXIT'); menu[2].add('Параллелепипеды',CreateCub, 'Graph3D.bmp',3); menu[2].add('Управление...', ShowOptions, 'OPTIONS'); menu[3].add('Полный экран', FullScreen, 'Graph3D.bmp',1); menu[4].add('Справка...', MenuItem3Click, 'HELP'); menu[4].add('О программе...', MenuItem2Click, 'HELP'); FAbout:=FormAboutBox.create('Graph3D v1.5 (c)Ткачук А.В. 2004-2005'); nrgb:=panel.create(foptions,1,1,foptions.clientwidth-2,440); StatusB:=statusBar.create(foptions); StatusB.add;StatusB[1].width:=StatusB.clientwidth div 2; tba:=mytrackbar.create(nrgb,nrgb.height-10,5,1,0,360,'X',onchangetb,ldclick); tbb:=mytrackbar.create(nrgb,nrgb.height-10,tba.left+tba.width,1,0,360,'Y',onchangetb,ldclick); tbg:=mytrackbar.create(nrgb,nrgb.height-10,tbb.left+tbb.width,1,0,360,'Z',onchangetb,ldclick); tbd:=mytrackbar.create(nrgb,nrgb.height-10,tbg.left+tbg.width,1,100,2000,'Дист',onchangetb,ldclick); tbr:=mytrackbar.create(nrgb,nrgb.height-10,tbd.left+tbd.width,1,5,rmax,'Разб',onchangetb,ldclick); with satuhanieb do begin satuhanieb:=trackbar.create(foptions,1,nrgb.height+nrgb.top,foptions.clientwidth-40,30); max:=50;min:=-max;Frequency:=max div 10;MarkerSize:=15;onchangeExt:=onchangetb; lsat:=TextLabel.Create(foptions);lsat.setpos(left+width,top+5);lsat.caption:='-0.000';lsat.hint:='Ускорение'; end; setkab:=checkbox.create(foptions); setkab.setpos(10,satuhanieb.height+satuhanieb.top);setkab.width:=55;setkab.caption:='Сетка';setkab.width:=70; setkab.onclickExt:=pcheckboxclick; osib:=checkbox.create(foptions); osib.setpos(setkab.left+setkab.width+25,setkab.top);osib.width:=45;osib.caption:='Оси'; osib.onclickExt:=pcheckboxclick; rotateb:=checkbox.create(foptions); rotateb.setpos(10,setkab.top+setkab.height);rotateb.caption:='Вращение'; rotateb.onclickExt:=pcheckboxclick; pncase:=panel.create(foptions); pncase.setpos(1,rotateb.top+rotateb.height+2); pncase.setsize(foptions.clientwidth-1,foptions.clientheight-pncase.top-statusb.height); nfcaseb:=radiobutton.create(pncase); nfcaseb.setpos(10,5);nfcaseb.caption:='Обычные'; nfcase:=combobox.create(pncase);nfcase.style:=csDropDownList; nfcase.setpos(nfcaseb.left,nfcaseb.top+nfcaseb.height);nfcase.DropDownCount:=10; for i:=1 to max_normf do nfcase.items.add(func_norm[i].name); pfcaseb:=radiobutton.create(pncase); pfcaseb.setpos(nfcase.left,nfcase.top+nfcase.height);pfcaseb.caption:='Параметрические'; pfcaseb.width:=pncase.clientwidth-nfcase.left-1; pfcase:=combobox.create(pncase);pfcase.style:=csDropDownList;pfcase.DropDownCount:=nfcase.DropDownCount; pfcase.setpos(pfcaseb.left,pfcaseb.top+pfcaseb.height); for i:=1 to max_paramf do pfcase.items.add(func_param[i].name); dfcaseb:=radiobutton.create(pncase); dfcaseb.setpos(pfcase.left,pfcase.top+pfcase.height);dfcaseb.caption:='Динамические'; dfcaseb.width:=150; dfcaseb.onclickExt:=ChangeFigure; t1:=timer.create(ontimer,30,false); t2:=timer.create(updatetime,500,true); end; procedure initfigureslist(natural:boolean;nnum,pnum:integer); begin nfcase.itemindex:=nnum;pfcase.itemindex:=pnum; nfcaseb.checked:=natural;pfcaseb.checked:=not natural; nfcaseb.onclickExt:=ChangeFigure;pfcaseb.onclickExt:=ChangeFigure; nfcase.onchangeExt:=ChangeFigure;pfcase.onchangeExt:=ChangeFigure; if natural then ChangeFigure(nfcaseb) else ChangeFigure(pfcaseb); end; begin //Application.EnableVCLDebug; InitComponents; rpx:=0;rpy:=0;rpz:=0; // rpx:=40;rpy:=80;rpz:=100; cordmax:=field.width; dynimgindex:=1; shag:=50; satuhanie:=1;//0.995; nFunc3D:=NaturalFunction3D.Create(cllime,-fieldsize/2,-fieldsize/2,fieldsize/2,fieldsize/2,shag,false,nil); nFunc3D2:=NaturalFunction3D.Create(cllime,-fieldsize/2,-fieldsize/2,fieldsize/2,fieldsize/2,shag,false,{polusharminus}nil); PFunc3D:=ParamFunction3D.Create(cllime,0,0,360,360,shag,false,nil); field.dist:=1000; osib.checked:=showosi; MenuItemNewClick; field.alpha:=-10;field.beta:=20;field.gamma:=0; bda:=0.1;bdb:=-0.5;bdg:=0; setrotate(true);{} satuhanieb.position:=satuhanieb.max*2-round(satuhanie*satuhanieb.max*2); onchangetb(satuhanieb); initfigureslist(random(2)=1,4,5); setkab.checked:=nfcaseb.checked; t1.start; foptions.show; writeln(compiletime,'ms+',milliseconds,'ms');
#3
Отправлено 03 July 2012 - 18:12
ну без дельфи же ,без дельфи . что за модули вначале??
icq 597801501
<span style="font-size:16pt;">I'm The Gogibeet</span>
<img src="http://img651.imageshack.us/img651/8753/soft725.gif" border="0" alt=""/>
<span style="font-size:16pt;">I'm The Gogibeet</span>
<img src="http://img651.imageshack.us/img651/8753/soft725.gif" border="0" alt=""/>
#7
Отправлено 08 July 2012 - 14:14
ладн,попробую переписать спс
не один из известных мне программных сред паскаля его не запускает
не один из известных мне программных сред паскаля его не запускает
icq 597801501
<span style="font-size:16pt;">I'm The Gogibeet</span>
<img src="http://img651.imageshack.us/img651/8753/soft725.gif" border="0" alt=""/>
<span style="font-size:16pt;">I'm The Gogibeet</span>
<img src="http://img651.imageshack.us/img651/8753/soft725.gif" border="0" alt=""/>
Поделиться темой:
Страница 1 из 1