Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi openGL zeichnen-problem (https://www.delphipraxis.net/7194-opengl-zeichnen-problem.html)

Illuminator-23-5 5. Aug 2003 09:22


openGL zeichnen-problem
 
ich hab mir das tutorial für opengl von mr_t vorgenommen, und es is wirklich gut.
jetzt hab ich aber ein kleines problem: ich hab genau das geschrieben, was im tut steht, aber beim 4eck zeichnen seh ich immer noch nur schwarz!
ich hab hier mal den code gepostet:
Delphi-Quellcode:
unit test1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OpenGL, ExtCtrls;

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

procedure Render;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

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
// zwischengespeiichert
begin
  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do begin //wir woollen 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 (Anzahl der Farben)
    cDepthBits:= 32; // 32-bit depth buffer
    iLayerType:= PFD_MAIN_PLANE; // Layer Type
  end;
  nPixelFormat:= ChoosePixelFormat(myDC, @pfd); //Das Pixel-Format
  SetPixelFormat(myDC, nPixelFormat, @pfd); // wird übertragen

  // Farbpalettenoptimierung wenn erforderlich

  DescribePixelFormat(myDC, nPixelFormat, //alles ab hier ist zwecks einstellungen nicht
  //mehr wichtig, sondern schlicht und einfach nur noch notwendig... ;-)
  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);
  glLoadIdentity;

  Glbegin(gl_quads);        //wir wollen ein Viereck zeichnen
  glVertex3f( 1 , 1,-6);
  glVertex3f(-1 , 1,-6);
  glVertex3f(-1 ,-1,-6);
  glVertex3f( 1 ,-1,-6);
  glend;

  SwapBuffers(form1.myDC);
end;

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglmakecurrent(0,0);
  wgldeletecontext(mydc);
  releasedc(handle,mydc);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  glViewport(0, 0, Width, Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, Width/Height, 1.0, 100.0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;

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

end.
wenn ich das programm ausführe, sehe ich schwarz! Wieso??????

Mr_T 5. Aug 2003 09:32

Re: openGL zeichnen-problem
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hmm, also ich kann Open Gl-Technisch keinen direkten Fehler finden.... (evtl. auch weil es mein eigener Code ist)
Aber eine Möglichkeit gibt es schon:
Auf welchem Intervall steht dein Timer? Steht der noch auf "1000", dann stelle den mal auf "1" bzw. sollte das Intervall bereits "1" betragen, versuche es mla mit "50"....
Eine andere Möglichkeit:
Evtl. Hilft es auch vor dem Quad einmal "glcolor3f(1,1,1)" aufzurufen... könnte sein, dass deine Open Gl-Implemetation als Standartfarbe "schwarz" hat ....
Hillft alles nichts, dann lade hier mla den Source hoch, damit ich ihn mir selber unter die Lupe nemen kann.....

Ps: wieso schreibste Open den Render-Procedure-Header nochmal hin? Das ist soweit ich weiß nicht nötig (ich tue es auch nicht)... man bracuht das an sich nur, wenn man ne Unit schreibt, in welcher einige Dinge exthern verfügbar sein sollen...

Pps: habe einfach mal hie das Programm geupt, welches du versuchst nachzubauen ...

Illuminator-23-5 5. Aug 2003 10:06

Re: openGL zeichnen-problem
 
es funzt nun, die farbe war das problem!
thx4help


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:46 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz