#34 PictureRegisteredFormats.pas AV with "Use debug DCUs" option

[Da Stranger]

Take a look at the attached file. When GLScene is
compiled with optimization turned off, this simple
example will crash. Tried turning optimization on for all
involved procedures with compiled directives, but it didn't
help, so I don't know how to fix this one.

[Da Stranger]

Optimization off bugg

[Lord Crc]

Logged In: YES
user_id=1617109

I cannot reproduce this on delphi 2006. I did a complete
"build all" between switching optimizations on/off.

Are you using a different delphi version?

[Da Stranger]

Logged In: YES
user_id=1586256

I'm using Delphi 7. If you confirm this bug I sugest you put a lines something like this:

{$IFDEF GLS_DELPHI_7}
{$IFOPT O-}
{$Message Error [[or Warn]] 'This may crash when compiled with optimization Off'}
{ENDIF}
{$ENDIF}

in procedure HackTPictureRegisteredFormats().

Don't forget to put {$I GLScene.inc} somewhere on top. I have a feeling that this concerns D6 to, so I would leave this warning for it too.

[Lord Crc]

Logged In: YES
user_id=1617109
Originator: NO

Wouldn't it be better to force optimization on for that block of code?

[Da Stranger]

Logged In: YES
user_id=1586256
Originator: YES

I tried that again today, it does not work. Looks like VCL is compiled differently with optimization On and Off. And procedure HackTPictureRegisteredFormats() hacks into VCL, and thus causing an access violation.

[Lord Crc]

Logged In: YES
user_id=1617109
Originator: NO

I do not have D7 installed anymore, would it be possible for you to try to determine the offsets? I still think it would be best to be compatible with debug mode. If not I'll dig up those D7 discs.

[Da Stranger]

Logged In: YES
user_id=1586256
Originator: YES

Well, I just don't know how to find those offsets. All those pointer operations are like black magic for me. For now, I've added a warning if Delphi version is below 7. Bug is still open.

[Da Stranger]

Logged In: YES
user_id=1586256
Originator: YES

I'm still having problems with this function even when optimization if On everywhere. This is so strange. A couple of month ago (in March 2007) a demo of mine worked fine. Now (August 2007) it fails because of this function. I'm still using Delphi 7...

[Da Stranger]

Logged In: YES
user_id=1586256
Originator: YES

Looks like I sound the source of the bug! It was the "Use debug DCUs" option on the Compiler options tab. And there IS a way to fix this, just need to find someone who knows something about those offsets...

[Johannes]

I dont know if this can help somebody, I changed this as followes for Lazarus to work regardless the compiler options. Seems to work

//=============== CODE START
procedure HackTPictureRegisteredFormats(destList: TStrings);
var
pRegisterFileFormat, pCallGetFileFormat, pGetFileFormats, pFileFormats: PAnsiChar;
iCall: Cardinal;
i: integer;
list: TList;
fileFormat: PFileFormat;
begin
// Warning: This will crash when Graphics.pas is compiled with the 'Use Debug DCUs' option.
{$ifdef FPC}

TPicture.RegisterFileFormat( fileFormat.Extension,fileFormat.Description,TGraphicClass(fileFormat.GraphicClass));
{$else}
{$ifndef FPC}
pRegisterFileFormat := PAnsiChar(@TPicture.RegisterFileFormat);
if pRegisterFileFormat[0] = #$FF then // in case of BPL redirector
pRegisterFileFormat := PAnsiChar(PCardinal(PCardinal(@pRegisterFileFormat[2])^)^);
pCallGetFileFormat := @pRegisterFileFormat[16];
iCall := PCardinal(pCallGetFileFormat)^;
pGetFileFormats := @pCallGetFileFormat[iCall + 4];
pFileFormats := PAnsiChar(PCardinal(@pGetFileFormats[2])^);
list := TList(PCardinal(pFileFormats)^);

if list <> nil then
begin
for i := 0 to list.Count - 1 do
begin
fileFormat := PFileFormat(list[i]);
destList.AddObject(fileFormat.Extension + '=' + fileFormat.Description,
TObject(fileFormat.GraphicClass));
end;
end;
{$endif}
{$endif}
end;

//============= CODE END

[Johannes]

Truly sorry about that, I realized why mine works (and what I did was incorrect). I changed my GraphicClassForExtension function to work better and thus I actually never got to this part.

Changed HackTPictureRegisteredFormats as follows :

//===== change from previous post ====
{$ifdef FPC}
// Warning: not suppose to get here at all.GraphicClassForExtension must handle this for you.
destList := nil;
{$else}
{$ifndef FPC}
//===============

and my GraphicClassForExtension looks like this for lazarus
where HackTPictureRegisteredFormats(sl); gets called I changed to

{$ifdef FPC}
result := TPicture.create.FindGraphicClassWithFileExt(buf,false);
{$else}
HackTPictureRegisteredFormats(sl);
i := sl.IndexOfName(buf);
if i >= 0 then
Result := TGraphicClass(sl.Objects[i]);
{$endif}

[YarUnderoaker]

Applied. Thanks.