Files |  Tutorials |  Articles |  Links |  Home |  Team |  Forum |  Wiki |  Impressum

Aktuelle Zeit: So Mär 07, 2021 10:11

Foren-Übersicht » English » English Programming Forum
Unbeantwortete Themen | Aktive Themen



Ein neues Thema erstellen Auf das Thema antworten  [ 2 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: glDelete causing White Textures
BeitragVerfasst: Mi Jan 11, 2012 10:34 
Offline
DGL Member
Benutzeravatar

Registriert: Mi Jul 21, 2004 22:39
Beiträge: 360
Wohnort: UK, Scotland
Below is my texture unit. When glDeleteTexture() is left un-commented i get white textures when some textures are re-loaded. Any ideas why?

Note: glDeleteTexture() is only being called once per texture, so its nothing to do with TTexture.Free being called more than FCount's Value.

Code:
  1. unit TextureUnit;
  2.  
  3. interface
  4.  
  5. uses Windows, Classes;
  6.  
  7. type
  8. TTexture = Class(TObject)
  9. private
  10.  FFilename : String;
  11.  FCount : Integer;
  12.  FTexture : Cardinal;
  13.  FWidth,FHeight : Integer;
  14.  FBPP           : Byte;
  15.  FFormat        : Cardinal;
  16.  FUseMipmaps,
  17.  FUseNearest    : Boolean;
  18. public
  19.  constructor Create(Filename : String);
  20.  procedure Free;
  21.  procedure Inc; //DO NOT CALL!
  22.  // $0DE1 is GL_TEXTURE_2D
  23.  procedure BindTexture(Target : Cardinal = $0DE1; Texture : Cardinal = Cardinal(-1));
  24.  
  25.  procedure UpdateTexture(Width,Height : Integer; BPP : Byte; Format,InternalFormat : Cardinal; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401); overload;
  26.  procedure UpdateTexture(Width,Height : Integer; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401); overload;
  27.  procedure UpdateTexture(Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401); overload;
  28.  property UseMipmaps : Boolean read FUseMipmaps write FUseMipmaps;
  29.  property UseNearest : Boolean read FUseNearest write FUseNearest;
  30.  property Filename : String read FFilename;
  31. end;
  32.  
  33. TTextureManager = Class(TObject)
  34. private
  35.  FTextures    : TList;
  36.  FLastTexture : Cardinal;
  37.  function GetTextureCount : Integer;
  38.  function GetTextureInt(Index : Integer) : TTexture;
  39. public
  40.  constructor Create;
  41.  destructor Destroy; override;
  42.  function GetTexture(Filename : String) : TTexture;
  43.  function LoadTextureFromFile(Filename : String) : TTexture;
  44.  function LoadTextureFromStream(Stream : TStream; Filename : String) : TTexture;
  45.  procedure RemoveTexture(Texture : TTexture);
  46.  property LastTexture : Cardinal read FLastTexture write FLastTexture;
  47.  property TextureCount : Integer read GetTextureCount;
  48.  property Texture[Index : Integer] : TTexture read GetTextureInt;
  49. end;
  50.  
  51. var
  52.  TextureManager : TTextureManager = Nil;
  53.  
  54. implementation
  55.  
  56. uses SysUtils, FreeBitmap, dglOpenGL;
  57.  
  58. constructor TTextureManager.Create;
  59. begin
  60.  FTextures    := TList.Create;
  61.  FLastTexture := 0;
  62. end;
  63.  
  64. destructor TTextureManager.Destroy;
  65. begin
  66.  FTextures.Free;
  67.  inherited;
  68. end;
  69.  
  70. function TTextureManager.GetTexture(Filename : String) : TTexture;
  71. var
  72.  X : Integer;
  73. begin
  74.  if FTextures.Count > 0 then
  75.  for X := 0 to FTextures.Count-1 do
  76.  begin
  77.   Result := FTextures[X];
  78.   if not Assigned(Result) then Continue;
  79.   if Lowercase(Result.Filename) = Lowercase(Filename) then Exit;
  80.  end;
  81.  Result := Nil;
  82. end;
  83.  
  84. function TTextureManager.LoadTextureFromFile(Filename : String) : TTexture;
  85. var
  86.  Stream : TStream;
  87. begin
  88.  Stream := TFileStream.Create(Filename,fmOpenRead);
  89.   Result := LoadTextureFromStream(Stream,Filename);
  90.  Stream.Free;
  91. end;
  92.  
  93. procedure Convert8BitTransparentImage(FBI : TFreeBitmap);
  94. var
  95.  Palette : TRGBQuad;
  96.  Pixels  : PRGBQuad;
  97.  C,PC    : Integer;
  98. begin
  99.  Palette := TRGBQuad(FBI.GetPalette^);
  100.  
  101.  FBI.ConvertTo32Bits;
  102.  
  103.  Pixels := Pointer(FBI.AccessPixels);
  104.  
  105.  PC := FBI.GetWidth*FBI.GetHeight;
  106.  
  107.  for C := 1 to PC do
  108.  begin
  109.   if (Pixels.rgbRed = Palette.rgbRed) and (Pixels.rgbGreen = Palette.rgbGreen) and (Pixels.rgbBlue = Palette.rgbBlue) then
  110.   Pixels.rgbReserved := 0
  111.   else
  112.   Pixels.rgbReserved := 255;
  113.  
  114.   if C < PC then
  115.   Inc(Cardinal(Pixels),4);
  116.  end;
  117. end;
  118.  
  119. procedure LoadTexture(Texture : TTexture; FBI : TFreeBitmap; UseMipMaps : Boolean = True; UseNearest : Boolean = False);
  120. var
  121.  BPP : Integer;
  122. begin
  123.  Texture.UseMipmaps := UseMipMaps;
  124.  Texture.UseNearest := UseNearest;
  125.  
  126.  BPP := FBI.GetBitsPerPixel div 8;
  127.  
  128.  if (BPP = 1) and (FBI.IsTransparent) and (FBI.GetPaletteSize > 0) then
  129.  Convert8BitTransparentImage(FBI)
  130.  else
  131.  if (BPP <> 3) and (BPP <> 4) then
  132.  if FBI.IsTransparent then
  133.   FBI.ConvertTo32Bits
  134.  else
  135.   FBI.ConvertTo24Bits;
  136.  
  137.  BPP := FBI.GetBitsPerPixel div 8;
  138.  
  139.  //Fill the Texture up.
  140.  // Warning: If the BitsPerPixel/8 are not 3 or 4 then there will be problems.
  141.  if BPP = 3 then
  142.  Texture.UpdateTexture(FBI.GetWidth,FBI.GetHeight,3,GL_BGR, GL_RGB,FBI.AccessPixels)
  143.  else
  144.  if BPP = 4 then
  145.  Texture.UpdateTexture(FBI.GetWidth,FBI.GetHeight,4,GL_BGRA, GL_RGBA,FBI.AccessPixels)
  146.  else
  147.  (*LogError(IntToStr(BPP) + ' BPP Invalid: <' + Name + '>')*);
  148. end;
  149.  
  150. function TTextureManager.LoadTextureFromStream(Stream : TStream; Filename : String) : TTexture;
  151. var
  152.  FBI : TFreeBitmap;
  153. begin
  154.   Result := GetTexture(Filename);
  155.   if Assigned(Result) then
  156.   begin
  157.    Result.Inc;
  158.    Exit;
  159.   end;
  160.  
  161.   FBI := TFreeBitmap.Create();
  162.   FBI.LoadFromStream(Stream);
  163.    Result := TTexture.Create(Filename);
  164.    LoadTexture(Result,FBI);
  165.   FBI.Free;
  166.  
  167.   FTextures.Add(Result);
  168. end;
  169.  
  170. procedure TTextureManager.RemoveTexture(Texture : TTexture);
  171. var
  172.  Index : Integer;
  173. begin
  174.  Index := FTextures.IndexOf(Texture);
  175.  if Index = -1 then Exit;
  176.  FTextures.Delete(Index);
  177. end;
  178.  
  179. function TTextureManager.GetTextureCount : Integer;
  180. begin
  181.  Result := FTextures.Count;
  182. end;
  183.  
  184. function TTextureManager.GetTextureInt(Index : Integer) : TTexture;
  185. begin
  186.  if (Index < 0) or (Index >= FTextures.Count) then
  187.  Result := Nil
  188.  else
  189.  Result := FTextures[Index];
  190. end;
  191.  
  192.  
  193.  
  194.  
  195. constructor TTexture.Create(Filename : String);
  196. begin
  197.  FFilename    := Filename;
  198.  FCount       := 1;
  199.  FTexture     := 0;
  200.  FWidth       := 0;
  201.  FHeight      := 0;
  202.  FBPP         := 0;
  203.  FFormat      := 0;
  204.  FUseMipmaps  := True;
  205.  FUseNearest  := False;
  206. end;
  207.  
  208. procedure TTexture.Free;
  209. begin
  210.  Dec(FCount);
  211.  if FCount < 1 then
  212.  begin
  213.   if FTexture > 0 then
  214.   glDeleteTextures(1,@FTexture);
  215.  
  216.   TextureManager.RemoveTexture(Self);
  217.   Inherited;
  218.  end;
  219. end;
  220.  
  221. procedure TTexture.Inc;
  222. begin
  223.  System.Inc(FCount);
  224. end;
  225.  
  226. procedure TTexture.BindTexture(Target : Cardinal = $0DE1; Texture : Cardinal = Cardinal(-1));
  227. begin
  228.  if Texture = Cardinal(-1) then
  229.  Texture := FTexture;
  230.  
  231.  if TextureManager.LastTexture = Texture then Exit;
  232.  
  233.  glBindTexture(Target,Texture);
  234.  
  235.  TextureManager.LastTexture := Texture;
  236. end;
  237.  
  238. procedure CheckForGLError;
  239. var
  240.  Err : TGLenum;
  241. begin
  242.  Err := glGetError;
  243.  if Err <> GL_NO_ERROR then
  244.  MessageBox(0,PChar('OGL ERROR: ' + IntToStr(Err)),'Error',0);
  245. end;
  246.  
  247. procedure TTexture.UpdateTexture(Width,Height : Integer; BPP : Byte; Format,InternalFormat : Cardinal; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401);
  248. begin
  249.  FBPP            := BPP;
  250.  FFormat         := InternalFormat;
  251.  
  252.   if FTexture = 0 then
  253.   begin
  254.    glGenTextures(1, @FTexture);
  255.   end;
  256.   CheckForGLError;
  257.   BindTexture(Target);
  258.  
  259.   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
  260.   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
  261.  
  262.   if FUseNearest then
  263.   glTexParameteri(Target,GL_TEXTURE_MAG_FILTER, GL_NEAREST)
  264.   else
  265.   glTexParameteri(Target,GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  266.  
  267.   if FUseMipmaps then
  268.   begin
  269.    if FUseNearest then
  270.     glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST_MIPMAP_LINEAR)
  271.    else
  272.     glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
  273.  
  274.     gluBuild2DMipmaps(Target, BPP, Width, Height, Format, DataType, Data);
  275.   end
  276.  else
  277.   begin
  278.    if FUseNearest then
  279.     glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST)
  280.    else
  281.     glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  282.   end;
  283.  
  284.   if (not FUseMipmaps) then
  285.   glTexImage2D(Target,0,InternalFormat,Width,Height,0,Format,DataType,Data);
  286.  
  287.   CheckForGLError;
  288.  
  289.  BindTexture(Target,0);
  290.  
  291.  FWidth          := Width;
  292.  FHeight         := Height;
  293. end;
  294.  
  295. procedure TTexture.UpdateTexture(Width,Height : Integer; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401);
  296. begin
  297.  if (FFormat = 0) or (FBPP = 0) then exit;
  298.  UpdateTexture(Width, Height, FBPP, FFormat, FFormat, Data, Target, DataType);
  299. end;
  300.  
  301. procedure TTexture.UpdateTexture(Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401);
  302. begin
  303.  if (FFormat = 0) or (FBPP = 0) or (FWidth = 0) or (FHeight = 0) then exit;
  304.  UpdateTexture(FWidth, FHeight, FBPP, FFormat, FFormat, Data, Target, DataType);
  305. end;
  306.  
  307.  
  308. end.

_________________
Free Map Editor - Game Requirements - Stucuk.Net
-Stu


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: glDelete causing White Textures
BeitragVerfasst: Mi Jan 11, 2012 12:43 
Offline
DGL Member
Benutzeravatar

Registriert: Mi Jul 21, 2004 22:39
Beiträge: 360
Wohnort: UK, Scotland
Found the problem. Calling glDeleteTexture and then glGenTexture without a new frame in between (Not looked deeper to see exactly what it wants) causes a white texture(If the TextureID glGenTexture picks was just free'd by glDeleteTexture). If there is a frame between the deletetexture and gentexture then it works right.... Wonder if its a driver bug.

I assume what is happening is that glDeleteTexture only free's the ID but not the Data when its called and that when a new frame happens it free's the data (Which has just been re-assigned).

_________________
Free Map Editor - Game Requirements - Stucuk.Net
-Stu


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 2 Beiträge ] 
Foren-Übersicht » English » English Programming Forum


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 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.

Suche nach:
Gehe zu:  
cron
  Powered by phpBB® Forum Software © phpBB Group
Deutsche Übersetzung durch phpBB.de
[ Time : 0.057s | 15 Queries | GZIP : On ]