OpenGL Grundgerüst

[freq.9]

Wir haben in der Schule den Abstand zwischen Vektoren berechnet. Darauf meinte ich, dass man das einfacher machen könnte, als wie es unserer Lehrer gemacht hat. Darauf habe ich von meinem Lehrer die Aufgabe bekommen bis zur nächsten Woche meine Aussage durch Beispiele etc. zu belegen. Das sollte für mich nicht das Problem sein, aber ich wollte dies noch durch eine 3D Anwendung visualisieren. Nur benötige ich nun ein OpenGL gestütztes Grundgerüst für eine solche Anwendung. Ich habe zwar schonmal mit OpenGL gearbeitet (vor ca. einem Jahr), jedoch bekomme ich das irgendwie nicht hin, dass ich ganz normale VCL-Komponenten + OpenGL auf ein Formular bekomme. Ich würde das gerne so machen, dass man auf der linken Seite die benötigten Daten für die Vektoren eintragen kann und diese dann auf der rechten Seite mit OpenGL dargestellt werden. Es wäre zwar auch möglich, dass Ganze ohne irgendwie eine Grafik-Schnittstelle zu programmieren, aber würde das nicht so verständlich sein für meine Mitschüler.

Was ich nun will:
Ein einfaches Grundgerüst einer Delphi-Anwendung welche links für Eingaben bereit steht (TBevel, Align=alLeft, Width=200) und auf der rechten Seite (OpenGL-Teil, Align=alClient, Width=TForm.Width-TBevel.Width) ein Bereich mit OpenGL hat, wo ich dann das Koordinatenkreuz sowie die Punkte eintragen kann.

[TheAn00bis]

Nehm doch einfach das Handle eines Panels,
statt das des Fensters beim Initialisieren
des OpenGL.

edit: Bsp:

Delphi-Quellcode:

//RC=OpenGL Rendering Context 
dc := GetDC(Panel.Handle);
wglMakeCurrent(dc, RC)

edit2: "den Handle" in "das Handle" geändert

[sniper_w]

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TglPanel = class(TPanel)
    private
      FOnPaintEvent:TNotifyEvent;
    protected
      procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    published
      property OnPaint:TNotifyEvent read FOnPaintEvent write FOnPaintEvent;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    myRc, myDc : Cardinal;
    GL_Texture:TglBitmap2D;
    Panel: TglPanel;
    procedure InitGl();
    procedure DeInitGl();
    procedure glRender();
  end;

var
  Form1: TForm1;
  e:TWinControl;

implementation

{$R *.dfm}

procedure TForm1.DeInitGl;
begin//
  DeactivateRenderingContext();
  DestroyRenderingContext(myRc);
  ReleaseDC(Panel.Handle,myDc);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin//
  OnResize := nil;
  Panel := TglPanel.Create(Self);
  with Panel do
  begin
    Caption := '';
    Align := alClient;
    OnPaint := FormPaint;
    Parent := Self;
  end;

  InitGl();
  Caption := 'OpenGL VCL Template by sniper ([e-mail])';
  KeyPreview := True;

  GL_Texture := TglBitmap2D.Create();
  GL_Texture.BuildMipMaps := False;
  GL_Texture.LoadFromFile('Back.bmp');
  GL_Texture.FreeDataAfterGenTexture := True;
  GL_Texture.GenTexture();

  OnResize := FormResize;
  Resize();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin//
  GL_Texture.Free();
  DeInitGl();
end;

procedure TForm1.InitGl;
begin//
 InitOpenGL();
 myDc := GetDC(Panel.Handle);
 myRc := CreateRenderingContext(myDc,[opDoubleBuffered],24,16,8,0,0,0);
 ActivateRenderingContext(myDc,myRc);
 glClearColor(0, 0,0, 0);
 glShadeModel(GL_SMOOTH);
 glClearDepth(1.5);
 glEnable(GL_DEPTH_TEST);
 glDepthFunc (GL_LEQUAL);
 glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
 glEnable(GL_TEXTURE_2D);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  // TODO : Draw Hier
  glRender();
  // End Drawing
  SwapBuffers(myDc);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=27 then Close();
