|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
09.02.2010, 02:06 | #1 |
Регистрация: 07.02.2010
Сообщений: 9
|
3D в PascalABC
Помогите сделать что нить в 3D на PascalABC, или подскажите плиз как сделать
|
09.02.2010, 12:56 | #2 |
Регистрация: 07.02.2010
Сообщений: 9
|
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;tb crocedure(sender:Component);dvc rocedure(Sender:Component;Shift:Shi ftState;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.TickM arks:=tmTopLeft; TB.SetPos(1,t+name.height);TB.SetSi ze(Width-4,h-name.height*3); TB.MarkerSize:=15;TB.Max:=Max;TB.Mi n:=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.onmousedownEx t:=dvc; end; function getPosition:Integer; begin result:=tb.Position;end; procedure setPosition(v:Integer); begin tb.Position:=v;value.caption:=intto str(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,nrgbanel; setkab,osib,rotateb:checkbox; activefcase,nfcase,pfcase:combobox; nfcaseb,pfcaseb,dfcaseb:radiobutton ; satuhanie,shag,t0,tt,da,db,dg,bda,b db,bdg,dd,mx,my,x,y,z,dx,dy,a,b,d,r px,rpy,rpz,cordmax:real; setka,showosi,moveleft,moveright,fr otate:boolean; fpsc,fps,i,playicon,pauseicon:integ er; 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:r eal; 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),rand om(255)); figures.addfigure3d(rectangle3d.cre ate(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:Shif tState;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; |
09.02.2010, 12:57 | #3 |
Регистрация: 07.02.2010
Сообщений: 9
|
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.b eta:=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.rasbien ie); if pfunc3d.getfunction<>nil then tbr.position:=round(pfunc3d.rasbien ie); 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(10 0,100,100)); end else begin da:=0;db:=0;dg:=0; if (nfunc3d.getfunction<>nil)and(nfunc 3d.rasbienie<>tbr.position) then begin t1.stop;WaitMessage;nfunc3d.rasbien ie:=tbr.position;t1.start; end; if (pfunc3d.getfunction<>nil)and(pfunc 3d.rasbienie<>tbr.position) then begin t1.stop;WaitMessage;pfunc3d.rasbien ie:=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);s etdcaption(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(trackba r(sender).position); if sender=tbb.tb then tbb.value.caption:=inttostr(trackba r(sender).position); if sender=tbg.tb then tbg.value.caption:=inttostr(trackba r(sender).position); if sender=tbd.tb then tbd.value.caption:=inttostr(trackba r(sender).position); if sender=tbr.tb then tbr.value.caption:=inttostr(trackba r(sender).position); if sender=satuhanieb then begin satuhanie:=1+satuhanieb.position/1000; lsat.caption:=formatstr('%1.3f',sat uhanie); 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(c lred, 0,0,0,osi,0,0)); figures.addfigure3d(line3d.create(c lgreen,0,0,0,0,osi,0)); figures.addfigure3d(line3d.create(c lblue, 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; |
09.02.2010, 12:59 | #4 |
Регистрация: 07.02.2010
Сообщений: 9
|
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.enable d:=false; nfcaseb.checked:=false;pfcaseb.chec ked:=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',no w); statusb.caption:=FormatDateTime('dd .mm.yyyy',now); foptions.caption:=inttostr(fps)+' fps'; end; |
09.02.2010, 13:00 | #5 |
Регистрация: 07.02.2010
Сообщений: 9
|
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,Scr een.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.c olor:=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,'Graph 3D.bmp',1); toolb[5].hint:='Полноэкранный режим'; toolb.AddButton(optionsclick,'OPTIO NS'); 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('Graph3 D v1.5 (c)Ткачук А.В. 2004-2005'); nrgb:=panel.create(foptions,1,1,fop tions.clientwidth-2,440); StatusB:=statusBar.create(foptions) ; StatusB.add;StatusB[1].width:=StatusB.clientwidth div 2; tba:=mytrackbar.create(nrgb,nrgb.he ight-10,5,1,0,360,'X',onchangetb,ldclick ); tbb:=mytrackbar.create(nrgb,nrgb.he ight-10,tba.left+tba.width,1,0,360,'Y',o nchangetb,ldclick); tbg:=mytrackbar.create(nrgb,nrgb.he ight-10,tbb.left+tbb.width,1,0,360,'Z',o nchangetb,ldclick); tbd:=mytrackbar.create(nrgb,nrgb.he ight-10,tbg.left+tbg.width,1,100,2000,'Д ист',onchangetb,ldclick); tbr:=mytrackbar.create(nrgb,nrgb.he ight-10,tbd.left+tbd.width,1,5,rmax,'Раз б',onchangetb,ldclick); with satuhanieb do begin satuhanieb:=trackbar.create(foption s,1,nrgb.height+nrgb.top,foptions.c lientwidth-40,30); max:=50;min:=-max;Frequency:=max div 10;MarkerSize:=15;onchangeExt:=onch angetb; lsat:=TextLabel.Create(foptions);ls at.setpos(left+width,top+5);lsat.ca ption:='-0.000';lsat.hint:='Ускорение'; end; setkab:=checkbox.create(foptions); setkab.setpos(10,satuhanieb.height+ satuhanieb.top);setkab.width:=55;se tkab.caption:='Сетка';setkab.width: =70; setkab.onclickExt:=pcheckboxclick; osib:=checkbox.create(foptions); osib.setpos(setkab.left+setkab.widt h+25,setkab.top);osib.width:=45;osi b.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.captio n:='Обычные'; nfcase:=combobox.create(pncase);nfc ase.style:=csDropDownList; nfcase.setpos(nfcaseb.left,nfcaseb. top+nfcaseb.height);nfcase.DropDown Count:=10; for i:=1 to max_normf do nfcase.items.add(func_norm[i].name); pfcaseb:=radiobutton.create(pncase) ; pfcaseb.setpos(nfcase.left,nfcase.t op+nfcase.height);pfcaseb.caption:= 'Параметрические'; pfcaseb.width:=pncase.clientwidth-nfcase.left-1; pfcase:=combobox.create(pncase);pfc ase.style:=csDropDownList;pfcase.Dr opDownCount:=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.t op+pfcase.height);dfcaseb.caption:= 'Динамические'; dfcaseb.width:=150; dfcaseb.onclickExt:=ChangeFigure; t1:=timer.create(ontimer,30,false); t2:=timer.create(updatetime,500,tru e); end; |
09.02.2010, 13:01 | #6 |
Регистрация: 07.02.2010
Сообщений: 9
|
procedure initfigureslist(natural:boolean;nnu m,pnum:integer);
begin nfcase.itemindex:=nnum;pfcase.itemi ndex:=pnum; nfcaseb.checked:=natural;pfcaseb.ch ecked:=not natural; nfcaseb.onclickExt:=ChangeFigure;pf caseb.onclickExt:=ChangeFigure; nfcase.onchangeExt:=ChangeFigure;pf case.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(c llime,-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(cll ime,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+',milliseco nds,'ms'); updatetime; end. |
09.02.2010, 13:02 | #7 |
Регистрация: 07.02.2010
Сообщений: 9
|
вот за компеліруйте все і увідете 3D графику в паскале, как сделать что то похожое,
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Прокрутка В PascalABC | Рудко Дмитрий | Паскаль, Turbo Pascal, PascalABC.NET | 2 | 09.02.2010 01:51 |
Графы и PascalABC | ArcaN0id | Помощь студентам | 7 | 07.12.2009 19:46 |
PascalABC, uses | Gorny | Помощь студентам | 3 | 04.12.2009 13:12 |
PascalABC. файлы. | Gorny | Помощь студентам | 5 | 02.12.2009 21:06 |
PascalABC. Записи. | Gorny | Помощь студентам | 4 | 02.12.2009 18:11 |