home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / news / 556 / demo3dw.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-02  |  10KB  |  314 lines
  1. (******************************************************************************
  2. *                                   demo3dW                                   *
  3. ******************************************************************************)
  4. program demo3dW;
  5.  
  6. {$R 3dLIB.RES}
  7.  
  8.  
  9.  
  10. uses
  11. {$ifdef ver15}
  12.     wObjects
  13. {$else}
  14.    oWindows
  15.    ,oDialogs
  16. {$endif}
  17.     ,winProcs
  18.     ,winTypes
  19.     ,rtObj
  20.     ,project3
  21.     ,hdr3d
  22.     ,ctm3d
  23.     ;
  24. const
  25.    id_icon = '3DICO';
  26.    id_cursor = '3DCUR';
  27.    id_menu = '3DMEN';
  28.  
  29.    cm_about = 101;
  30.    cm_reDraw = 102;
  31.    cm_quit = 103;
  32. type
  33.     Pr2d2Application = ^ r2d2Application;
  34.     r2d2Application = object(TApplication)
  35.  
  36.         procedure initMainWindow; virtual;
  37.  
  38.     end; {r2d2Application object definition}
  39.  
  40.     Pr2d2Window = ^ r2d2Window;
  41.     r2d2Window = object(TWindow)
  42.  
  43.  
  44.       constructor init(AParent : PWindowsObject; ATitle : PChar);
  45.         procedure paint(paintDC : HDC; var paintInfo : TPaintStruct); virtual;
  46.       procedure setupWindow; virtual;
  47.       procedure WMDestroy(var msg : TMessage); virtual wm_first + wm_destroy;
  48.       procedure wmTimer(var msg : TMessage); virtual wm_first + wm_timer;
  49.         procedure error(i : byte; j : word);
  50.        procedure getWindowClass(var AWndClass : TWndClass); virtual;
  51.        procedure cmQuit(var Msg : TMessage); virtual cm_first + cm_quit;
  52.        procedure cmReDraw(var Msg : TMessage); virtual cm_first + cm_reDraw;
  53.        procedure cmAbout(var Msg : TMessage); virtual cm_first + cm_about;
  54.  
  55.     end; {r2d2Window object definition}
  56.  
  57. const
  58.    timer_id = 1;
  59.  
  60. constructor r2d2Window.init;
  61. begin
  62.      TWindow.init(AParent, ATitle);
  63.      with attr do begin
  64.           x := 20;
  65.           y := 30;
  66.           w := 150;
  67.           h := 150;
  68.      end;
  69.      attr.menu := loadMenu(HInstance, id_menu);
  70. end; { r2d2Window.init }
  71.  
  72. (*******************************************************************)
  73. (* Application initMainWindow Procedure                            *)
  74. (*******************************************************************)
  75. procedure r2d2Application.initMainWindow;
  76. begin
  77.     mainWindow := new(Pr2d2Window, init(nil, '3dLib/W - DEMO3dW'));
  78.    randomize;
  79. end; {r2d2Application.initMainWindow}
  80.  
  81. procedure r2d2Window.error;
  82. begin
  83.     messageBox(hWindow, 'Error occured during object load', 'Alert', mb_iconExclamation or mb_ok);
  84.     closeWindow;
  85. end; { Window error procedure }
  86.  
  87. (*******************************************************************)
  88. (* Global Variables and Constants                                  *)
  89. (*******************************************************************)
  90. var
  91.     i,
  92.     element    : integer;
  93.     ee    : word;
  94.     obj    : array [ 1 .. 9 ] of baseObjectPtr;
  95.     ch    : char;
  96.     V0
  97.     ,V1
  98.     ,V2
  99.     ,V3
  100.     ,V4
  101.     ,V5
  102.     ,V6
  103.     ,V7
  104.     ,V8
  105.     ,V9    : real;
  106.     I0
  107.     ,I1
  108.     ,I2
  109.     ,I3
  110.     ,I4
  111.     ,I5
  112.     ,I6
  113.     ,I7
  114.     ,I8
  115.     ,I9    : integer;
  116.     mover, mover2 : byte;
  117. const
  118.     zeroPoint    : point3d = (x:0.0; y:0.0; z:0.0);
  119.    backwards   : boolean = false;
  120.  
  121.  
  122. (*******************************************************************)
  123. (* power                                                           *)
  124. (*******************************************************************)
  125. function power(a, b : real) : real;
  126. begin
  127.     power := exp(b * ln(a));
  128. end; {power}
  129.  
  130. (*******************************************************************)
  131. (* Window Paint Procedure                                          *)
  132. (*******************************************************************)
  133. procedure r2d2Window.Paint;
  134. var
  135.     myPen, oldPen : HPen;
  136.     color1, color2, color3, color4 : TColorRef;
  137. begin
  138.    color1 := rgb(random(255), random(255), random(255));
  139.    color2 := rgb(random(255), random(255), random(255));
  140.    color3 := rgb(random(255), random(255), random(255));
  141.    color4 := rgb(random(255), random(255), random(255));
  142.    if (backwards) then begin
  143.       mover := random(20) + 1;
  144.       mover2 := random(20) + 1;
  145.    end;
  146.    if (isZoomed(hWindow)) then begin
  147.     maxX := getSystemMetrics(sm_cxFullScreen);
  148.     maxY := getSystemMetrics(sm_cyFullScreen);
  149.    end else begin
  150.     maxX := attr.w;
  151.     maxY := attr.h;
  152.    end; { not zoomed }
  153.     myPen := getStockObject(white_pen);
  154.     oldPen := selectObject(paintDC, myPen);
  155.    if (not backwards) then begin
  156.        for i0 := 1 to trunc( 60) do begin
  157.           selectObject(paintDC, oldPen);
  158.            deleteObject(myPen);
  159.            myPen := createPen(ps_solid, 1, color1);
  160.            selectObject(paintDC, myPen);
  161.            obj[1]^.paint(paintDC);
  162.            obj[1]^.rotate(z, trunc( 6));
  163.            obj[1]^.move(x,  mover);
  164.           selectObject(paintDC, oldPen);
  165.            deleteObject(myPen);
  166.            myPen := createPen(ps_solid, 1, color2);
  167.            selectObject(paintDC, myPen);
  168.            obj[2]^.paint(paintDC);
  169.            obj[2]^.rotate(z, trunc( -6));
  170.            obj[2]^.move(x,  -mover);
  171.           selectObject(paintDC, oldPen);
  172.            deleteObject(myPen);
  173.            myPen := createPen(ps_solid, 1, color3);
  174.            selectObject(paintDC, myPen);
  175.            obj[3]^.paint(paintDC);
  176.            obj[3]^.rotate(z, trunc( 6));
  177.            obj[3]^.move(y,  mover2);
  178.           selectObject(paintDC, oldPen);
  179.            deleteObject(myPen);
  180.            myPen := createPen(ps_solid, 1, color4);
  181.            selectObject(paintDC, myPen);
  182.            obj[4]^.paint(paintDC);
  183.            obj[4]^.rotate(z, trunc( -6));
  184.            obj[4]^.move(y,  -mover2);
  185.        end; { loop } 
  186.    end else begin
  187.        for i0 := 1 to trunc( 60) do begin
  188.           selectObject(paintDC, oldPen);
  189.            deleteObject(myPen);
  190.            myPen := createPen(ps_solid, 1, color4);
  191.            selectObject(paintDC, myPen);
  192.            obj[1]^.paint(paintDC);
  193.            obj[1]^.rotate(z, trunc( -6));
  194.            obj[1]^.move(x,  -mover);
  195.           selectObject(paintDC, oldPen);
  196.            deleteObject(myPen);
  197.            myPen := createPen(ps_solid, 1, color3);
  198.            selectObject(paintDC, myPen);
  199.            obj[2]^.paint(paintDC);
  200.            obj[2]^.rotate(z, trunc( 6));
  201.            obj[2]^.move(x,  mover);
  202.           selectObject(paintDC, oldPen);
  203.            deleteObject(myPen);
  204.            myPen := createPen(ps_solid, 1, color2);
  205.            selectObject(paintDC, myPen);
  206.            obj[3]^.paint(paintDC);
  207.            obj[3]^.rotate(z, trunc( -6));
  208.            obj[3]^.move(y,  -mover2);
  209.           selectObject(paintDC, oldPen);
  210.            deleteObject(myPen);
  211.            myPen := createPen(ps_solid, 1, color1);
  212.            selectObject(paintDC, myPen);
  213.            obj[4]^.paint(paintDC);
  214.            obj[4]^.rotate(z, trunc( 6));
  215.            obj[4]^.move(y,  mover2);
  216.        end; { loop }
  217.    end;
  218.    backwards := not backwards;
  219.     selectObject(paintDC, oldPen);
  220.     deleteObject(myPen);
  221. end; { Window Paint Procedure }
  222.  
  223. (******************************************************************************
  224. *                           r2d2Window.setupWindow                            *
  225. ******************************************************************************)
  226. procedure r2d2Window.setupWindow;
  227. begin
  228.    TWindow.setupWindow;
  229.    setTimer(hWindow, timer_id, 10000, nil);
  230.     obj[1] := new(obj3dPtr, open('box.3D2', zeroPoint, maxColor));
  231.     ee := obj[1]^.load;
  232.     if (ee <> 0) then
  233.         error(1, ee);
  234.     obj[1]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
  235.     obj[2] := new(obj3dPtr, open('box.3D2', zeroPoint, maxColor));
  236.     ee := obj[2]^.load;
  237.     if (ee <> 0) then
  238.         error(1, ee);
  239.     obj[2]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
  240.     obj[3] := new(obj3dPtr, open('pyr.3D2', zeroPoint, maxColor));
  241.     ee := obj[3]^.load;
  242.     if (ee <> 0) then
  243.         error(1, ee);
  244.     obj[3]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
  245.     obj[4] := new(obj3dPtr, open('pyr.3D2', zeroPoint, maxColor));
  246.     ee := obj[4]^.load;
  247.     if (ee <> 0) then
  248.         error(1, ee);
  249.     obj[4]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
  250. end; {r2d2Window.setupWindow}
  251.  
  252. (******************************************************************************
  253. *                            r2d2Window.WMDestroy                             *
  254. ******************************************************************************)
  255. procedure r2d2Window.WMDestroy;
  256. begin
  257.    killTimer(hWindow, timer_id);
  258.    TWindow.WMDestroy(Msg);
  259. end; {r2d2Window.WMDestroy}
  260.  
  261. (******************************************************************************
  262. *                             r2d2Window.WMTimer                              *
  263. ******************************************************************************)
  264. procedure r2d2Window.WMTimer;
  265. begin
  266.    invalidateRect(hWindow, nil, true);
  267. end; {r2d2Window.WMTimer}
  268.  
  269. (******************************************************************************
  270. *                          r2d2Window.getWindowClass                          *
  271. ******************************************************************************)
  272. procedure r2d2Window.getWindowClass;
  273. begin
  274.      TWindow.getWindowClass(AWndClass);
  275.      AWndClass.HIcon := loadIcon(HInstance, id_icon);
  276.      aWndClass.HCursor := loadCursor(HInstance, id_cursor);
  277. end; {r2d2Window.getWindowClass}
  278.  
  279. (******************************************************************************
  280. *                              r2d2Window.cmQuit                              *
  281. ******************************************************************************)
  282. procedure r2d2Window.cmQuit;
  283. begin
  284.     closeWindow;
  285. end; {r2d2Window.cmQuit}
  286.  
  287. (******************************************************************************
  288. *                             r2d2Window.cmReDraw                             *
  289. ******************************************************************************)
  290. procedure r2d2Window.cmReDraw;
  291. begin
  292.     invalidateRect(HWindow, nil, true);
  293. end;
  294.  
  295. (******************************************************************************
  296. *                             r2d2Window.cmAbout                              *
  297. ******************************************************************************)
  298. procedure r2d2Window.cmAbout;
  299. var
  300.     dialog : TDialog;
  301. begin
  302.     dialog.init(@self, '3DABO');
  303.     dialog.execute;
  304.     dialog.done;
  305. end; {r2d2Window.cmAbout}
  306.  
  307. var
  308.     r2d2App : r2d2Application;
  309. begin
  310.     r2d2App.init('r2d2App');
  311.     r2d2App.run;
  312.     r2d2App.done;
  313. end.
  314.