end;

procedure TForm1.FormResize(Sender: TObject);
begin//
  if (ClientHeight=0) then
  begin
    ClientHeight := 1;
  end;
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  // for 2d
  glOrtho(0, ClientWidth, ClientHeight,0, -10,10);
  // for 3d
  //gluPerspective(45, Width/Height, 0.1, 1000);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();

  FormPaint(nil);
end;

procedure TForm1.glRender();
begin
  GL_Texture.Bind();

  glLoadIdentity();
  glTranslatef( ClientWidth/2 - GL_Texture.Width/2, ClientHeight/2 - GL_Texture.Height/2, 0 );
  glScalef(GL_Texture.Width, GL_Texture.Height, 1);
  glBegin(GL_QUADS);
  glTexCoord2f(0,0);
  glVertex2f(0,0);
  glTexCoord2f(1,0);
  glVertex2f(1,0);
  glTexCoord2f(1,1);
  glVertex2f(1,1);
  glTexCoord2f(0,1);
  glVertex2f(0,1);
  glEnd();
end;

{ TglPanel }

procedure TglPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TglPanel.WMPaint(var Message: TWMPaint);
var
  PS:TPaintStruct;
begin
  BeginPaint( Handle, PS);
  if Assigned(FOnPaintEvent) then
    FOnPaintEvent(Self);
  EndPaint( Handle, PS);
  Message.Result := 0;
end;

end.

Zum Kompilieren benötigte Quellen:dglOpenGl.pasglBitmap.pas

[freq.9]

Jau das sieht ja schon ganz gut aus, jedoch wird immer eine Exception geworfen mit folgender Message:

Zitat:

First chance exception at $77E53887. Exception class Exception with message 'TglBitmap2D.GenTexture - Rendercontex dosn't support non power of two texture.'. Process PunktAbstand.exe (1892)

Zudem musste ich nun diese Zeile rausnehmen, da BuildMipMaps scheinbar undefiniert ist.

GL_Texture.BuildMipMaps := False; Edit_1:
Okay, wenn ich nun folgendes auch noch rausnehme funktionierts ohne Probleme:

GL_Texture.GenTexture();

[freq.9]

Wo genau trage ich nun meinen Teil rein, mit dem ich "Zeichnen" kann?

[Cliff]

Hi,
schaue doch einmal unbedingt hier: http://www.delphigl.com vorbei.

Dort findest Du alles was Du benötigst (... und noch viel mehr )

Gruss Cliff

[freq.9]

Jau war da schon die ganze Zeit, aber hatte das falsche gesucht. Nun gehts. Nur gibts ne Funktion, mit der man Linien zeichnen kann, oder muss man die per Hand erstellen?

// Edit:
GL_LINES hilft

// Edit_2:
Okay grade als ich es bearbeite antwortest du

[Airblader]

In etwa so:

Delphi-Quellcode:

glBegin(GL_LINES);
   glVertex3f(x1, y1, z1);
   glVertex3f(x2, y2, z2);
glEnd();

Kann man natürlich auch als Funktion schachteln.

air

[freq.9]

So ich habe nun ein Koordinatenkreuz gezeichnet. Wenn ich dieses nun aber drehe (0°..360°) dreht sich die X-Achse immer weit über die Anwendung hinaus. Woran kann das liegen?

Mein aktueller Code:

Delphi-Quellcode:

unit main;

interface

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

type
  TglPanel = class(TPanel)
    private
      FOnPaintEvent:TNotifyEvent;
    protected
      procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    published
      property OnPaint:TNotifyEvent read FOnPaintEvent write FOnPaintEvent;
  end;

  TfrmMain = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    myRc, myDc : Cardinal;
    GL_Texture:TglBitmap2D;
    Panel: TglPanel;
    ControlPanel: TPanel;
    procedure InitGl();
    procedure DeInitGl();
    procedure glRender();
  end;

