DGL
https://delphigl.com/forum/

Shader und Shaderlist
https://delphigl.com/forum/viewtopic.php?f=20&t=8497		 Seite 1 von 2
Autor:  mori [ Di Jun 30, 2009 15:04 ]
Betreff des Beitrags:  Shader und Shaderlist
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:
  1.  
  2. unit Shader;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls, Dialogs,
  8.   dglOpenGL, ExtCtrls, StdCtrls;
  9.  
  10. type
  11.  
  12. TShader=class;
  13.  
  14. TOnInternError=procedure(Shader:TShader; InternErrorString:String) of Object;
  15.  
  16. TShader=class
  17. private
  18.   PFragmentCode:TStringList;
  19.   PVertexCode:TSTringList;
  20. public
  21.   ProgramObject        : GLhandleARB;
  22.   VertexShaderObject   : GLhandleARB;
  23.   FragmentShaderObject : GLhandleARB;
  24.   InternErrorString:String;
  25.   OnInternError:TOnInternError;
  26.  
  27.   constructor Create(VertexFile,FragmentFile:String); overload;
  28.   constructor Create(VertexCode,FragmentCode:TStringList); overload;
  29.   constructor Create(); overload;
  30.   function glSlang_GetInfoLog(glObject : GLHandleARB) : String;
  31.   procedure SetShaderCode(VertexFile,FragmentFile:String); overload;
  32.   procedure SetShaderCode(VertexCode,FragmentCode:TStringList); overload;
  33.   function CreateShader(ProgramObject:GLhandleARB;VertexCode,FragmentCode : String;VertexShader,FragmentShader:GLhandleARB):String;
  34.   procedure UseShader();
  35.   procedure Free(SetOtherShader:Integer);
  36. end;
  37.  
  38. TShaderList=class
  39. private
  40.   Shader:TList;
  41.   ShaderCount:Integer;
  42. public
  43.   constructor Create();
  44.   destructor Free();
  45.   function CreateShader(VertexFile,FragmentFile:String):Integer;
  46.   procedure DeleteShader(Item:Integer);
  47.   function GetShaderHandle(Item:Integer):GLhandleARB;
  48.   procedure UseShader(Item:Integer);
  49. end;
  50.  
  51. implementation
  52.  
  53. constructor TShader.Create();
  54. begin
  55. PVertexCode:=TStringList.Create();
  56. PFragmentCode:=TStringList.Create();
  57. end;
  58.  
  59. constructor TShader.Create(VertexFile,FragmentFile:String);
  60. var
  61.    ErrStr:String;
  62. begin
  63. PVertexCode:=TStringList.Create();
  64. PFragmentCode:=TStringList.Create();
  65.  
  66. SetShaderCode(VertexFile,FragmentFile);
  67.  
  68. ErrStr:=CreateShader(ProgramObject,PVertexCode.Text,
  69.                                    PFragmentCode.Text,
  70.                      VertexShaderObject,
  71.                      FragmentShaderObject);
  72.  
  73. if ErrStr<>'' then
  74.    begin
  75.    InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
  76.    OnInternError(Self,InternErrorString);
  77.    end;
  78. end;
  79.  
  80.  
  81. constructor TShader.Create(VertexCode,FragmentCode:TStringList);
  82. var
  83.    ErrStr:String;
  84. begin
  85. PVertexCode:=TStringList.Create();
  86. PFragmentCode:=TStringList.Create();
  87.  
  88. SetShaderCode(VertexCode,FragmentCode);
  89.  
  90. ErrStr:=CreateShader(ProgramObject,PVertexCode.Text,
  91.                                    PFragmentCode.Text,
  92.                      VertexShaderObject,
  93.                      FragmentShaderObject);
  94.  
  95. if ErrStr<>'' then
  96.    begin
  97.    InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
  98.    OnInternError(Self,InternErrorString);
  99.    end;
  100. end;
  101.  
  102.  
  103. procedure TShader.SetShaderCode(VertexFile,FragmentFile:String);
  104. begin
  105. PVertexCode.Text:='';
  106. PFragmentCode.Text:='';
  107.  
  108. if FileExists(VertexFile) then
  109.    PVertexCode.LoadFromFile(VertexFile)
  110. else
  111.    begin
  112.    InternErrorString:='Error: Die Datei "'+VertexFile+'" existiert nicht';
  113.    OnInternError(Self,InternErrorString);
  114.    end;
  115.  
  116. if FileExists(FragmentFile) then
  117.    PFragmentCode.LoadFromFile(FragmentFile)
  118. else
  119.    begin
  120.    InternErrorString:='Error: Die Datei "'+FragmentFile+'" existiert nicht';
  121.    OnInternError(Self,InternErrorString);
  122.    end;
  123. end;
  124.  
  125.  
  126. procedure TShader.SetShaderCode(VertexCode,FragmentCode:TStringList);
  127. begin
  128. PVertexCode.Text:='';
  129. PFragmentCode.Text:='';
  130.  
  131. PVertexCode.Add(VertexCode.Text);
  132. PFragmentCode.Add(FragmentCode.Text);
  133. end;
  134.  
  135.  
  136. function TShader.glSlang_GetInfoLog(glObject : GLHandleARB) : String;
  137. var
  138.  blen,slen : GLInt;
  139.  InfoLog   : PGLCharARB;
  140. begin
  141. glGetObjectParameterivARB(glObject, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
  142. if blen > 1 then
  143.    begin
  144.    GetMem(InfoLog, blen*SizeOf(GLCharARB));
  145.    glGetInfoLogARB(glObject, blen, slen, InfoLog);
  146.    Result := PChar(InfoLog);
  147.    Dispose(InfoLog);
  148.    end;
  149. end;
  150.  
  151.  
  152. function TShader.CreateShader(ProgramObject:GLhandleARB;VertexCode,FragmentCode : String;VertexShader,FragmentShader:GLhandleARB):String;
  153. var
  154.    tmpLen : Integer;
  155.    ErrStr:String;
  156. begin
  157. ProgramObject:=glCreateProgram;
  158.  
  159. if Length(VertexCode) > 0 then
  160.    begin
  161.    tmpLen := Length(VertexCode);
  162.    VertexShader := glCreateShader(GL_VERTEX_SHADER);
  163.    glShaderSource(VertexShader,1,@VertexCode,@tmpLen);
  164.    glCompileShader(VertexShader);
  165.    glAttachShader(ProgramObject, VertexShader);
  166.    glDeleteShader(VertexShader);
  167.    end;
  168.  
  169. if Length(FragmentCode) > 0 then
  170.    begin
  171.    tmpLen := Length(FragmentCode);
  172.    FragmentShader := glCreateShader(GL_FRAGMENT_SHADER);
  173.    glShaderSource(FragmentShader,1,@FragmentCode,@tmpLen);
  174.    glCompileShader(FragmentShader);
  175.    glAttachShader(ProgramObject, FragmentShader);
  176.    glDeleteShader(FragmentShader);
  177.    end;
  178.  
  179. glLinkProgram(ProgramObject);
  180.  
  181. ErrStr:=glSlang_GetInfoLog(ProgramObject);
  182.  
  183. if ErrStr='' then
  184.    begin
  185.    result:='';
  186.    glUseProgramObjectARB(ProgramObject);
  187.    end
  188. else
  189.    result:='Shader Error: '+ErrStr;
  190. end;
  191.  
  192.  
  193. procedure TShader.UseShader();
  194. begin
  195. glUseProgramObjectARB(ProgramObject);
  196. end;
  197.  
  198.  
  199. procedure TShader.Free(SetOtherShader:Integer);
  200. begin
  201. PVertexCode.Free();
  202. PFragmentCode.Free();
  203.  
  204. glDeleteProgram(ProgramObject);
  205.  
  206. if SetOtherShader<>-1 then
  207.    glUseProgramObjectARB(SetOtherShader)
  208. else
  209.    glUseProgramObjectARB(0);
  210. end;
  211.  
  212.  
  213. constructor TShaderList.Create();
  214. begin
  215. Shader:=TList.Create();
  216. ShaderCount:=0;
  217. end;
  218.  
  219. destructor TShaderList.Free();
  220. var
  221.    i:Integer;
  222. begin
  223. for i:=0 to ShaderCount-1 do
  224.     TShader(Shader.Items[i]).Free(-1);
  225.  
  226. Shader.Free();
  227. end;
  228.  
  229.  
  230. function TShaderList.CreateShader(VertexFile,FragmentFile:String):Integer;
  231. var
  232.    NewShader:TShader;
  233. begin
  234. NewShader:=TShader.Create(VertexFile,FragmentFile);
  235. Shader.Add(NewShader);
  236. ShaderCount:=ShaderCount+1;
  237.  
  238. result:=ShaderCount;
  239. end;
  240.  
  241.  
  242. procedure TShaderList.DeleteShader(Item:Integer);
  243. begin
  244. TShader(Shader.Items[Item]).Free(-1);
  245. Shader.Delete(Item);
  246. ShaderCount:=ShaderCount-1;
  247. end;
  248.  
  249.  
  250. function TShaderList.GetShaderHandle(Item:Integer):GLhandleARB;
  251. begin
  252. result:=TShader(Shader.Items[Item]).ProgramObject;
  253. end;
  254.  
  255.  
  256. procedure TShaderList.UseShader(Item:Integer);
  257. begin
  258. TShader(Shader.Items[Item]).UseShader();
  259. end;
  260.  
  261. end.
  262.  
  263.  
Autor:  Markus [ Di Jun 30, 2009 18:35 ]
Betreff des Beitrags: 
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.
Autor:  Lord Horazont [ Di Jun 30, 2009 18:50 ]
Betreff des Beitrags: 
Weiterhin sollten Destruktoren immer Destroy heißen und den standarddestruktor überschreiben:
Code:
  1. destructor Destroy; override;
.

Und dann die Klasseninstanzen immer mit Aufruf von Free freigeben.

greetings
Autor:  damadmax [ Di Jun 30, 2009 22:56 ]
Betreff des Beitrags: 
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
Autor:  Schläfer [ Mi Jul 01, 2009 16:05 ]
Betreff des Beitrags: 
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.
Autor:  mori [ Mi Jul 01, 2009 17:08 ]
Betreff des Beitrags: 
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.
Autor:  mori [ Mi Jul 01, 2009 17:29 ]
Betreff des Beitrags: 
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:
  1.  
  2. unit Shader;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls, Dialogs,
  8.   dglOpenGL, ExtCtrls, StdCtrls;
  9.  
  10. type
  11.  
  12. TShader=class;
  13.  
  14. TOnInternError=procedure(Shader:TShader; ErrorString:String) of Object;
  15.  
  16. TShader=class
  17. private
  18.   PFragmentCode:TStringList;
  19.   PVertexCode:TSTringList;
  20.   UseStep:Integer;
  21.   ProgramObject : GLhandleARB;
  22.  
  23.   function glSlang_GetInfoLog(glObject : GLHandleARB) : String;
  24. public
  25.   InternErrorString:String;
  26.   OnInternError:TOnInternError;
  27.  
  28.   constructor Create(VertexFile,FragmentFile:String); overload;
  29.   constructor Create(VertexCode,FragmentCode:TStringList); overload;
  30.   constructor Create(); overload;
  31.   procedure SetShaderCode(VertexFile,FragmentFile:String); overload;
  32.   procedure SetShaderCode(VertexCode,FragmentCode:TStringList); overload;
  33.   function CreateShader():String;
  34.   procedure UseShader();
  35.   procedure Destroy(SetOtherShader:Integer) overload;
  36. end;
  37.  
  38. TShaderList=class
  39. private
  40.   Shader:TList;
  41.   function FGetShaderCount():Integer;
  42. public
  43.   property ShaderCount:Integer read FGetShaderCount;
  44.  
  45.   constructor Create();
  46.   destructor Destroy(); overload;
  47.   function CreateShader(VertexFile,FragmentFile:String):Integer;
  48.   procedure DeleteShader(Item:Integer);
  49.   function GetShader(Item:Integer):TShader;
  50.   procedure UseShader(Item:Integer);
  51. end;
  52.  
  53. implementation
  54.  
  55. constructor TShader.Create();
  56. begin
  57. UseStep:=0;
  58. PVertexCode:=TStringList.Create();
  59. PFragmentCode:=TStringList.Create();
  60. end;
  61.  
  62. constructor TShader.Create(VertexFile,FragmentFile:String);
  63. var
  64.    ErrStr:String;
  65. begin
  66. UseStep:=0;
  67. PVertexCode:=TStringList.Create();
  68. PFragmentCode:=TStringList.Create();
  69.  
  70. SetShaderCode(VertexFile,FragmentFile);
  71.  
  72. ErrStr:=CreateShader();
  73.  
  74. if ErrStr<>'' then
  75.    begin
  76.    InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
  77.    if Assigned(OnInternError) then
  78.       OnInternError(Self,InternErrorString);
  79.    end;
  80. end;
  81.  
  82.  
  83. constructor TShader.Create(VertexCode,FragmentCode:TStringList);
  84. var
  85.    ErrStr:String;
  86. begin
  87. UseStep:=0;
  88. PVertexCode:=TStringList.Create();
  89. PFragmentCode:=TStringList.Create();
  90.  
  91. SetShaderCode(VertexCode,FragmentCode);
  92.  
  93. ErrStr:=CreateShader();
  94.  
  95. if ErrStr<>'' then
  96.    begin
  97.    InternErrorString:='Error: Beim laden des Shaders trat folgendes Problem auf"'+ErrStr+'"';
  98.    if Assigned(OnInternError) then
  99.       OnInternError(Self,InternErrorString);
  100.    end;
  101.  
  102. UseShader();
  103. end;
  104.  
  105.  
  106. procedure TShader.SetShaderCode(VertexFile,FragmentFile:String);
  107. begin
  108. UseStep:=1;
  109. PVertexCode.Text:='';
  110. PFragmentCode.Text:='';
  111.  
  112. if FileExists(VertexFile) then
  113.    PVertexCode.LoadFromFile(VertexFile)
  114. else
  115.    begin
  116.    InternErrorString:='Error: Die Datei "'+VertexFile+'" existiert nicht';
  117.    if Assigned(OnInternError) then
  118.       OnInternError(Self,InternErrorString);
  119.    UseStep:=0;
  120.    end;
  121.  
  122. if FileExists(FragmentFile) then
  123.    PFragmentCode.LoadFromFile(FragmentFile)
  124. else
  125.    begin
  126.    InternErrorString:='Error: Die Datei "'+FragmentFile+'" existiert nicht';
  127.    if @OnInternError<>nil then
  128.       OnInternError(Self,InternErrorString);
  129.    UseStep:=0;
  130.    end;
  131. end;
  132.  
  133.  
  134. procedure TShader.SetShaderCode(VertexCode,FragmentCode:TStringList);
  135. begin
  136. PVertexCode.Text:='';
  137. PFragmentCode.Text:='';
  138.  
  139. PVertexCode.Add(VertexCode.Text);
  140. PFragmentCode.Add(FragmentCode.Text);
  141. UseStep:=1;
  142. end;
  143.  
  144.  
  145. function TShader.glSlang_GetInfoLog(glObject : GLHandleARB) : String;
  146. var
  147.  blen,slen : GLInt;
  148.  InfoLog   : PGLCharARB;
  149. begin
  150. glGetObjectParameterivARB(glObject, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
  151. if blen > 1 then
  152.    begin
  153.    GetMem(InfoLog, blen*SizeOf(GLCharARB));
  154.    glGetInfoLogARB(glObject, blen, slen, InfoLog);
  155.    Result := PChar(InfoLog);
  156.    Dispose(InfoLog);
  157.    end;
  158. end;
  159.  
  160.  
  161. function TShader.CreateShader():String;
  162. var
  163.    tmpLen : Integer;
  164.    ErrStr:String;
  165.    VertexShaderObject   : GLhandleARB;
  166.    FragmentShaderObject : GLhandleARB;
  167.    VCode,FCode:String;
  168. begin
  169.  
  170. if UseStep=1 then
  171.    begin
  172.    UseStep:=2;
  173.    VCode:=PVertexCode.Text;
  174.    FCode:=PFragmentCode.Text;
  175.  
  176.    ProgramObject:=glCreateProgram;
  177.  
  178.    if Length(VCode) > 0 then
  179.       begin
  180.       tmpLen := Length(PVertexCode.Text);
  181.       VertexShaderObject := glCreateShader(GL_VERTEX_SHADER);
  182.       glShaderSource(VertexShaderObject,1,@VCode,@tmpLen);
  183.       glCompileShader(VertexShaderObject);
  184.       glAttachShader(ProgramObject, VertexShaderObject);
  185.       glDeleteShader(VertexShaderObject);
  186.       end
  187.    else
  188.       UseStep:=1;
  189.  
  190.    if Length(FCode) > 0 then
  191.       begin
  192.       tmpLen := Length(FCode);
  193.       FragmentShaderObject := glCreateShader(GL_FRAGMENT_SHADER);
  194.       glShaderSource(FragmentShaderObject,1,@FCode,@tmpLen);
  195.       glCompileShader(FragmentShaderObject);
  196.       glAttachShader(ProgramObject, FragmentShaderObject);
  197.       glDeleteShader(FragmentShaderObject);
  198.       end
  199.    else
  200.       UseStep:=1;
  201.  
  202.    glLinkProgram(ProgramObject);
  203.  
  204.    ErrStr:=glSlang_GetInfoLog(ProgramObject);
  205.  
  206.    if ErrStr='' then
  207.       begin
  208.       result:='';
  209.       glUseProgramObjectARB(ProgramObject);
  210.       end
  211.    else
  212.       begin
  213.       result:='Shader Error: '+ErrStr;
  214.       UseStep:=1;
  215.       end;
  216.    end;
  217. end;
  218.  
  219.  
  220. procedure TShader.UseShader();
  221. begin
  222. if UseStep=2 then
  223.    glUseProgramObjectARB(ProgramObject)
  224. else
  225.    begin
  226.    glUseProgramObjectARB(0);
  227.    InternErrorString:='Shader is not ready to use';
  228.    if Assigned(OnInternError) then
  229.       OnInternError(self,InternErrorString);
  230.    end;
  231. end;
  232.  
  233.  
  234. procedure TShader.Destroy(SetOtherShader:Integer);
  235. begin
  236. inherited Destroy();
  237.  
  238. PVertexCode.Free();
  239. PFragmentCode.Free();
  240.  
  241. glDeleteProgram(ProgramObject);
  242.  
  243. if SetOtherShader<>-1 then
  244.    glUseProgramObjectARB(SetOtherShader)
  245. else
  246.    glUseProgramObjectARB(0);
  247. end;
  248.  
  249.  
  250. constructor TShaderList.Create();
  251. begin
  252. Shader:=TList.Create();
  253. Shader.Count:=0;
  254. end;
  255.  
  256. destructor TShaderList.Destroy();
  257. var
  258.    i:Integer;
  259. begin
  260. inherited Destroy();
  261.  
  262. for i:=0 to Shader.Count-1 do
  263.     TShader(Shader.Items[i]).Destroy(-1);
  264.  
  265. Shader.Free();
  266. end;
  267.  
  268.  
  269. function TShaderList.CreateShader(VertexFile,FragmentFile:String):Integer;
  270. var
  271.    NewShader:TShader;
  272. begin
  273. NewShader:=TShader.Create(VertexFile,FragmentFile);
  274. Shader.Add(NewShader);
  275.  
  276. result:=Shader.Count;
  277. end;
  278.  
  279.  
  280. procedure TShaderList.DeleteShader(Item:Integer);
  281. begin
  282. TShader(Shader.Items[Item]).Destroy(-1);
  283. Shader.Delete(Item);
  284. end;
  285.  
  286.  
  287. function TShaderList.GetShader(Item:Integer):TShader;
  288. begin
  289. result:=TShader(Shader.Items[Item]);
  290. end;
  291.  
  292.  
  293. procedure TShaderList.UseShader(Item:Integer);
  294. begin
  295. TShader(Shader.Items[Item]).UseShader();
  296. end;
  297.  
  298. function TShaderList.FGetShaderCount():Integer;
  299. begin
  300. Result:=Shader.Count;
  301. end;
  302.  
  303. end.
  304.  
Autor:  Schläfer [ Mi Jul 01, 2009 19:16 ]
Betreff des Beitrags: 
mori hat geschrieben:
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.


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.
Autor:  Markus [ Do Jul 02, 2009 09:57 ]
Betreff des Beitrags: 
Jetzt hast du Free() in Destroy() umbenannt... Destroy() ist normalerweise der Destruktor und keine Prozedur, das solltest du ändern.
Autor:  Lord Horazont [ Do Jul 02, 2009 12:22 ]
Betreff des Beitrags: 
Und override nicht overload. Und immer Free aufrufen, nicht Destroy.

greetings
Autor:  mori [ Do Jul 02, 2009 15:18 ]
Betreff des Beitrags: 
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?
Autor:  Sellmann [ Do Jul 02, 2009 15:46 ]
Betreff des Beitrags: 
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.
Autor:  Lord Horazont [ Do Jul 02, 2009 16:42 ]
Betreff des Beitrags: 
Nicht ganz.
Code:
  1. procedure TObject.Free;
  2. begin
  3.   // the call via self avoids a warning
  4.   if self<>nil then
  5.     self.destroy;
  6. 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:
  1. 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
Autor:  mori [ Mi Jul 08, 2009 13:15 ]
Betreff des Beitrags: 
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:
  1.  
  2. unit Shader;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes,Dialogs, dglOpenGL;
  8.  
  9. const
  10.  
  11. GL_NO_ERROR=0;
  12. GL_FRAGMENT_ERROR=1;
  13. GL_VERTEX_ERROR=2;
  14. GL_NO_CODE_LOADED=3;
  15. GL_NO_CODE_FOUND=4;
  16. GL_COMPILER_ERROR=5;
  17. GL_LINKER_ERROR=6;
  18. GL_SHADER_ISNT_READY_TO_USE=7;
  19.  
  20. type
  21.  
  22. TShaderError=GL_NO_ERROR..GL_SHADER_ISNT_READY_TO_USE;
  23. TShaderErrors=set of TShaderError;
  24.  
  25.  
  26. TShader=class;
  27.  
  28. TOnInternError=procedure(Shader:TShader; ErrorCode:TShaderErrors; ErrorString:String) of Object;
  29.  
  30. TShader=class
  31. private
  32.   PFragmentCode:TStringList;
  33.   PVertexCode:TSTringList;
  34.   UseStep:Integer;
  35.   ProgramObject : GLhandleARB;
  36.  
  37.   InternErrors:TStringList;
  38.  
  39.   function glSlang_GetProgramInfoLog(PProgram : GLHandleARB) : String;
  40.   function glSlang_GetShaderInfoLog(PShader:GlHandleARB):String;
  41.  
  42.   function PGetShaderHandle():GLhandleARB;
  43.   function PGetError(ErrorNr:Integer):String;
  44.  
  45.   procedure AddError(ErrorCode:TShaderErrors; ErrorString:String);
  46. public
  47.   OnInternError:TOnInternError;
  48.   property ShaderHandle:GLhandleARB read PGetShaderHandle;
  49.   property Errors [Nr:Integer]: String read PGetError;
  50.  
  51.   constructor Create(VertexFile,FragmentFile:String); overload;
  52.   constructor Create(VertexCode,FragmentCode:TStringList); overload;
  53.   constructor Create(); overload;
  54.   procedure SetShaderCode(VertexFile,FragmentFile:String); overload;
  55.   procedure SetShaderCode(VertexCode,FragmentCode:TStringList); overload;
  56.   procedure CreateShader();
  57.   procedure UseShader();
  58.   destructor Destroy(SetOtherShader:Integer);
  59.  
  60.   function GetAllErrors():String;
  61.   function GetLastError():String;
  62. end;
  63.  
  64. TShaderList=class
  65. private
  66.   PShader:TList;
  67.   function FGetShaderCount():Integer;
  68.   function FGetShader(Item:Integer):TShader;
  69. public
  70.   property ShaderCount:Integer read FGetShaderCount;
  71.   property Shader [ShaderNr:Integer]: TShader read FGetShader;
  72.  
  73.   constructor Create();
  74.   destructor Destroy(); override;
  75.   function CreateShader(VertexFile,FragmentFile:String):Integer;
  76.   procedure DeleteShader(Item:Integer);
  77.   procedure UseShader(Item:Integer);
  78. end;
  79.  
  80. implementation
  81.  
  82. constructor TShader.Create();
  83. begin
  84. UseStep:=0;
  85. PVertexCode:=TStringList.Create();
  86. PFragmentCode:=TStringList.Create();
  87. InternErrors:=TStringList.Create();
  88. end;
  89.  
  90. constructor TShader.Create(VertexFile,FragmentFile:String);
  91. begin
  92. UseStep:=0;
  93. PVertexCode:=TStringList.Create();
  94. PFragmentCode:=TStringList.Create();
  95. InternErrors:=TStringList.Create();
  96.  
  97. SetShaderCode(VertexFile,FragmentFile);
  98.  
  99. CreateShader();
  100. end;
  101.  
  102.  
  103. constructor TShader.Create(VertexCode,FragmentCode:TStringList);
  104. var
  105.    ErrStr:String;
  106. begin
  107. UseStep:=0;
  108. PVertexCode:=TStringList.Create();
  109. PFragmentCode:=TStringList.Create();
  110. InternErrors:=TStringList.Create();
  111.  
  112. SetShaderCode(VertexCode,FragmentCode);
  113.  
  114. CreateShader();
  115.  
  116. UseShader();
  117. end;
  118.  
  119.  
  120. procedure TShader.SetShaderCode(VertexFile,FragmentFile:String);
  121. begin
  122. UseStep:=1;
  123. PVertexCode.Text:='';
  124. PFragmentCode.Text:='';
  125.  
  126. if FileExists(VertexFile) then
  127.    PVertexCode.LoadFromFile(VertexFile)
  128. else
  129.    begin
  130.    AddError([GL_NO_CODE_LOADED,GL_VERTEX_ERROR],'Error: Die Datei "'+VertexFile+'" existiert nicht');
  131.    UseStep:=0;
  132.    end;
  133.  
  134. if FileExists(FragmentFile) then
  135.    PFragmentCode.LoadFromFile(FragmentFile)
  136. else
  137.    begin
  138.    AddError([GL_NO_CODE_LOADED,GL_FRAGMENT_ERROR],'Error: Die Datei "'+FragmentFile+'" existiert nicht');
  139.    UseStep:=0;
  140.    end;
  141. end;
  142.  
  143.  
  144. procedure TShader.SetShaderCode(VertexCode,FragmentCode:TStringList);
  145. begin
  146. PVertexCode.Text:='';
  147. PFragmentCode.Text:='';
  148.  
  149. PVertexCode.Add(VertexCode.Text);
  150. PFragmentCode.Add(FragmentCode.Text);
  151. UseStep:=1;
  152. end;
  153.  
  154.  
  155. function TShader.glSlang_GetProgramInfoLog(PProgram : GLHandle) : String;
  156. var
  157.  blen,slen : GLInt;
  158.  InfoLog   : PGLCharARB;
  159. begin
  160. Result:='';
  161. glGetProgramiv(PProgram, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
  162.  
  163. if blen > 1 then
  164.    begin
  165.    GetMem(InfoLog, blen*SizeOf(GLCharARB));
  166.    glGetProgramInfoLog(PProgram,blen,slen,InfoLog);
  167.    Result := PChar(InfoLog);
  168.    Dispose(InfoLog);
  169.    end;
  170. end;
  171.  
  172. function TShader.glSlang_GetShaderInfoLog(PShader:GlHandle):String;
  173. var
  174.  blen,slen : GLInt;
  175.  InfoLog   : PGLCharARB;
  176.  LStatus: Integer;
  177. begin
  178. Result:='';
  179. glGetShaderiv(PShader, GL_COMPILE_STATUS, @LStatus);
  180. if LStatus=GL_FALSE then
  181.    begin
  182.    glGetObjectParameterivARB(PShader, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
  183.  
  184.    if blen > 1 then
  185.       begin
  186.       GetMem(InfoLog, blen*SizeOf(GLCharARB));
  187.       glGetShaderInfoLog(PShader,blen,slen,InfoLog);
  188.       Result := PChar(InfoLog);
  189.       Dispose(InfoLog);
  190.       end;
  191.    end;
  192. end;
  193.  
  194.  
  195. procedure TShader.CreateShader();
  196. var
  197.    tmpLen : Integer;
  198.    ErrStr:String;
  199.    VertexShaderObject   : GLhandleARB;
  200.    FragmentShaderObject : GLhandleARB;
  201.    VCode,FCode:String;
  202.  
  203.    LStatus:Integer;
  204.    blen,slen : GLInt;
  205.    InfoLog   : PGLCharARB;
  206. begin
  207. if UseStep=1 then
  208.    begin
  209.    UseStep:=2;
  210.    VCode:=PVertexCode.Text;
  211.    FCode:=PFragmentCode.Text;
  212.  
  213.    ProgramObject:=glCreateProgram;
  214.  
  215.    if Length(VCode) > 0 then
  216.       begin
  217.       tmpLen := Length(PVertexCode.Text);
  218.       VertexShaderObject := glCreateShader(GL_VERTEX_SHADER);
  219.       glShaderSource(VertexShaderObject,1,@VCode,@tmpLen);
  220.       glCompileShader(VertexShaderObject);
  221.       LStatus:=GL_TRUE;
  222.       glAttachShader(ProgramObject, VertexShaderObject);
  223.         Errstr:=GlSlang_GetShaderInfoLog(VertexShaderObject);
  224.         if ErrStr<>'' then
  225.            begin
  226.            AddError([GL_COMPILER_ERROR,GL_VERTEX_ERROR],'Error: Beim laden des Shaders trat folgendes Problem auf'+#13+#13+ErrStr);
  227.            UseStep:=1;
  228.            end;
  229.       glDeleteShader(VertexShaderObject);
  230.       end
  231.    else
  232.       begin
  233.       UseStep:=1;
  234.       AddError([GL_NO_CODE_FOUND,GL_VERTEX_ERROR],'No Vertexshadercode found');
  235.       end;
  236.  
  237.    if Length(FCode) > 0 then
  238.       begin
  239.       tmpLen := Length(FCode);
  240.       FragmentShaderObject := glCreateShader(GL_FRAGMENT_SHADER);
  241.       glShaderSource(FragmentShaderObject,1,@FCode,@tmpLen);
  242.       glCompileShader(FragmentShaderObject);
  243.       glAttachShader(ProgramObject, FragmentShaderObject);
  244.         ErrStr:=glSlang_GetShaderInfoLog(FragmentShaderObject);
  245.         if ErrStr<>'' then
  246.            begin
  247.            AddError([GL_COMPILER_ERROR,GL_FRAGMENT_ERROR],'Error: Beim laden des Shaders trat folgendes Problem auf'+#13+#13+ErrStr);
  248.            UseStep:=1;
  249.            end;
  250.       glDeleteShader(FragmentShaderObject);
  251.       end
  252.    else
  253.       begin
  254.       UseStep:=1;
  255.       AddError([GL_NO_CODE_FOUND,GL_FRAGMENT_ERROR],'No Fragmentshadercode found');
  256.       end;
  257.  
  258.    glLinkProgram(ProgramObject);
  259.    LStatus:=GL_TRUE;
  260.    glGetProgramiv(ProgramObject, GL_LINK_STATUS, @LStatus);
  261.  
  262.    if LStatus<>GL_TRUE then
  263.       begin
  264.       glGetProgramiv(ProgramObject, GL_OBJECT_INFO_LOG_LENGTH_ARB , @blen);
  265.       if blen > 1 then
  266.          begin
  267.          GetMem(InfoLog, blen*SizeOf(GLCharARB));
  268.          glGetProgramInfoLog(ProgramObject, blen, slen, InfoLog);
  269.          AddError([GL_LINKER_ERROR],'Error: Beim Linken des Shaders trat folgendes Problem auf'+#13+#13+PChar(InfoLog));
  270.          Dispose(InfoLog);
  271.          end;
  272.       end;
  273.  
  274.  
  275.    ErrStr:=glSlang_GetProgramInfoLog(ProgramObject);
  276.    if ErrStr='' then
  277.       glUseProgramObjectARB(ProgramObject)
  278.    else          
  279.       begin
  280.       UseStep:=1;
  281.       end;
  282.    end;
  283. end;
  284.  
  285.  
  286. procedure TShader.UseShader();
  287. begin
  288. if UseStep=2 then
  289.    glUseProgramObjectARB(ProgramObject)
  290. else
  291.    begin
  292.    glUseProgramObjectARB(0);
  293.    AddError([GL_SHADER_ISNT_READY_TO_USE],'Der Shader ist nicht bereit');
  294.    end;
  295. end;
  296.  
  297. function TShader.GetAllErrors():String;
  298. var
  299.    i:Integer;
  300. begin
  301. Result:='';
  302. for i:=1 to InternErrors.Count-1 do
  303.     Result:=Result+Inttostr(i)+': '+InternErrors.Strings[i]+' | ';
  304. end;
  305.  
  306. function TShader.GetLastError():String;
  307. begin
  308. if InternErrors.Count<>0 then
  309.    Result:=InternErrors.Strings[InternErrors.Count-1]
  310. else
  311.    Result:='No Error';
  312. end;
  313.  
  314. function TShader.PGetError(ErrorNr:Integer):String;
  315. begin
  316. result:='No Error';
  317. if (InternErrors.Count>ErrorNr) and (0<=ErrorNr) then
  318.    Result:=InternErrors.Strings[ErrorNr]
  319. else
  320.    Result:='Error existiert nicht';
  321. end;
  322.  
  323. function TShader.PGetShaderHandle():GLhandleARB;
  324. begin
  325. Result:=ProgramObject;
  326. end;
  327.  
  328. destructor TShader.Destroy(SetOtherShader:Integer);
  329. begin
  330. inherited Destroy();
  331.  
  332. PVertexCode.Free();
  333. PFragmentCode.Free();
  334. InternErrors.Free();
  335.  
  336. glDeleteProgram(ProgramObject);
  337.  
  338. if SetOtherShader<>-1 then
  339.    glUseProgramObjectARB(SetOtherShader)
  340. else
  341.    glUseProgramObjectARB(0);
  342. end;
  343.  
  344. procedure TShader.AddError(ErrorCode:TShaderErrors; ErrorString:String);
  345. begin
  346. if (GetLastError()<>'Der Shader ist nicht bereit') and
  347.    (ErrorString   <>'Der Shader ist nicht bereit') then
  348.    begin
  349.    if InternErrors.Count-1=5 then
  350.       InternErrors.Delete(1);
  351.  
  352.    InternErrors.Add(ErrorString);
  353.  
  354.    if Assigned(OnInternError) then
  355.       OnInternError(Self,ErrorCode,GetLastError());
  356.  
  357.    ShowMessage(GetLastError());
  358.    end;
  359. end;
  360.  
  361.  
  362. constructor TShaderList.Create();
  363. begin
  364. PShader:=TList.Create();
  365. end;
  366.  
  367. destructor TShaderList.Destroy();
  368. var
  369.    i:Integer;
  370. begin
  371. inherited Destroy();
  372.  
  373. for i:=0 to PShader.Count-1 do
  374.     TShader(PShader.Items[i]).Destroy(-1);
  375.  
  376. PShader.Free();
  377. end;
  378.  
  379.  
  380. function TShaderList.CreateShader(VertexFile,FragmentFile:String):Integer;
  381. var
  382.    NewShader:TShader;
  383. begin
  384. NewShader:=TShader.Create(VertexFile,FragmentFile);
  385. PShader.Add(NewShader);
  386.  
  387. result:=PShader.Count;
  388. end;
  389.  
  390.  
  391. procedure TShaderList.DeleteShader(Item:Integer);
  392. begin
  393. TShader(PShader.Items[Item]).Destroy(-1);
  394. PShader.Delete(Item);
  395. end;
  396.  
  397.  
  398. function TShaderList.FGetShader(Item:Integer):TShader;
  399. begin
  400. if (PShader.Count>Item) and (0<=Item) then
  401.    Result:=TShader(PShader.Items[Item])
  402. else
  403.    Result:=nil;
  404. end;
  405.  
  406.  
  407. procedure TShaderList.UseShader(Item:Integer);
  408. begin
  409. TShader(PShader.Items[Item]).UseShader();
  410. end;
  411.  
  412. function TShaderList.FGetShaderCount():Integer;
  413. begin
  414. Result:=PShader.Count;
  415. end;
  416.  
  417. end.
  418.  
  419.  
Autor:  Lord Horazont [ Mi Jul 08, 2009 13:44 ]
Betreff des Beitrags: 
Um verwirrung zu vermeiden, solltest du deine Konstenten nicht mit GL_ beginnen lassen.

greetings
Seite 1 von 2 Alle Zeiten sind UTC + 1 Stunde
Powered by phpBB® Forum Software © phpBB Group
https://www.phpbb.com/