DGL • Thema anzeigen - Shader und Shaderlist

Shader und Shaderlist

Moderator: DGL-Team

Seite 1 von 2

[ 20 Beiträge ]

Gehe zu Seite 1, 2 Nächste

Druckansicht

Vorheriges Thema | Nächstes Thema

Autor

Nachricht

mori

Betreff des Beitrags: Shader und Shaderlist

Verfasst: Di Jun 30, 2009 15:04

DGL Member

Registriert: Do Okt 16, 2008 13:18
Beiträge: 252

Hi,
ich habe mich vor kurzem an ein Projekt gesetzt, weil es mir aber zu umständlich war für jeden Shader extra Code zu schreiben, habe ich mir eine Unit erstellt die die Klassen TShader (einzelner Shader) und TShaderList enthält. Ich poste die Unit einfach mal, vielleicht kann sie jemand gebrauchen.

PS: Die Unit ist warscheinlich nicht Fehlerfrei, für Tipps währe ich dankbar.

Code:

 
unit Shader;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls, Dialogs,
  dglOpenGL, ExtCtrls, StdCtrls;
 
type
 
TShader=class;
 
TOnInternError=procedure(Shader:TShader; InternErrorString:String) of Object;
 
TShader=class
private
  PFragmentCode:TStringList;
  PVertexCode:TSTringList;
public
  ProgramObject        : GLhandleARB;
  VertexShaderObject   : GLhandleARB;
  FragmentShaderObject : GLhandleARB;
  InternErrorString:String;
  OnInternError:TOnInternError;
 
  constructor Create(VertexFile,FragmentFile:String); overload;
  constructor Create(VertexCode,FragmentCode:TStringList); overload;
  constructor Create(); overload;
  function glSlang_GetInfoLog(glObject : GLHandleARB) : String;
  procedure SetShaderCode(VertexFile,FragmentFile:String); overload;
  procedure SetShaderCode(VertexCode,FragmentCode:TStringList); overload;
  function CreateShader(ProgramObject:GLhandleARB;VertexCode,FragmentCode : String;VertexShader,FragmentShader:GLhandleARB):String;
  procedure UseShader();
  procedure Free(SetOtherShader:Integer);
end;
 
TShaderList=class
private
  Shader:TList;
  ShaderCount:Integer;
public
  constructor Create();
  destructor Free();
  function CreateShader(VertexFile,FragmentFile:String):Integer;
  procedure DeleteShader(Item:Integer);
  function GetShaderHandle(Item:Integer):GLhandleARB;
  procedure UseShader(Item:Integer);
end;
 
implementation
 
constructor TShader.Create();
begin
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
end;
 
constructor TShader.Create(VertexFile,FragmentFile:String);
var
   ErrStr:String;
begin
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
 
SetShaderCode(VertexFile,FragmentFile);
 
ErrStr:=CreateShader(ProgramObject,PVertexCode.Text,
                                   PFragmentCode.Text,
                     VertexShaderObject,
                     FragmentShaderObject);
 
if ErrStr<>'' then
   begin
   InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
   OnInternError(Self,InternErrorString);
   end;
end;
 
 
constructor TShader.Create(VertexCode,FragmentCode:TStringList);
var
   ErrStr:String;
begin
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
 
SetShaderCode(VertexCode,FragmentCode);
 
ErrStr:=CreateShader(ProgramObject,PVertexCode.Text,
                                   PFragmentCode.Text,
                     VertexShaderObject,
                     FragmentShaderObject);
 
if ErrStr<>'' then
   begin
   InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
   OnInternError(Self,InternErrorString);
   end;
end;
 
 
procedure TShader.SetShaderCode(VertexFile,FragmentFile:String);
begin
PVertexCode.Text:='';
PFragmentCode.Text:='';
 
if FileExists(VertexFile) then
   PVertexCode.LoadFromFile(VertexFile)
else
   begin
   InternErrorString:='Error: Die Datei "'+VertexFile+'" existiert nicht';
   OnInternError(Self,InternErrorString);
   end;
 
if FileExists(FragmentFile) then
   PFragmentCode.LoadFromFile(FragmentFile)
else
   begin
   InternErrorString:='Error: Die Datei "'+FragmentFile+'" existiert nicht';
   OnInternError(Self,InternErrorString);
   end;
end;
 
 
procedure TShader.SetShaderCode(VertexCode,FragmentCode:TStringList);
begin
PVertexCode.Text:='';
PFragmentCode.Text:='';
 
PVertexCode.Add(VertexCode.Text);
PFragmentCode.Add(FragmentCode.Text);
end;
 
 
function TShader.glSlang_GetInfoLog(glObject : GLHandleARB) : String;
var
 blen,slen : GLInt;
 InfoLog   : PGLCharARB;
