Lord Satan wrote:
Hi,
as the subject says. I just realized that it does not work anymore (after
working flawlessly for years). The latest svn revision that works for me is
11800. Perhaps there are later revisions that work but some I could not compile
and others did not start and I got tired of just randomly trying revision
numbers and compile lazarus over and over. To me this looks like Marcs new
image code is responsible for my troubles.
As far as I can tell from the code you gave not. But the given code and
probelmdescription is a bit limited.
Btw I am using a TFPCustomImage descendant and the ImagesForLazarus package.
Here is the output of one of my programs trying to load an iamge:
and here is my code:
class defintion:
// Texture
TTextureFilter = (nearest, bilinear, trilinear);
{ TAsmTexture2D }
TAsmTexture2D = class(TFPCustomImage)
private
fAnisotropic: boolean;
fBound: boolean;
fFilterMode: TTextureFilter;
fMipMapped: boolean;
MagFilter: GLenum;
MinFilter: GLenum;
fSRepeat: boolean;
fTRepeat: boolean;
function GetPixel(x, y: integer): glubRGBColor;
procedure SetAnisotropic(const AValue: boolean);
procedure SetFilterMode(const AValue: TTextureFilter);
procedure SetInternalColor(x, y: integer;
const Value: TFPColor); override;
function GetInternalColor(
x, y: integer): TFPColor; override;
SWrapMode: GLenum;
TWrapMode: GLenum;
procedure SetMipMapped(const AValue: boolean);
procedure SetSRepeat(const AValue: boolean);
procedure SetTRepeat(const AValue: boolean);
procedure SetPixel(x, y: integer; const AValue: glubRGBColor);
procedure SetPixel(x, y: integer; red, green, blue: GLubyte);
// dummy procedures to avoid hints
procedure SetInternalPixel(x, y: integer; value: integer); override;
function GetInternalPixel(x, y: integer): integer; override;
public
Data: PGLubyte;
id: GLuint;
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
function LoadFromFile(Filename: string): boolean;
procedure SetSize(AWidth, AHeight: integer); override;
//
property Pixel[x, y: integer]: glubRGBColor read GetPixel write SetPixel;
//
property Anisotropic: boolean read fAnisotropic write SetAnisotropic;
property Bound: boolean read fBound;
property SRepeat: boolean read fSRepeat write SetSRepeat;
property TRepeat: boolean read fTRepeat write SetTRepeat;
property FilterMode: TTextureFilter read fFilterMode write SetFilterMode;
property MipMapped: boolean read fMipMapped write SetMipMapped;
procedure Bind;
procedure UpdateRegion(x, y, AWidth, AHeight: integer);
end;
Nothing wrong here unless you forget to call some inherited method.
loading code:
function TAsmTexture2D.LoadFromFile(Filename: string): boolean;
var
FileStream: TFileStream;
MemStream: TMemoryStream;
ReaderClass: TFPCustomImageReaderClass;
Reader: TFPCustomImageReader;
begin
// open file
try
ReaderClass:=GetFPImageReaderForFileExtension(ExtractFileExt(Filename));
FileStream:=TFileStream.Create(Filename, fmOpenRead);
except
ShowMessage('Error opening file');
Result:=false;
end;
MemStream:=nil;
try
// read file into mem
MemStream:=TMemoryStream.Create;
MemStream.CopyFrom(FileStream,FileStream.Size);
// convert stream to texture
MemStream.Position:=0;
if ReaderClass<>nil then begin
Reader:=ReaderClass.Create;
try
LoadFromStream(MemStream, Reader); << This fails
What error ? (*)
Result:=true;
except
Result:=false;
Free;
ShowMessage('Error reading file'); << because this I get in an endless
loop
This wonders me, why do you get here an endless loop ? Where is the loop ?
(*) thy using:
except
on E: exception do
begin
Result:=false;
Free;
ShowMessage('Error reading file: ' + E.Message);
end;
Marc
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
