Thema: Delphi 3D Objekte steuern

Einzelnen Beitrag anzeigen

Wolverine

Registriert seit: 30. Mai 2003
Ort: Düsseldorf (NRW)
109 Beiträge
 
Delphi 7 Enterprise
 
#4

Re: 3D Objekte steuern

  Alt 14. Dez 2003, 21:15
Hi,
nein ATwardz, das ist leider nicht das was ich suche.
Ich poste mal den Quellcode, damit du weisst wie ich es eingebunden habe:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, opengl,
  ExtCtrls, gl3ds;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
   myDC : HDC;
   myRC : HGLRC;
   myPalette : HPALETTE;
   procedure SetupPixelFormat;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  model: TAll3dsMesh;

implementation

{$R *.DFM}
procedure TForm1.SetupPixelFormat;
var hHeap: THandle;
  nColors, i: Integer; //Anzahl der Farben
  lpPalette : PLogPalette; //Die Farbpalette
  byRedMask, byGreenMask, byBlueMask: Byte; //Blau, Grün und Rot
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor; //Dies ist der "Descriptor"..in ihm werden die Infos
                                            //zwischengespeichert
begin
  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do begin //wir wollen das Format bearbeiten
    nSize := sizeof(pfd); // Länge der pfd-Struktur
    nVersion := 1; // Version
    dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or
                 PFD_DOUBLEBUFFER; // Flags
    iPixelType:= PFD_TYPE_RGBA; // RGBA Pixel Type
    cColorBits:= 24; // 24-bit color
    cDepthBits:= 32; // 32-bit depth buffer
    iLayerType:= PFD_MAIN_PLANE; // Layer Type
  end;
  nPixelFormat:= ChoosePixelFormat(myDC, @pfd);
  SetPixelFormat(myDC, nPixelFormat, @pfd);
                                            // Farbpalettenoptimierung wenn erforderlich
  DescribePixelFormat(myDC, nPixelFormat,
                      sizeof(TPixelFormatDescriptor),pfd);
  if ((pfd.dwFlags and PFD_NEED_PALETTE) <> 0) then begin
    nColors := 1 shl pfd.cColorBits;
    hHeap := GetProcessHeap;
    lpPalette:= HeapAlloc
       (hHeap,0,sizeof(TLogPalette)+(nColors*sizeof(TPaletteEntry)));
    lpPalette^.palVersion := $300;
    lpPalette^.palNumEntries := nColors;
    byRedMask := (1 shl pfd.cRedBits) - 1;
    byGreenMask:= (1 shl pfd.cGreenBits) - 1;
    byBlueMask := (1 shl pfd.cBlueBits) - 1;
    for i := 0 to nColors - 1 do begin
      lpPalette^.palPalEntry[i].peRed :=
        (((i shr pfd.cRedShift) and byRedMask) *255)DIV byRedMask;
      lpPalette^.palPalEntry[i].peGreen:=
        (((i shr pfd.cGreenShift)and byGreenMask)*255)DIV byGreenMask;
      lpPalette^.palPalEntry[i].peBlue :=
        (((i shr pfd.cBlueShift) and byBlueMask) *255)DIV byBlueMask;
      lpPalette^.palPalEntry[i].peFlags:= 0;
    end;
    myPalette:= CreatePalette(lpPalette^);
    HeapFree(hHeap, 0, lpPalette);
    if (myPalette <> 0) then begin
      SelectPalette(myDC, myPalette, False);
      RealizePalette(myDC);
    end;
  end;
end;

procedure render;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); //Farb und Tiefenpuffer löschen
glLoadIdentity; // World Matrix zurücksetzen

gltranslatef(0,0,-12);
glrotatef(45,0.5,1,0);
glscalef(0.1,0.1,0.1);
model.Render;

SwapBuffers(form1.myDC); //scene ausgeben
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
form1.myDC:= GetDC(Handle);
SetupPixelFormat;
myRC:= wglCreateContext(myDC);
wglMakeCurrent(myDC, myRC);
glEnable(GL_DEPTH_TEST);
glLoadIdentity;

model:=TAll3DSMesh.Create(nil);
model.TexturePath:='textur\Tex.bmp';
model.LoadFromFile('teekanne.3ds');

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

model.Free;

wglmakecurrent(0,0);
wgldeletecontext(mydc);
releasedc(handle,mydc);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
glViewport(0, 0, Width, Height); // Setzt den Viewport für das OpenGL Fenster
glMatrixMode(GL_PROJECTION); // Matrix Mode auf Projection setzen
glLoadIdentity(); // Reset View
gluPerspective(45.0, Width/Height, 1, 100.0); // Perspektive den neuen Maßen anpassen.
glMatrixMode(GL_MODELVIEW); // Zurück zur Modelview Matrix
glLoadIdentity();
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
render;
end;

end.
Hoffe das hilft soweit. Nen Screenie hab ich nicht, sorry.
Guido L.
The nice thing about Windows is - It does not just crash, it displays a dialog box and lets you press 'OK' first.
Guten Rutsch und Start ins neue Jahr 2005
  Mit Zitat antworten Zitat