begin
glGetObjectParameterivARB(glObject, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
if blen > 1 then
   begin
   GetMem(InfoLog, blen*SizeOf(GLCharARB));
   glGetInfoLogARB(glObject, blen, slen, InfoLog);
   Result := PChar(InfoLog);
   Dispose(InfoLog);
   end;
end;
 
 
function TShader.CreateShader(ProgramObject:GLhandleARB;VertexCode,FragmentCode : String;VertexShader,FragmentShader:GLhandleARB):String;
var
   tmpLen : Integer;
   ErrStr:String;
begin
ProgramObject:=glCreateProgram;
 
if Length(VertexCode) > 0 then
   begin
   tmpLen := Length(VertexCode);
   VertexShader := glCreateShader(GL_VERTEX_SHADER);
   glShaderSource(VertexShader,1,@VertexCode,@tmpLen);
   glCompileShader(VertexShader);
   glAttachShader(ProgramObject, VertexShader);
   glDeleteShader(VertexShader);
   end;
 
if Length(FragmentCode) > 0 then
   begin
   tmpLen := Length(FragmentCode);
   FragmentShader := glCreateShader(GL_FRAGMENT_SHADER);
   glShaderSource(FragmentShader,1,@FragmentCode,@tmpLen);
   glCompileShader(FragmentShader);
   glAttachShader(ProgramObject, FragmentShader);
   glDeleteShader(FragmentShader);
   end;
 
glLinkProgram(ProgramObject);
 
ErrStr:=glSlang_GetInfoLog(ProgramObject);
 
if ErrStr='' then
   begin
   result:='';
   glUseProgramObjectARB(ProgramObject);
   end
else
   result:='Shader Error: '+ErrStr;
end;
 
 
procedure TShader.UseShader();
begin
glUseProgramObjectARB(ProgramObject);
end;
 
 
procedure TShader.Free(SetOtherShader:Integer);
begin
PVertexCode.Free();
PFragmentCode.Free();
 
glDeleteProgram(ProgramObject);
 
if SetOtherShader<>-1 then
   glUseProgramObjectARB(SetOtherShader)
else
   glUseProgramObjectARB(0);
end;
 
 
constructor TShaderList.Create();
begin
Shader:=TList.Create();
ShaderCount:=0;
end;
 
destructor TShaderList.Free();
var
   i:Integer;
begin
for i:=0 to ShaderCount-1 do
    TShader(Shader.Items[i]).Free(-1);
 
Shader.Free();
end;
 
 
function TShaderList.CreateShader(VertexFile,FragmentFile:String):Integer;
var
   NewShader:TShader;
begin
NewShader:=TShader.Create(VertexFile,FragmentFile);
Shader.Add(NewShader);
ShaderCount:=ShaderCount+1;
 
result:=ShaderCount;
end;
 
 
procedure TShaderList.DeleteShader(Item:Integer);
begin
TShader(Shader.Items[Item]).Free(-1);
Shader.Delete(Item);
ShaderCount:=ShaderCount-1;
end;
 
 
function TShaderList.GetShaderHandle(Item:Integer):GLhandleARB;
begin
result:=TShader(Shader.Items[Item]).ProgramObject;
end;
 
 
procedure TShaderList.UseShader(Item:Integer);
begin
TShader(Shader.Items[Item]).UseShader();
end;
 
end.
 
 

_________________
You even trying ...

Website: http://rise-of-light.de/

Nach oben

Markus

Betreff des Beitrags:

Verfasst: Di Jun 30, 2009 18:35

DGL Member

Registriert: Fr Mär 30, 2007 18:35
Beiträge: 331

Ich hab nur mal schnell drüber geschaut - du solltest deine Free()-Methode umbenennen, weil es die in TObject schon gibt. Das könnte unter Umständen verwirrend sein.

Nach oben

Lord Horazont

Betreff des Beitrags:

Verfasst: Di Jun 30, 2009 18:50

DGL Member

Registriert: Do Sep 02, 2004 19:42
Beiträge: 4158
Programmiersprache: FreePascal, C++

Weiterhin sollten Destruktoren immer Destroy heißen und den standarddestruktor überschreiben:

Code:

destructor Destroy; override;

.

Und dann die Klasseninstanzen immer mit Aufruf von Free freigeben.

greetings

_________________
If you find any deadlinks, please send me a notification – Wenn du tote Links findest, sende mir eine Benachrichtigung.
current projects: ManiacLab; aioxmpp
zombofant network • my photostream
„Writing code is like writing poetry“ - source unknown

„Give a man a fish, and you feed him for a day. Teach a man to fish and you feed him for a lifetime. “ ~ A Chinese Proverb

Nach oben

damadmax

Betreff des Beitrags:

Verfasst: Di Jun 30, 2009 22:56

DGL Member

Registriert: Sa Aug 18, 2007 18:47
Beiträge: 694
Wohnort: Köln
Programmiersprache: Java

Zitat:

ShaderCount:Integer;

Kannst du dir auch sparen, da TList eine solche Eigenschaft bereits hat.

In meiner Unit hab ich eine abstrakte Klasse für alle Shadertypen benutzt. Davon wird dann jeweils Fragment, Vertex oder auch Geometry (wenn ich es denn mal einbaue) abgeleitet.

Die Handles auf die einzelnen Shaderobjekte brauchen/sollten auch nicht public sein. Die braucht man draussen sowieso nicht. Falls doch -warum auch immer- würde ich diese in Funktionen kapseln.

Gruß

damadmax

_________________
Es werde Licht.
glEnable(GL_LIGHTING);
Und es ward Licht.

Zitat aus einem Java Buch: "C makes it easy to shoot yourself in the foot; C++ makes it harder, but when you do it blows your whole leg off"

on error goto next

Nach oben

Schläfer

Betreff des Beitrags:

Verfasst: Mi Jul 01, 2009 16:05

DGL Member

Registriert: Fr Okt 03, 2008 13:32
Beiträge: 367

Du übergibts der Funktion "TShader.CreateShader" die Variablen "VertexShaderObject" und "FragmentShaderObject", die aber immer NULL sein sollten. Besonders am Anfang, falls man sie nicht selbst setzt.
Abgesehen davon werden die Werte gleich mit "VertexShader := glCreateShader(GL_VERTEX_SHADER);" (Zeile 162) bzw. "FragmentShader := glCreateShader(GL_FRAGMENT_SHADER);" (Zeile 172) überschrieben. Dann werden sie wieder freigegeben ("glDeleteShader") wodurch sie wieder NULL sind.
Selbst wenn die Paramter als "var" deklariert wären, würden sie keine brauchbaren Informationen enthalten.

Was mir auch noch gerade auffällt: "ProgramObject" ist auch kein "var"-Paramter. Darum bleibt "TShader.ProgramObject" auch immer NULL. Mal ganz davon abgesehen das es sinnlos ist das als Paramter zu übergeben, weil die Funktion auch so darauf zugreifen kann.

Und zur Form: Ich denke ich das die Handles nicht "public" sein sollten, sonst ändert die noch einer. Es ist sicherlich gut so wenig wie möglich, aber so viel wie nötig, in den Public-Teil zu packen. Also kann da meiner Meinung nach die Funktionen "glSlang_GetInfoLog" raus.

Hm, der constructor in Zeile 29 ist relativ sinnlos. Der erstellt nur die Stringlisten. Die du dann mit SetShaderCode füllen musst. Und dann muss noch der Shader mit CreateShader erzeugt werden. Das "Create" in der Zeile darüber macht aber all das selbst. Wenn man mit "SetShaderCode" den Code aus mehreren Teilen zusammensetzen könnte, hätte das vielleicht noch einen Sinn, aber da der vorherige Teil immer gelöscht wird, wird man das wohl nie benutzen.
Und wenn man das Create weglässt, können auch "SetShaderCode" und "CreateShader" aus dem "public"-Bereich raus.

Nach oben

mori

Betreff des Beitrags:

Verfasst: Mi Jul 01, 2009 17:08

DGL Member

Registriert: Do Okt 16, 2008 13:18
Beiträge: 252

Zitat:

Und wenn man das Create weglässt, können auch "SetShaderCode" und "CreateShader" aus dem "public"-Bereich raus.

Ich hatte Create deshalb getrennt und in die funktionen in den public-Bereich verschoben, falls man den Shader nachträglich nochmal ändern möchte z.B zum Testen von Shadern, die direkt eingetippt werden ect.

_________________
You even trying ...

Website: http://rise-of-light.de/

Nach oben

mori

Betreff des Beitrags:

Verfasst: Mi Jul 01, 2009 17:29

DGL Member

Registriert: Do Okt 16, 2008 13:18
Beiträge: 252

Hi,
ich habe eben noch einen großen Fehler behoben, bis jetzt sind die Shder nicht geladen worden :oops:

.
Jetzt funktioniert aber alles, ich habe die meisten Tipps umgesetzt. Hier die zumindest richtig funktionierende Unit:

Code:

 
unit Shader;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls, Dialogs,
  dglOpenGL, ExtCtrls, StdCtrls;
 
type
 
TShader=class;
 
TOnInternError=procedure(Shader:TShader; ErrorString:String) of Object;
 
TShader=class
private
  PFragmentCode:TStringList;
  PVertexCode:TSTringList;
  UseStep:Integer;
  ProgramObject : GLhandleARB;
 
  function glSlang_GetInfoLog(glObject : GLHandleARB) : String;
public
  InternErrorString:String;
  OnInternError:TOnInternError;
 
  constructor Create(VertexFile,FragmentFile:String); overload;
  constructor Create(VertexCode,FragmentCode:TStringList); overload;
  constructor Create(); overload;
  procedure SetShaderCode(VertexFile,FragmentFile:String); overload;
  procedure SetShaderCode(VertexCode,FragmentCode:TStringList); overload;
  function CreateShader():String;
  procedure UseShader();
  procedure Destroy(SetOtherShader:Integer) overload;
end;
 
TShaderList=class
private
  Shader:TList;
  function FGetShaderCount():Integer;
public
  property ShaderCount:Integer read FGetShaderCount;
 
  constructor Create();
  destructor Destroy(); overload;
  function CreateShader(VertexFile,FragmentFile:String):Integer;
  procedure DeleteShader(Item:Integer);
  function GetShader(Item:Integer):TShader;
  procedure UseShader(Item:Integer);
end;
 
implementation
 
constructor TShader.Create();
begin
UseStep:=0;
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
end;
 
constructor TShader.Create(VertexFile,FragmentFile:String);
var
   ErrStr:String;
begin
UseStep:=0;
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
 
SetShaderCode(VertexFile,FragmentFile);
 
ErrStr:=CreateShader();
 
if ErrStr<>'' then
   begin
   InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
   if Assigned(OnInternError) then
      OnInternError(Self,InternErrorString);
   end;
end;
 
 
constructor TShader.Create(VertexCode,FragmentCode:TStringList);
var
   ErrStr:String;
begin
UseStep:=0;
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
 
SetShaderCode(VertexCode,FragmentCode);
 
ErrStr:=CreateShader();
 
if ErrStr<>'' then
   begin
   InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
   if Assigned(OnInternError) then
      OnInternError(Self,InternErrorString);
   end;
 
UseShader();
end;
 
 
procedure TShader.SetShaderCode(VertexFile,FragmentFile:String);
begin
UseStep:=1;
PVertexCode.Text:='';
PFragmentCode.Text:='';
 
if FileExists(VertexFile) then
   PVertexCode.LoadFromFile(VertexFile)
else
   begin
   InternErrorString:='Error: Die Datei "'+VertexFile+'" existiert nicht';
   if Assigned(OnInternError) then
      OnInternError(Self,InternErrorString);
   UseStep:=0;
   end;
 
if FileExists(FragmentFile) then
   PFragmentCode.LoadFromFile(FragmentFile)
else
   begin
   InternErrorString:='Error: Die Datei "'+FragmentFile+'" existiert nicht';
   if @OnInternError<>nil then
      OnInternError(Self,InternErrorString);
   UseStep:=0;
   end;
end;
 
 
procedure TShader.SetShaderCode(VertexCode,FragmentCode:TStringList);
begin
PVertexCode.Text:='';
PFragmentCode.Text:='';
 
PVertexCode.Add(VertexCode.Text);
PFragmentCode.Add(FragmentCode.Text);
UseStep:=1;
end;
 
 
function TShader.glSlang_GetInfoLog(glObject : GLHandleARB) : String;
var
 blen,slen : GLInt;
 InfoLog   : PGLCharARB;
begin
glGetObjectParameterivARB(glObject, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
if blen > 1 then
   begin
   GetMem(InfoLog, blen*SizeOf(GLCharARB));
   glGetInfoLogARB(glObject, blen, slen, InfoLog);
   Result := PChar(InfoLog);
   Dispose(InfoLog);
   end;
end;
 
 
function TShader.CreateShader():String;
var
   tmpLen : Integer;
   ErrStr:String;
   VertexShaderObject   : GLhandleARB;
   FragmentShaderObject : GLhandleARB;
   VCode,FCode:String;
begin
 
if UseStep=1 then
   begin
   UseStep:=2;
   VCode:=PVertexCode.Text;
   FCode:=PFragmentCode.Text;
 
   ProgramObject:=glCreateProgram;
 
   if Length(VCode) > 0 then
      begin
      tmpLen := Length(PVertexCode.Text);
      VertexShaderObject := glCreateShader(GL_VERTEX_SHADER);
      glShaderSource(VertexShaderObject,1,@VCode,@tmpLen);
      glCompileShader(VertexShaderObject);
      glAttachShader(ProgramObject, VertexShaderObject);
      glDeleteShader(VertexShaderObject);
      end
   else
      UseStep:=1;
 
   if Length(FCode) > 0 then
      begin
      tmpLen := Length(FCode);
      FragmentShaderObject := glCreateShader(GL_FRAGMENT_SHADER);
      glShaderSource(FragmentShaderObject,1,@FCode,@tmpLen);
      glCompileShader(FragmentShaderObject);
      glAttachShader(ProgramObject, FragmentShaderObject);
      glDeleteShader(FragmentShaderObject);
      end
   else
      UseStep:=1;
 
   glLinkProgram(ProgramObject);
 
   ErrStr:=glSlang_GetInfoLog(ProgramObject);
 
   if ErrStr='' then
      begin
      result:='';
      glUseProgramObjectARB(ProgramObject);
      end
   else
      begin
      result:='Shader Error: '+ErrStr;
      UseStep:=1;
      end;
   end;
end;
 
 
procedure TShader.UseShader();
begin
if UseStep=2 then
   glUseProgramObjectARB(ProgramObject)
else
   begin
   glUseProgramObjectARB(0);
   InternErrorString:='Shader is not ready to use';
   if Assigned(OnInternError) then
      OnInternError(self,InternErrorString);
   end;
end;
 
 
procedure TShader.Destroy(SetOtherShader:Integer);
begin
inherited Destroy();
 
PVertexCode.Free();
PFragmentCode.Free();
 
glDeleteProgram(ProgramObject);
 
if SetOtherShader<>-1 then
   glUseProgramObjectARB(SetOtherShader)
else
   glUseProgramObjectARB(0);
end;
 
 
constructor TShaderList.Create();
begin
Shader:=TList.Create();
Shader.Count:=0;
end;
 
destructor TShaderList.Destroy();
var
   i:Integer;
begin
inherited Destroy();
 
for i:=0 to Shader.Count-1 do
    TShader(Shader.Items[i]).Destroy(-1);
 
Shader.Free();
end;
 
 
function TShaderList.CreateShader(VertexFile,FragmentFile:String):Integer;
var
   NewShader:TShader;
begin
NewShader:=TShader.Create(VertexFile,FragmentFile);
Shader.Add(NewShader);
 
result:=Shader.Count;
end;
 
 
procedure TShaderList.DeleteShader(Item:Integer);
begin
TShader(Shader.Items[Item]).Destroy(-1);
Shader.Delete(Item);
end;
 
 
function TShaderList.GetShader(Item:Integer):TShader;
begin
result:=TShader(Shader.Items[Item]);
end;
 
 
procedure TShaderList.UseShader(Item:Integer);
begin
TShader(Shader.Items[Item]).UseShader();
end;
 
function TShaderList.FGetShaderCount():Integer;
begin
Result:=Shader.Count;
end;
 
end.
 

_________________
You even trying ...

Website: http://rise-of-light.de/

Nach oben

Schläfer

Betreff des Beitrags:

Verfasst: Mi Jul 01, 2009 19:16

DGL Member

Registriert: Fr Okt 03, 2008 13:32
Beiträge: 367

mori hat geschrieben:

Zitat:

Und wenn man das Create weglässt, können auch "SetShaderCode" und "CreateShader" aus dem "public"-Bereich raus.

OK, das ist natürlich ein Grund. Man könnte auch den Shader mit Free löschen und einen neuen erstellen, aber das ist dann nicht so günstig wenn man zwischendurch auf den zugreifen will.
Das "UseStep" soll wohl dafür sorgen das alles in der richtigen Reihenfolge gemacht wird?
Hast du auch daran gedacht das alte Handle freizugeben, sonst bleiben die alten Shader noch im Speicher. In "CreateShader" hab ich nichts gefunden, hab aber grad nicht die Zeit alles nochmal durchzuschauen.

Nach oben

Markus

Betreff des Beitrags:

Verfasst: Do Jul 02, 2009 09:57

DGL Member

Registriert: Fr Mär 30, 2007 18:35
Beiträge: 331

Jetzt hast du Free() in Destroy() umbenannt... Destroy() ist normalerweise der Destruktor und keine Prozedur, das solltest du ändern.

Nach oben

Lord Horazont

Betreff des Beitrags:

Verfasst: Do Jul 02, 2009 12:22

DGL Member

Registriert: Do Sep 02, 2004 19:42
Beiträge: 4158
Programmiersprache: FreePascal, C++

Und override nicht overload. Und immer Free aufrufen, nicht Destroy.

greetings

Nach oben

mori

Betreff des Beitrags:

Verfasst: Do Jul 02, 2009 15:18

DGL Member

Registriert: Do Okt 16, 2008 13:18
Beiträge: 252

Zitat:

Jetzt hast du Free() in Destroy() umbenannt... Destroy() ist normalerweise der Destruktor und keine Prozedur, das solltest du ändern.

Ja das mit dem Destructor ist mir auch kurz nachdem ich es gepostet habe aufgefallen

Zitat:

Und override nicht overload.

Das mit dem overload habe ich auch erst nachdem ich es gepostet hatte gesehen ist jetzt aber korrigiert.

Zitat:

Und immer Free aufrufen, nicht Destroy.

Was heißt das jetzt, soll ich Destroy überschreiben aber Free aufrufen?

_________________
You even trying ...

Website: http://rise-of-light.de/

Nach oben

Sellmann

Betreff des Beitrags:

Verfasst: Do Jul 02, 2009 15:46

DGL Member

Registriert: Fr Jan 04, 2008 21:29
Beiträge: 419
Wohnort: Lübeck

Free ist eine procedure die Destroy aufruft und allen betroffenen Objekten bescheid gibt, dass dein Objekt nicht mehr existiert. Außerdem werden durch Free alle weiteren Funktionen aufgerufen, die für die allgemeine Objektstruktur notwendig sind um ein Objekt sauber aus dem Arbeitsspeicher zu entfernen. Nicht zu vergessen ist, dass ggf. der Destructor der Mutterklasse ausgeführt werden muss. Das sind alles Dinge die "Destroy" nicht von sich aus macht, Free schon.

_________________
Klar Soweit?

Nach oben

Lord Horazont

Betreff des Beitrags:

Verfasst: Do Jul 02, 2009 16:42

DGL Member

Registriert: Do Sep 02, 2004 19:42
Beiträge: 4158
Programmiersprache: FreePascal, C++

Nicht ganz.

Code:

procedure TObject.Free;
begin
  // the call via self avoids a warning
  if self<>nil then
    self.destroy;
end;

... Um mal kurz aus der objpas.inc zu zitieren [zur besseren Lesbarkeit leicht abgeändert].

Free tut also nichts weiter als vorher zu prüfen, ob man nicht gerade versucht, einen nil-Pointer freizugeben. Es gehört einfach zum guten Stil, Free aufzurufen anstatt Destroy. Der aufruf von Destroy wird dann von Free erledigt.

Das Aufrufen der Destruktoren der Vorfahrenklassen muss durch ein

Code:

inherited Destroy;

im eigenen Destruktor erledigt werden. Passenderweise sollte das am Ende geschehen.

Weder Free noch Destroy kümmern sich darum, dass alle Referenzen des Objektes geleert werden.

greetings

Nach oben

mori

Betreff des Beitrags:

Verfasst: Mi Jul 08, 2009 13:15

DGL Member

Registriert: Do Okt 16, 2008 13:18
Beiträge: 252

Hi,
hier ist nochmal eine neue Version, ich habe die Fehlerbehandlung geändert, und ein paar neue Funktionen hinzugefügt. Mit TShaderErrors kann man jetzt auch herausfinden was den Fehler verursacht hat.

Code:

 
unit Shader;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes,Dialogs, dglOpenGL;
 
const
 
GL_NO_ERROR=0;
GL_FRAGMENT_ERROR=1;
GL_VERTEX_ERROR=2;
GL_NO_CODE_LOADED=3;
GL_NO_CODE_FOUND=4;
GL_COMPILER_ERROR=5;
GL_LINKER_ERROR=6;
GL_SHADER_ISNT_READY_TO_USE=7;
 
type
 
TShaderError=GL_NO_ERROR..GL_SHADER_ISNT_READY_TO_USE;
TShaderErrors=set of TShaderError;
 
 
TShader=class;
 
TOnInternError=procedure(Shader:TShader; ErrorCode:TShaderErrors; ErrorString:String) of Object;
 
TShader=class
private
  PFragmentCode:TStringList;
  PVertexCode:TSTringList;
  UseStep:Integer;
  ProgramObject : GLhandleARB;
 
  InternErrors:TStringList;
 
  function glSlang_GetProgramInfoLog(PProgram : GLHandleARB) : String;
  function glSlang_GetShaderInfoLog(PShader:GlHandleARB):String;
 
  function PGetShaderHandle():GLhandleARB;
  function PGetError(ErrorNr:Integer):String;
 
  procedure AddError(ErrorCode:TShaderErrors; ErrorString:String);
public
  OnInternError:TOnInternError;
  property ShaderHandle:GLhandleARB read PGetShaderHandle;
  property Errors [Nr:Integer]: String read PGetError;
 
  constructor Create(VertexFile,FragmentFile:String); overload;
  constructor Create(VertexCode,FragmentCode:TStringList); overload;
  constructor Create(); overload;
  procedure SetShaderCode(VertexFile,FragmentFile:String); overload;
  procedure SetShaderCode(VertexCode,FragmentCode:TStringList); overload;
  procedure CreateShader();
  procedure UseShader();
  destructor Destroy(SetOtherShader:Integer);
 
  function GetAllErrors():String;
  function GetLastError():String;
end;
 
TShaderList=class
private
  PShader:TList;
  function FGetShaderCount():Integer;
  function FGetShader(Item:Integer):TShader;
public
  property ShaderCount:Integer read FGetShaderCount;
  property Shader [ShaderNr:Integer]: TShader read FGetShader;
 
  constructor Create();
  destructor Destroy(); override;
  function CreateShader(VertexFile,FragmentFile:String):Integer;
  procedure DeleteShader(Item:Integer);
  procedure UseShader(Item:Integer);
end;
 
implementation
 
constructor TShader.Create();
begin
UseStep:=0;
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
InternErrors:=TStringList.Create();
end;
 
constructor TShader.Create(VertexFile,FragmentFile:String);
begin
UseStep:=0;
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
InternErrors:=TStringList.Create();
 
SetShaderCode(VertexFile,FragmentFile);
 
CreateShader();
end;
 
 
constructor TShader.Create(VertexCode,FragmentCode:TStringList);
var
   ErrStr:String;
begin
UseStep:=0;
PVertexCode:=TStringList.Create();
PFragmentCode:=TStringList.Create();
InternErrors:=TStringList.Create();
 
SetShaderCode(VertexCode,FragmentCode);
 
CreateShader();
 
UseShader();
end;
 
 
procedure TShader.SetShaderCode(VertexFile,FragmentFile:String);
begin
UseStep:=1;
PVertexCode.Text:='';
PFragmentCode.Text:='';
 
if FileExists(VertexFile) then
   PVertexCode.LoadFromFile(VertexFile)
else
   begin
   AddError([GL_NO_CODE_LOADED,GL_VERTEX_ERROR],'Error: Die Datei "'+VertexFile+'" existiert nicht');
   UseStep:=0;
   end;
 
if FileExists(FragmentFile) then
   PFragmentCode.LoadFromFile(FragmentFile)
else
   begin
   AddError([GL_NO_CODE_LOADED,GL_FRAGMENT_ERROR],'Error: Die Datei "'+FragmentFile+'" existiert nicht');
   UseStep:=0;
   end;
end;
 
 
procedure TShader.SetShaderCode(VertexCode,FragmentCode:TStringList);
begin
PVertexCode.Text:='';
PFragmentCode.Text:='';
 
PVertexCode.Add(VertexCode.Text);
PFragmentCode.Add(FragmentCode.Text);
UseStep:=1;
end;
 
 
function TShader.glSlang_GetProgramInfoLog(PProgram : GLHandle) : String;
var
 blen,slen : GLInt;
 InfoLog   : PGLCharARB;
begin
Result:='';
glGetProgramiv(PProgram, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
 
if blen > 1 then
   begin
   GetMem(InfoLog, blen*SizeOf(GLCharARB));
   glGetProgramInfoLog(PProgram,blen,slen,InfoLog);
   Result := PChar(InfoLog);
   Dispose(InfoLog);
   end;
end;
 
function TShader.glSlang_GetShaderInfoLog(PShader:GlHandle):String;
var
 blen,slen : GLInt;
 InfoLog   : PGLCharARB;
 LStatus: Integer;
begin
Result:='';
glGetShaderiv(PShader, GL_COMPILE_STATUS, @LStatus);
if LStatus=GL_FALSE then
   begin
   glGetObjectParameterivARB(PShader, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
 
   if blen > 1 then
      begin
      GetMem(InfoLog, blen*SizeOf(GLCharARB));
      glGetShaderInfoLog(PShader,blen,slen,InfoLog);
      Result := PChar(InfoLog);
      Dispose(InfoLog);
      end;
   end;
end;
 
 
procedure TShader.CreateShader();
var
   tmpLen : Integer;
   ErrStr:String;
   VertexShaderObject   : GLhandleARB;
   FragmentShaderObject : GLhandleARB;
   VCode,FCode:String;
 
   LStatus:Integer;
   blen,slen : GLInt;
   InfoLog   : PGLCharARB;
begin
if UseStep=1 then
   begin
   UseStep:=2;
   VCode:=PVertexCode.Text;
   FCode:=PFragmentCode.Text;
 
   ProgramObject:=glCreateProgram;
 
   if Length(VCode) > 0 then
      begin
      tmpLen := Length(PVertexCode.Text);
      VertexShaderObject := glCreateShader(GL_VERTEX_SHADER);
      glShaderSource(VertexShaderObject,1,@VCode,@tmpLen);
      glCompileShader(VertexShaderObject);
      LStatus:=GL_TRUE;
      glAttachShader(ProgramObject, VertexShaderObject);
        Errstr:=GlSlang_GetShaderInfoLog(VertexShaderObject);
        if ErrStr<>'' then
           begin
           AddError([GL_COMPILER_ERROR,GL_VERTEX_ERROR],'Error: Beim laden des Shaders trat folgendes Problem auf'+#13+#13+ErrStr);
           UseStep:=1;
           end;
      glDeleteShader(VertexShaderObject);
      end
   else
      begin
      UseStep:=1;
      AddError([GL_NO_CODE_FOUND,GL_VERTEX_ERROR],'No Vertexshadercode found');
      end;
 
   if Length(FCode) > 0 then
      begin
      tmpLen := Length(FCode);
      FragmentShaderObject := glCreateShader(GL_FRAGMENT_SHADER);
      glShaderSource(FragmentShaderObject,1,@FCode,@tmpLen);
      glCompileShader(FragmentShaderObject);
      glAttachShader(ProgramObject, FragmentShaderObject);
        ErrStr:=glSlang_GetShaderInfoLog(FragmentShaderObject);
        if ErrStr<>'' then
           begin
           AddError([GL_COMPILER_ERROR,GL_FRAGMENT_ERROR],'Error: Beim laden des Shaders trat folgendes Problem auf'+#13+#13+ErrStr);
           UseStep:=1;
           end;
      glDeleteShader(FragmentShaderObject);
      end
   else
      begin
      UseStep:=1;
      AddError([GL_NO_CODE_FOUND,GL_FRAGMENT_ERROR],'No Fragmentshadercode found');
      end;
 
   glLinkProgram(ProgramObject);
   LStatus:=GL_TRUE;
   glGetProgramiv(ProgramObject, GL_LINK_STATUS, @LStatus);
 
   if LStatus<>GL_TRUE then
      begin
      glGetProgramiv(ProgramObject, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
      if blen > 1 then
         begin
         GetMem(InfoLog, blen*SizeOf(GLCharARB));
         glGetProgramInfoLog(ProgramObject, blen, slen, InfoLog);
         AddError([GL_LINKER_ERROR],'Error: Beim Linken des Shaders trat folgendes Problem auf'+#13+#13+PChar(InfoLog));
         Dispose(InfoLog);
         end;
      end;
 
 
   ErrStr:=glSlang_GetProgramInfoLog(ProgramObject);
   if ErrStr='' then
      glUseProgramObjectARB(ProgramObject)
   else          
      begin
      UseStep:=1;
      end;
   end;
end;
 
 
procedure TShader.UseShader();
begin
if UseStep=2 then
   glUseProgramObjectARB(ProgramObject)
else
   begin
   glUseProgramObjectARB(0);
   AddError([GL_SHADER_ISNT_READY_TO_USE],'Der Shader ist nicht bereit');
   end;
end;
 
function TShader.GetAllErrors():String;
var
   i:Integer;
begin
Result:='';
for i:=1 to InternErrors.Count-1 do
    Result:=Result+Inttostr(i)+': '+InternErrors.Strings[i]+' | ';
end;
 
function TShader.GetLastError():String;
begin
if InternErrors.Count<>0 then
   Result:=InternErrors.Strings[InternErrors.Count-1]
else
   Result:='No Error';
end;
 
function TShader.PGetError(ErrorNr:Integer):String;
begin
result:='No Error';
if (InternErrors.Count>ErrorNr) and (0<=ErrorNr) then
   Result:=InternErrors.Strings[ErrorNr]
else
   Result:='Error existiert nicht';
end;
 
function TShader.PGetShaderHandle():GLhandleARB;
begin
Result:=ProgramObject;
end;
 
destructor TShader.Destroy(SetOtherShader:Integer);
begin
inherited Destroy();
 
PVertexCode.Free();
PFragmentCode.Free();
InternErrors.Free();
 
glDeleteProgram(ProgramObject);
 
if SetOtherShader<>-1 then
   glUseProgramObjectARB(SetOtherShader)
else
   glUseProgramObjectARB(0);
end;
 
procedure TShader.AddError(ErrorCode:TShaderErrors; ErrorString:String);
begin
if (GetLastError()<>'Der Shader ist nicht bereit') and
   (ErrorString   <>'Der Shader ist nicht bereit') then
   begin
   if InternErrors.Count-1=5 then
      InternErrors.Delete(1);
 
   InternErrors.Add(ErrorString);
 
   if Assigned(OnInternError) then
      OnInternError(Self,ErrorCode,GetLastError());
 
   ShowMessage(GetLastError());
   end;
end;
 
 
constructor TShaderList.Create();
begin
PShader:=TList.Create();
end;
 
destructor TShaderList.Destroy();
var
   i:Integer;
begin
inherited Destroy();
 
for i:=0 to PShader.Count-1 do
    TShader(PShader.Items[i]).Destroy(-1);
 
PShader.Free();
end;
 
 
function TShaderList.CreateShader(VertexFile,FragmentFile:String):Integer;
var
   NewShader:TShader;
begin
NewShader:=TShader.Create(VertexFile,FragmentFile);
PShader.Add(NewShader);
 
result:=PShader.Count;
end;
 
 
procedure TShaderList.DeleteShader(Item:Integer);
begin
TShader(PShader.Items[Item]).Destroy(-1);
PShader.Delete(Item);
end;
 
 
function TShaderList.FGetShader(Item:Integer):TShader;
begin
if (PShader.Count>Item) and (0<=Item) then
   Result:=TShader(PShader.Items[Item])
else
   Result:=nil;
end;
 
 
procedure TShaderList.UseShader(Item:Integer);
begin
TShader(PShader.Items[Item]).UseShader();
end;
 
function TShaderList.FGetShaderCount():Integer;
begin
Result:=PShader.Count;
end;
 
end.
 
 

_________________
You even trying ...

Website: http://rise-of-light.de/

Nach oben

Lord Horazont

Betreff des Beitrags:

Verfasst: Mi Jul 08, 2009 13:44

DGL Member

Registriert: Do Sep 02, 2004 19:42
Beiträge: 4158
Programmiersprache: FreePascal, C++

Um verwirrung zu vermeiden, solltest du deine Konstenten nicht mit GL_ beginnen lassen.

greetings

Nach oben

Seite 1 von 2

[ 20 Beiträge ]

Gehe zu Seite 1, 2 Nächste

Foren-Übersicht » Programmierung » Shader

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 6 Gäste

Du darfst keine neuen Themen in diesem Forum erstellen.
Du darfst keine Antworten zu Themen in diesem Forum erstellen.
Du darfst deine Beiträge in diesem Forum nicht ändern.
Du darfst deine Beiträge in diesem Forum nicht löschen.
Du darfst keine Dateianhänge in diesem Forum erstellen.