ich habe ein kleines Problem mit der Leadwerks-Engine und hoffe auf eure mithilfe - das Problem ist eigentlich auch schon in Delphi/Pascal gelößt - nur verstehe ich da die hälte der Syntax mal gleich garnicht.
Ziel ist es die Leadwerks-Engine (welche auch ohne Probleme unter PB läuft) in ein Image zu zeichnen um quasi die Engine in ein PB Windows Fenster Anwendung für einen kleinen Viewer etc. einzubinden.
Wenn ich das richtig gesehen habe wird ein "Custom Buffer" für die Leadwerks-Engine mit LE Syntax erstellt und dann dieser Buffer auf ein ImageGadget oder nur Image geschrieben:
Orginaler Code:
Code: Alles auswählen
unit uAppWin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, OpenGL, Leadwerks;
type
TAppWin = class(TForm)
RenderPanel: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
procedure SceneCreate;
procedure SceneUpdate;
procedure SceneRender;
public
{ Public declarations }
function InitializeContexts (RenderCtrl:TWinControl) : boolean;
procedure DestroyContexts;
end;
var
AppWin: TAppWin;
implementation
{$R *.dfm}
var
pixelFormat : integer;
pfDescriptor : TPixelFormatDescriptor;
deviceContext : HDC;
renderingContext : HGLRC;
renderingControl : TWinControl;
BackBufferWnd, gWorldBuf, gLightBuf : THandle;
gLight, gCamera, gMaterial, gPlane, gCube : THandle;
procedure CBufGetSize // callback for CreateCustombuffer
( var Width:Integer; var Height:Integer ); stdcall;
begin
Width := renderingControl.ClientWidth;
Height := renderingControl.ClientHeight;
end;
procedure CBufMakeCurrent; stdcall; // callback for CreateCustombuffer
begin
wglMakeCurrent(deviceContext, renderingContext);
end;
procedure TAppWin.FormCreate(Sender: TObject);
begin
InitializeContexts (RenderPanel); // create render and device contexts
end;
procedure TAppWin.FormDestroy(Sender: TObject);
begin
DestroyContexts; // destroy render and device contexts on form destroy
end;
procedure TAppWin.FormActivate(Sender: TObject);
begin
SceneCreate; // create scene on form activate
end;
procedure TAppWin.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Application.OnIdle := nil; // detach render scene loop
EndRender;
FreeBuffer(gWorldBuf); // free buffers
FreeBuffer(gLightBuf);
FreeBuffer(BackBufferWnd);
end;
function TAppWin.InitializeContexts (RenderCtrl:TWinControl) : boolean;
begin
Result := False;
FillChar(pfDescriptor, SizeOf(pfDescriptor), 0);
with pfDescriptor do begin // Requested Pixel Format
nSize := SizeOf(pfDescriptor);
nVersion := 1;
dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := 32;
iLayerType := PFD_MAIN_PLANE;
end;
renderingControl := RenderCtrl;
deviceContext := GetDC(renderingControl.Handle); // create device context
if (deviceContext=0) then begin
ShowMessage('Can''t create a device context.'); Exit;
end;
pixelFormat := ChoosePixelFormat(deviceContext, @pfDescriptor);
if (pixelFormat=0) then begin
ShowMessage('Can''t find a suitable pixel format.'); Exit;
end;
if not SetPixelFormat(deviceContext, pixelFormat, @pfDescriptor) then begin
ShowMessage('Can''t set the pixel format : '+ IntToStr(pixelFormat));
end;
renderingContext := wglCreateContext(deviceContext); // create rendering context
if (renderingContext=0) then begin
ShowMessage ('Can''t create a rendering context.'); Exit;
end;
wglMakeCurrent(deviceContext, renderingContext);
Result := True;
end;
procedure TAppWin.DestroyContexts;
begin
if (renderingContext <> 0) then begin // delete rendering context
wglMakeCurrent(0, 0); wglDeleteContext(renderingContext);
renderingContext := 0;
end;
if (deviceContext <> 0) then begin // release device context
ReleaseDC(Self.Handle, deviceContext); deviceContext := 0;
end;
end;
procedure TAppWin.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
begin
SceneUpdate; // update timing and physics
SceneRender; // render scene and draw into custom buffer
Done := False;
end;
procedure TAppWin.SceneCreate;
begin
// Initialize
CreateWorld;
LoadFont('Arial');
// DebugLights(1); DebugSceneGraph(1); DebugPhysics(1); DebugEntities(1);
BackBufferWnd := CreateCustomBuffer(@CBufGetSize, @CBufMakeCurrent);
SetBuffer (BackBufferWnd);
// Create a camera
gCamera := CreateCamera;
CameraClearColor (gCamera,Vec4(0));
PositionEntity (gCamera,Vec3(0,0,-6));
// Load a material
gMaterial:=LoadMaterial('scifi.mat');
// Create plane
gPlane := CreateCube;
ScaleEntity (gPlane, Vec3(20,0.5,30) );
MoveEntity (gPlane, Vec3(0,-5,0) );
PaintEntity (gPlane, gMaterial);
// Create cube
gCube := CreateCube;
ScaleEntity (gCube, Vec3(3) );
PaintEntity (gCube, gMaterial);
// Create a spot light
gLight := CreateSpotLight(20);
EntityColor(gLight,Vec4(1,1,1,1));
MoveEntity (gLight, Vec3(-1,2,-4));
RotateEntity (gLight, Vec3(25,0,15));
// Set ambient light
AmbientLight(Vec3(0.2));
// Startup on idle loop
Application.OnIdle := ApplicationEventsIdle;
end;
procedure TAppWin.SceneUpdate;
begin
TurnEntity(gCube, Vec3(0.25,0.5,1)); // Rotating cube
UpdateAppTime; UpdateWorld(AppSpeed); // Update timing and physics
end;
procedure TAppWin.SceneRender;
var s : string;
bWidth, bHeight : integer;
begin
// Custom Back Buffer size - window may be resized in any time
bWidth := BufferWidth(BackBufferWnd);
bHeight := BufferHeight(BackBufferWnd);
// Render World into gWorldBuf
if gWorldBuf<>0 then // Free render buffer if custom back buffer resized
if ( BufferWidth(gWorldBuf)<>bWidth ) or ( BufferHeight(gWorldBuf)<>bHeight )
then begin FreeBuffer (gWorldBuf); gWorldBuf := 0; end;
if ( gWorldBuf=0 ) then // Create render buffer if needed
gWorldBuf := CreateBuffer( bWidth, bHeight, BUFFER_COLOR or BUFFER_DEPTH or BUFFER_NORMAL);
SetBuffer(gWorldBuf); // Make our render buffer the current buffer
RenderWorld; // Render the world to the render buffer
// Render Lights into gLightBuf
if gLightBuf<>0 then // Free render buffer if custom back buffer resized
if ( BufferWidth(gLightBuf)<>bWidth ) or ( BufferHeight(gLightBuf)<>bHeight )
then begin FreeBuffer (gLightBuf); gLightBuf := 0; end;
if ( gLightBuf=0 ) then // Create render buffer if needed
gLightBuf := CreateBuffer( bWidth, bHeight, BUFFER_COLOR or BUFFER_DEPTH);
SetBuffer(gLightBuf); // Make our render buffer the current buffer
RenderLights(gWorldBuf); // Passing render buffer (color, depth, and normal data)
// Draw final image into Custom Back Buffer and Flip
SetBuffer(BackBufferWnd); // Make the custom back buffer the current buffer
DrawImage( GetColorBuffer(gLightBuf,0), 0, bHeight, bWidth, -bHeight );
// Write some infos
s := Format('buffer size: %d x %d , fps: %d',
[ BufferWidth(BackBufferWnd), BufferHeight(BackBufferWnd), Round(UPS) ]);
DrawText (PChar(s),4,4); // Draw some info
SwapBuffers (deviceContext); // Flip (custom buffer)
end;
end.
Wenn hier jemand das include der Leadwerks Engine braucht - das gibts hier:
http://www.redwalled.de/pb/hw_include_engine_3d.pbi
Plz Plz PLz help