var
  frmMain: TfrmMain;
  e: TWinControl;
  Angle: Integer;

implementation

{$R *.dfm}

procedure TfrmMain.DeInitGl;
begin
  DeactivateRenderingContext();
  DestroyRenderingContext(myRc);
  ReleaseDC(Panel.Handle, myDc);
end; 

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  OnResize := nil;
  Angle := 0;

  Panel := TglPanel.Create(Self);
  with Panel do
  begin
    Caption := '';
    Align   := alClient;
    OnPaint := FormPaint;
    Parent  := frmMain;
  end;

  InitGl();
  Caption := 'OpenGL VCL Template by sniper ([e-mail])';
  KeyPreview := True;

  GL_Texture := TglBitmap2D.Create();
  {//GL_Texture.BuildMipMaps := False;
  GL_Texture.LoadFromFile('../Images/back.bmp');
  GL_Texture.FreeDataAfterGenTexture := True;
  //GL_Texture.GenTexture();}

  OnResize := FormResize;
  Resize();
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  GL_Texture.Free();
  DeInitGl();
end;

procedure TfrmMain.InitGl;
begin
  InitOpenGL();

  myDc := GetDC(Panel.Handle);
  myRc := CreateRenderingContext(myDc, [opDoubleBuffered], 24, 16, 8, 0, 0, 0);

  ActivateRenderingContext(myDc,myRc);
  glClearColor(0, 0, 0, 0);
  glShadeModel(GL_SMOOTH);
  glClearDepth(1.0);
  glEnable(GL_DEPTH_TEST);
  glDepthFunc (GL_LEQUAL);
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
  glEnable(GL_TEXTURE_2D);
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glRender();
  SwapBuffers(myDc);
end;

procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=27 then Close();
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin//
  if (ClientHeight=0) then
  begin
    ClientHeight := 1;
  end;
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(120.0, ClientWidth/ClientHeight, 1, 1000);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();

  FormPaint(nil);
end;

procedure TfrmMain.glRender();
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(120.0, ClientWidth/ClientHeight, 1, 1000);

  glTranslatef(0, 0, -5);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glRotated(Angle, 0, 1, 0);

  glBegin(GL_LINES);
    glColor3f(255, 0, 0);
    glVertex3f(-8,  0, 0);
    glVertex3f( 8,  0, 0);
    glColor3f(0, 255, 0);
    glVertex3f( 0,  8, 0);
    glVertex3f( 0, -8, 0);
  glEnd;
 
  SwapBuffers(myDC);
end;

{ TglPanel }

procedure TglPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TglPanel.WMPaint(var Message: TWMPaint);
var
  PS: TPaintStruct;
begin
  BeginPaint(Handle, PS);
  if Assigned(FOnPaintEvent) then
    FOnPaintEvent(Self);
  EndPaint(Handle, PS);
  Message.Result := 0;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  if Angle >= 360 then
    Angle := 0
  else
  begin
    Inc(Angle);
    Inc(Angle);
    Inc(Angle);
    Inc(Angle);
  end;
  glRender;
end;

end.

Bei der Datei bitte aus foo.wma nen foo.avi machen. Leider habe ich kein Programm, mit dem ich WMA oder so aufnehmen kann. Leider nur AVI

[sniper_w]

Zitat von freq.9:

Jau das sieht ja schon ganz gut aus, jedoch wird immer eine Exception geworfen mit folgender Message:

Zitat:

First chance exception at $77E53887. Exception class Exception with message 'TglBitmap2D.GenTexture - Rendercontex dosn't support non power of two texture.'. Process PunktAbstand.exe (1892)

Zudem musste ich nun diese Zeile rausnehmen, da BuildMipMaps scheinbar undefiniert ist.

GL_Texture.BuildMipMaps := False; Edit_1:
Okay, wenn ich nun folgendes auch noch rausnehme funktionierts ohne Probleme:

GL_Texture.GenTexture();

Wenn du soGL_Texture.BuildMipMaps := True; machst, dann sollte klapen mit der Textur.