home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
3DLIB20
/
DEMO3DW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-06-03
|
10KB
|
314 lines
(******************************************************************************
* demo3dW *
******************************************************************************)
program demo3dW;
{$R 3dLIB.RES}
uses
{$ifdef ver15}
wObjects
{$else}
oWindows
,oDialogs
{$endif}
,winProcs
,winTypes
,rtObj
,project3
,hdr3d
,ctm3d
;
const
id_icon = '3DICO';
id_cursor = '3DCUR';
id_menu = '3DMEN';
cm_about = 101;
cm_reDraw = 102;
cm_quit = 103;
type
Pr2d2Application = ^ r2d2Application;
r2d2Application = object(TApplication)
procedure initMainWindow; virtual;
end; {r2d2Application object definition}
Pr2d2Window = ^ r2d2Window;
r2d2Window = object(TWindow)
constructor init(AParent : PWindowsObject; ATitle : PChar);
procedure paint(paintDC : HDC; var paintInfo : TPaintStruct); virtual;
procedure setupWindow; virtual;
procedure WMDestroy(var msg : TMessage); virtual wm_first + wm_destroy;
procedure wmTimer(var msg : TMessage); virtual wm_first + wm_timer;
procedure error(i : byte; j : word);
procedure getWindowClass(var AWndClass : TWndClass); virtual;
procedure cmQuit(var Msg : TMessage); virtual cm_first + cm_quit;
procedure cmReDraw(var Msg : TMessage); virtual cm_first + cm_reDraw;
procedure cmAbout(var Msg : TMessage); virtual cm_first + cm_about;
end; {r2d2Window object definition}
const
timer_id = 1;
constructor r2d2Window.init;
begin
TWindow.init(AParent, ATitle);
with attr do begin
x := 20;
y := 30;
w := 150;
h := 150;
end;
attr.menu := loadMenu(HInstance, id_menu);
end; { r2d2Window.init }
(*******************************************************************)
(* Application initMainWindow Procedure *)
(*******************************************************************)
procedure r2d2Application.initMainWindow;
begin
mainWindow := new(Pr2d2Window, init(nil, '3dLib/W - DEMO3dW'));
randomize;
end; {r2d2Application.initMainWindow}
procedure r2d2Window.error;
begin
messageBox(hWindow, 'Error occured during object load', 'Alert', mb_iconExclamation or mb_ok);
closeWindow;
end; { Window error procedure }
(*******************************************************************)
(* Global Variables and Constants *)
(*******************************************************************)
var
i,
element : integer;
ee : word;
obj : array [ 1 .. 9 ] of baseObjectPtr;
ch : char;
V0
,V1
,V2
,V3
,V4
,V5
,V6
,V7
,V8
,V9 : real;
I0
,I1
,I2
,I3
,I4
,I5
,I6
,I7
,I8
,I9 : integer;
mover, mover2 : byte;
const
zeroPoint : point3d = (x:0.0; y:0.0; z:0.0);
backwards : boolean = false;
(*******************************************************************)
(* power *)
(*******************************************************************)
function power(a, b : real) : real;
begin
power := exp(b * ln(a));
end; {power}
(*******************************************************************)
(* Window Paint Procedure *)
(*******************************************************************)
procedure r2d2Window.Paint;
var
myPen, oldPen : HPen;
color1, color2, color3, color4 : TColorRef;
begin
color1 := rgb(random(255), random(255), random(255));
color2 := rgb(random(255), random(255), random(255));
color3 := rgb(random(255), random(255), random(255));
color4 := rgb(random(255), random(255), random(255));
if (backwards) then begin
mover := random(20) + 1;
mover2 := random(20) + 1;
end;
if (isZoomed(hWindow)) then begin
maxX := getSystemMetrics(sm_cxFullScreen);
maxY := getSystemMetrics(sm_cyFullScreen);
end else begin
maxX := attr.w;
maxY := attr.h;
end; { not zoomed }
myPen := getStockObject(white_pen);
oldPen := selectObject(paintDC, myPen);
if (not backwards) then begin
for i0 := 1 to trunc( 60) do begin
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color1);
selectObject(paintDC, myPen);
obj[1]^.paint(paintDC);
obj[1]^.rotate(z, trunc( 6));
obj[1]^.move(x, mover);
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color2);
selectObject(paintDC, myPen);
obj[2]^.paint(paintDC);
obj[2]^.rotate(z, trunc( -6));
obj[2]^.move(x, -mover);
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color3);
selectObject(paintDC, myPen);
obj[3]^.paint(paintDC);
obj[3]^.rotate(z, trunc( 6));
obj[3]^.move(y, mover2);
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color4);
selectObject(paintDC, myPen);
obj[4]^.paint(paintDC);
obj[4]^.rotate(z, trunc( -6));
obj[4]^.move(y, -mover2);
end; { loop }
end else begin
for i0 := 1 to trunc( 60) do begin
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color4);
selectObject(paintDC, myPen);
obj[1]^.paint(paintDC);
obj[1]^.rotate(z, trunc( -6));
obj[1]^.move(x, -mover);
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color3);
selectObject(paintDC, myPen);
obj[2]^.paint(paintDC);
obj[2]^.rotate(z, trunc( 6));
obj[2]^.move(x, mover);
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color2);
selectObject(paintDC, myPen);
obj[3]^.paint(paintDC);
obj[3]^.rotate(z, trunc( -6));
obj[3]^.move(y, -mover2);
selectObject(paintDC, oldPen);
deleteObject(myPen);
myPen := createPen(ps_solid, 1, color1);
selectObject(paintDC, myPen);
obj[4]^.paint(paintDC);
obj[4]^.rotate(z, trunc( 6));
obj[4]^.move(y, mover2);
end; { loop }
end;
backwards := not backwards;
selectObject(paintDC, oldPen);
deleteObject(myPen);
end; { Window Paint Procedure }
(******************************************************************************
* r2d2Window.setupWindow *
******************************************************************************)
procedure r2d2Window.setupWindow;
begin
TWindow.setupWindow;
setTimer(hWindow, timer_id, 10000, nil);
obj[1] := new(obj3dPtr, open('box.3D2', zeroPoint, maxColor));
ee := obj[1]^.load;
if (ee <> 0) then
error(1, ee);
obj[1]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
obj[2] := new(obj3dPtr, open('box.3D2', zeroPoint, maxColor));
ee := obj[2]^.load;
if (ee <> 0) then
error(1, ee);
obj[2]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
obj[3] := new(obj3dPtr, open('pyr.3D2', zeroPoint, maxColor));
ee := obj[3]^.load;
if (ee <> 0) then
error(1, ee);
obj[3]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
obj[4] := new(obj3dPtr, open('pyr.3D2', zeroPoint, maxColor));
ee := obj[4]^.load;
if (ee <> 0) then
error(1, ee);
obj[4]^.goto3DPos(trunc( 0), trunc( 0), trunc( 0));
end; {r2d2Window.setupWindow}
(******************************************************************************
* r2d2Window.WMDestroy *
******************************************************************************)
procedure r2d2Window.WMDestroy;
begin
killTimer(hWindow, timer_id);
TWindow.WMDestroy(Msg);
end; {r2d2Window.WMDestroy}
(******************************************************************************
* r2d2Window.WMTimer *
******************************************************************************)
procedure r2d2Window.WMTimer;
begin
invalidateRect(hWindow, nil, true);
end; {r2d2Window.WMTimer}
(******************************************************************************
* r2d2Window.getWindowClass *
******************************************************************************)
procedure r2d2Window.getWindowClass;
begin
TWindow.getWindowClass(AWndClass);
AWndClass.HIcon := loadIcon(HInstance, id_icon);
aWndClass.HCursor := loadCursor(HInstance, id_cursor);
end; {r2d2Window.getWindowClass}
(******************************************************************************
* r2d2Window.cmQuit *
******************************************************************************)
procedure r2d2Window.cmQuit;
begin
closeWindow;
end; {r2d2Window.cmQuit}
(******************************************************************************
* r2d2Window.cmReDraw *
******************************************************************************)
procedure r2d2Window.cmReDraw;
begin
invalidateRect(HWindow, nil, true);
end;
(******************************************************************************
* r2d2Window.cmAbout *
******************************************************************************)
procedure r2d2Window.cmAbout;
var
dialog : TDialog;
begin
dialog.init(@self, '3DABO');
dialog.execute;
dialog.done;
end; {r2d2Window.cmAbout}
var
r2d2App : r2d2Application;
begin
r2d2App.init('r2d2App');
r2d2App.run;
r2d2App.done;
end.