XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
3D mit Profan²
+---------------------------------------------------------------------+
| d3d.prf - Direct3D mit Profan²                                      |
| Autor: Sebastian König                                              |
| email: feedback@sekoenig.de                                         |
| Homepage: http://www.sekoenig.de                                    |
| Copyright ©2001 Sebastian König                                     |
|                                                                     |
| Dieser Quellcode zeigt, wie Direct3D (Retained Mode) mit Profan²    |
| genutzt werden kann.                                                |
|                                                                     |
| * Vorbild für diesen Code war ein Direct3D-Tutorial von Stefan      |
|   Zerbst (http://www-public.tu-bs.de:8080/~y0005571/direct3d/1.htm) |
| * Das 3D-Modell, das diesem Quellcode beiliegt, stammt aus dem      |
|   Freeware-Archiv von 3dcafe.com                                    |
|                                                                     |
| WICHTIG: Dieser Quellcode funktioniert erst ab Profan 7.0 und setzt |
|          voraus, dass DirectX installiert ist.                      |
|                                                                     |
| HINWEIS: Für eventuelle Schäden an Hard- und/oder Software, die     |
|          beim Ausführen dieses Quellcodes entstehen könnten, über-  |
|          nimmt der Autor keinerlei Haftung.                         |
|          Beim Testen sind allerdings keine Schäden entstanden.      |
+---------------------------------------------------------------------+
---Benötigte (COM/OLE)-API-Funktionen:
DEF CoTaskMemAlloc(1) !OLE32,CoTaskMemAlloc
DEF CoTaskMemFree(1) !OLE32,CoTaskMemFree
DEF Direct3DRMCreate(1) !D3DRM,Direct3DRMCreate
DEF DirectDrawCreateClipper(3) !DDRAW,DirectDrawCreateClipper
DEF GetClientRect(2) !USER32,GetClientRect
DEF MoveMemory(3) !KERNEL32,RtlMoveMemory
---Globale Variablen deklarieren:
declare D3DRM&,DDClipper&
declare dev&,scene&,camera&,view&
declare vp_d3d&,vp_clip&,vp_dev&,vp_view&,vp_cam&,vp_scene&
declare winRECT#,file#
declare width&,height&
declare d3dll&
declare hr&
----Prozeduren:
++++++++++++++++
+ BuildScene
+
+ In dieser Prozedur wird die 3D-Szene aufgebaut.
+
+ Parameter: keine

proc BuildScene

    Lokale Variablen deklarieren:
    declare childframe&,lights&,meshbuilder&,light1&,light2&,mat&,mesh&
    declare vp_cframe&,vp_lights&,vp_mbuilder&,vp_l1&,vp_l2&,vp_mat&,vp_mesh&
    declare x&,y&,z&,theta&
    declare r&,g&,b&,mtype&
    Speicher allokieren:
    let childframe& = CoTaskMemAlloc(4)
    let lights& = CoTaskMemAlloc(4)
    let meshbuilder& = CoTaskMemAlloc(4)
    let light1& = CoTaskMemAlloc(4)
    let light2& = CoTaskMemAlloc(4)
    let mat& = CoTaskMemAlloc(4)
    let mesh& = CoTaskMemAlloc(4)
    dim file#,256
    print
    print |------BuildScene------|
    ---Meshbuilder erstellen:
    print CreateMeshBuilder:,
    Call(@long(vp_d3d&,24),D3DRM&,Addr(meshbuilder&)) CreateMeshBuilder
    let vp_mbuilder& = @long(meshbuilder&,0)
    ---3D-Objekt laden:
    string file#,0 = test.x
    print Meshbuilder->Load:,
    Call(@long(vp_mbuilder&,44),meshbuilder&,file#,0,0,0,0) Load
    ---Frame für Objekt erstellen:
    print CreateFrame [childframe]:,
    Call(@long(vp_d3d&,16),D3DRM&,scene&,Addr(childframe&)) CreateFrame
    let vp_cframe& = @long(childframe&,0)
    x& = Single(-0.1)
    y& = Single(-0.1)
    z& = Single(-3.0)
    ---Kamera positionieren:
    print Camera->SetPosition:,
    Call(@long(vp_cam&,244),camera&,scene&,x&,y&,z&) SetPosition
    x& = Single(0.1)
    y& = Single(0.7)
    z& = Single(1.0)
    theta& = Single(0.03)  Rotationswinkel: ca. 1.7° (Wert im Bogenmaß!)
    ---Dem 3D-Objekt eine Rotation zuweisen:
    print Childframe->SetRotation:,
    Call(@long(vp_cframe&,248),childframe&,scene&,x&,y&,z&,theta&) SetRotation
    ---Frame für Lichtquellen erzeugen:
    print CreateFrame [lights]:,
    Call(@long(vp_d3d&,16),D3DRM&,scene&,Addr(lights&)) CreateFrame
    let vp_lights& = @long(lights&,0)
    ---Lichtquellen-Frame positionieren:
    x& = Single(-3.0)
    y& = Single(0.0)
    z& = Single(0.0)
    print Lights->SetPosition:,
    Call(@long(vp_lights&,244),lights&,scene&,x&,y&,z&) SetPosition
    r& = Single(0.9)
    g& = Single(0.8)
    b& = Single(0.7)
    ---2 Lichtquellen erstellen und in den Lichtquellenframe selektieren:
    1.: Punktförmige Lichtquelle:
    print CreateLightRGB [1]:,
    Call(@long(vp_d3d&,48),D3DRM&,1,r&,g&,b&,Addr(light1&)) CreateLightRGB
    let vp_l1& = @long(light1&,0)
    print Lights->AddLight [1]:,
    Call(@long(vp_lights&,48),lights&,light1&) AddLight
    r& = Single(0.0)
    g& = Single(0.5)
    b& = Single(0.0)
    2.: Umgebungslicht
    print CreateLightRGB [2]:,
    Call(@long(vp_d3d&,48),D3DRM&,0,r&,g&,b&,Addr(light2&)) CreateLightRGB
    let vp_l2& = @long(light2&,0)
    print Lights->AddLight [2]:,
    Call(@long(vp_lights&,48),lights&,light2&) AddLight
    ---Material für 3D-Objekt erstellen:
    mtype& = Single(10.0)
    print CreateMaterial:,
    Call(@long(vp_d3d&,52),D3DRM&,mtype&,Addr(mat&)) CreateMaterial
    let vp_mat& = @long(mat&,0)
    ---Material dem Objekt zuweisen:
    print Meshbuilder->SetMaterial:,
    Call(@long(vp_mbuilder&,112),meshbuilder&,mat&) SetMaterial
    ---Objektfarbe setzen:
    r& = Single(1.0)
    g& = Single(0.0)
    b& = Single(0.0)
    print Meshbuilder->SetColorRGB:,
    Call(@long(vp_mbuilder&,100),meshbuilder&,r&,g&,b&) SetColorRGB
    ---Mesh-Objekt erzeugen:
    print CreateMesh:,
    Call(@long(vp_mbuilder&,192),meshbuilder&,Addr(mesh&)) CreateMesh
    let vp_mesh& = @long(mesh&,0)
    print vp_mesh&
    ---Mesh-Objekt in Frame selektieren:
    print Childframe->AddVisual [2]:,
    Call(@long(vp_cframe&,72),childframe&,mesh&) AddVisual
    ---COM-Objekte freigeben:
    Call(@long(vp_cframe&,8),childframe&)
    Call(@long(vp_lights&,8),lights&)
    Call(@long(vp_mbuilder&,8),meshbuilder&)
    Call(@long(vp_l1&,8),light1&)
    Call(@long(vp_l2&,8),light2&)
    Call(@long(vp_mat&,8),mat&)
    Call(@long(vp_mesh&,8),mesh&)
    ---Speicher freigeben:
    CoTaskMemFree(childframe&)
    CoTaskMemFree(lights&)
    CoTaskMemFree(meshbuilder&)
    CoTaskMemFree(light1&)
    CoTaskMemFree(light2&)
    CoTaskMemFree(mat&)
    CoTaskMemFree(mesh&)
    dispose file#

endproc

++++++++++++++++
+ RenderScene
+
+ Mit Hilfe dieser Prozedur wird die 3D-Szene aktualisiert und gerendert.
+
+ Parameter: keine

proc RenderScene

    ---Bewegungen ausführen:
    Call(@long(vp_scene&,148),scene&,$3F800000) Move / $3F800000 = 1.0
    ---Hintergrund löschen:
    Call(@long(vp_view&,48),view&) Clear
    ---Szene rendern:
    Call(@long(vp_view&,52),view&,scene&) Render
    ---Bild ausgeben:
    Call(@long(vp_dev&,56),dev&) Update

endproc

----Hauptprogramm:
Fenster erstellen:
window 0,0-640,480
windowtitle Direct3D mit Profan²
SetTrueColor 1
Für den Direct3D Retained Mode muss diese DLL explizit geladen werden:
(Sie ist Bestandteil von DirectX)
let d3dll& = UseDll(D3DRM.DLL)
Speicher allokieren:
let D3DRM& = CoTaskMemAlloc(4)
let DDClipper& = CoTaskMemAlloc(4)
let dev& = CoTaskMemAlloc(4)
let scene& = CoTaskMemAlloc(4)
let camera& = CoTaskMemAlloc(4)
let view& = CoTaskMemAlloc(4)
---Direct3D (Retained Mode) Objekt erstellen:
let hr& = Direct3DRMCreate(Addr(D3DRM&))
print Direct3DRMCreate:,hr&

if @neq(hr&,0)

    MessageBox(Direct3D-Objekt konnte nicht erstellt werden.,Fehler,16)
    end

endif

let vp_d3d& = @long(D3DRM&,0)
---DirectDraw-Clipper für die Ausgabe erstellen und mit dem Fenster verknüpfen:
let hr& = DirectDrawCreateClipper(0,Addr(DDClipper&),0)
print DirectDrawCreateClipper:,hr&

if @neq(hr&,0)

    MessageBox(DirectDraw-Clipper konnte nicht erstellt werden.,Fehler,16)
    end

endif

let vp_clip& = @long(DDClipper&,0)
print Clipper->SetHwnd:,
Call(@long(vp_clip&,32),DDClipper&,0,%hwnd) SetHwnd
---Direct3D-Device für den Clipper erstellen:
dim winRECT#,16
GetClientRect(%hwnd,winRECT#)
print CreateDeviceFromClipper:,
Call(@long(vp_d3d&,68),D3DRM&,DDClipper&,0,@long(winRECT#,8),
@long(winRECT#,12),Addr(dev&)) CreateDeviceFromClipper
let vp_dev& = @long(dev&,0)
dispose winRECT#
---Root-Frame erzeugen: (Alle weiteren Frames sind diesem Frame untergeordnet.)
print CreateFrame [scene]:,
Call(@long(vp_d3d&,16),D3DRM&,0,Addr(scene&)) CreateFrame
let vp_scene& = @long(scene&,0)
---Kamera erstellen:
print CreateFrame [camera]:,
Call(@long(vp_d3d&,16),D3DRM&,scene&,Addr(camera&)) CreateFrame
let vp_cam& = @long(camera&,0)
---Viewport erstellen:
let width& = Call(@long(vp_dev&,108),dev&) GetWidth
let height& = Call(@long(vp_dev&,104),dev&) GetHeigth
print CreateViewport:,
Call(@long(vp_d3d&,80),D3DRM&,dev&,camera&,0,0,width&,height&,Addr(view&)) CreateViewport
let vp_view& = @long(view&,0)
---Szene aufbauen:
BuildScene
---Szene 1x darstellen und Text ausgeben:
RenderScene
TextColor RGB(0,255,0),-1
DrawText 4,4,Mit Mausklick beenden!
---Hauptprogrammschleife:

whilenot @equ(%mousekey,1)

    Szene rendern und darstellen:
    RenderScene

wend

---Aufräumarbeiten:
COM-Objekte freigeben:
Call(@long(vp_view&,8),view&)       Release Viewport
Call(@long(vp_cam&,8),camera&)      Release Kamera
Call(@long(vp_scene&,8),scene&)     Release Szene
Call(@long(vp_dev&,8),dev&)         Release Device
Call(@long(vp_clip&,8),DDClipper&)  Release Clipper
Call(@long(vp_d3d&,8),D3DRM&)       Release Direct3D
Speicher freigeben:
CoTaskMemFree(view&)
CoTaskMemFree(camera&)
CoTaskMemFree(scene&)
CoTaskMemFree(dev&)
CoTaskMemFree(DDClipper&)
CoTaskMemFree(D3DRM&)
Direct3D (Retained Mode) DLL freigeben:
./../funzione-riferimenti/XProfan/freedll/'>FreeDll d3dll&
---Ende:
end