mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 01:09:27 +02:00
* clearing palette (if used) before reading image
* determining which handler to use for reading image
This commit is contained in:
parent
580bd29c50
commit
0b9255933d
@ -51,7 +51,7 @@ begin
|
||||
with ih do
|
||||
begin
|
||||
FTypeName := ATypeName;
|
||||
FExtention := TheExtentions;
|
||||
FExtention := lowercase(TheExtentions);
|
||||
FDefaultExt := CalcDefExt (TheExtentions);
|
||||
FReader := AReader;
|
||||
FWriter := AWriter;
|
||||
@ -77,7 +77,7 @@ begin
|
||||
with ih do
|
||||
begin
|
||||
FTypeName := ATypeName;
|
||||
FExtention := TheExtentions;
|
||||
FExtention := Lowercase(TheExtentions);
|
||||
FDefaultExt := CalcDefExt (TheExtentions);
|
||||
FReader := AReader;
|
||||
FWriter := nil;
|
||||
@ -104,7 +104,7 @@ begin
|
||||
with ih do
|
||||
begin
|
||||
FTypeName := ATypeName;
|
||||
FExtention := TheExtentions;
|
||||
FExtention := lowercase(TheExtentions);
|
||||
FDefaultExt := CalcDefExt (TheExtentions);
|
||||
FReader := nil;
|
||||
FWriter := AWriter;
|
||||
@ -131,6 +131,14 @@ begin
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function TImageHandlersManager.GetData (index:integer) : TIHData;
|
||||
begin
|
||||
if (index >= 0) and (index < FData.count) then
|
||||
result := TIHData (FData[index])
|
||||
else
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function TImageHandlersManager.GetTypeName (index:integer) : string;
|
||||
var ih : TIHData;
|
||||
begin
|
||||
@ -216,6 +224,8 @@ begin
|
||||
else
|
||||
result := Img;
|
||||
FImage := result;
|
||||
if FImage.UsePalette then
|
||||
FImage.Palette.Clear;
|
||||
if CheckContents (Str) then
|
||||
begin
|
||||
InternalRead (Str, result)
|
||||
|
@ -39,10 +39,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TFPCustomImage.LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
|
||||
|
||||
var
|
||||
var
|
||||
fs : TStream;
|
||||
|
||||
begin
|
||||
if FileExists (filename) then
|
||||
begin
|
||||
@ -63,10 +61,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TFPCustomImage.SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
||||
|
||||
var
|
||||
var
|
||||
fs : TStream;
|
||||
|
||||
begin
|
||||
fs := TFileStream.Create (filename, fmCreate);
|
||||
try
|
||||
@ -76,6 +72,105 @@ begin
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TFPCustomImage.LoadFromStream (Str:TStream);
|
||||
var r : integer;
|
||||
h : TFPCustomImageReaderClass;
|
||||
reader : TFPCustomImageReader;
|
||||
msg : string;
|
||||
d : TIHData;
|
||||
begin
|
||||
with ImageHandlers do
|
||||
try
|
||||
r := count-1;
|
||||
while (r >= 0) do
|
||||
begin
|
||||
d := GetData(r);
|
||||
if assigned (d) then
|
||||
h := d.FReader;
|
||||
if assigned (h) then
|
||||
begin
|
||||
reader := h.Create;
|
||||
with reader do
|
||||
try
|
||||
if CheckContents (str) then
|
||||
try
|
||||
FStream := str;
|
||||
FImage := self;
|
||||
InternalRead (str, self);
|
||||
break;
|
||||
except
|
||||
on e : exception do
|
||||
msg := e.message;
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
str.seek (soFromBeginning, 0);
|
||||
end;
|
||||
end;
|
||||
dec (r);
|
||||
end;
|
||||
except
|
||||
on e : exception do
|
||||
FPImgError (StrCantDetermineType, [e.message]);
|
||||
end;
|
||||
if r < 0 then
|
||||
if msg = '' then
|
||||
FPImgError (StrNoCorrectReaderFound)
|
||||
else
|
||||
FPImgError (StrReadWithError, [Msg]);
|
||||
end;
|
||||
|
||||
procedure TFPCustomImage.LoadFromFile (const filename:String);
|
||||
var e,s : string;
|
||||
r : integer;
|
||||
f : TFileStream;
|
||||
h : TFPCustomImageReaderClass;
|
||||
reader : TFPCustomImageReader;
|
||||
d : TIHData;
|
||||
Msg : string;
|
||||
begin
|
||||
e := lowercase (ExtractFileExt(filename));
|
||||
if (e <> '') and (e[1] = '.') then
|
||||
delete (e,1,1);
|
||||
with ImageHandlers do
|
||||
begin
|
||||
r := count-1;
|
||||
s := e + ';';
|
||||
while (r >= 0) do
|
||||
begin
|
||||
d := GetData(r);
|
||||
if (pos(s,d.Fextention+';') <> 0) then
|
||||
try
|
||||
h := d.FReader;
|
||||
if assigned (h) then
|
||||
begin
|
||||
reader := h.Create;
|
||||
loadfromfile (filename, reader);
|
||||
break;
|
||||
end;
|
||||
except
|
||||
on e : exception do
|
||||
Msg := e.message;
|
||||
end;
|
||||
dec (r);
|
||||
end
|
||||
end;
|
||||
if Msg = '' then
|
||||
begin
|
||||
if r < 0 then
|
||||
begin
|
||||
f := TFileStream.Create (filename, fmOpenRead);
|
||||
try
|
||||
LoadFromStream (f);
|
||||
finally
|
||||
f.Free;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FPImgError (StrReadWithError, [Msg]);
|
||||
end;
|
||||
|
||||
procedure TFPCustomImage.SetHeight (Value : integer);
|
||||
begin
|
||||
if Value <> FHeight then
|
||||
|
@ -83,6 +83,7 @@ type
|
||||
procedure Merge (pal : TFPPalette); virtual;
|
||||
function IndexOf (const AColor: TFPColor) : integer; virtual;
|
||||
function Add (const Value: TFPColor) : integer; virtual;
|
||||
procedure Clear; virtual;
|
||||
property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
|
||||
property Count : integer read GetCount write SetCount;
|
||||
end;
|
||||
@ -124,7 +125,9 @@ type
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
// Saving and loading
|
||||
procedure LoadFromStream (Str:TStream; Handler:TFPCustomImageReader);
|
||||
procedure LoadFromStream (Str:TStream);
|
||||
procedure LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
|
||||
procedure LoadFromFile (const filename:String);
|
||||
procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
|
||||
procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
||||
// Size and data
|
||||
@ -229,6 +232,7 @@ type
|
||||
function GetDefExt (const TypeName:string) : string;
|
||||
function GetTypeName (index:integer) : string;
|
||||
function GetData (const ATypeName:string) : TIHData;
|
||||
function GetData (index : integer) : TIHData;
|
||||
function GetCount : integer;
|
||||
public
|
||||
constructor Create;
|
||||
@ -279,6 +283,9 @@ type
|
||||
StrTypeAlreadyExist,
|
||||
StrTypeReaderAlreadyExist,
|
||||
StrTypeWriterAlreadyExist,
|
||||
StrCantDetermineType,
|
||||
StrNoCorrectReaderFound,
|
||||
StrReadWithError,
|
||||
StrNoPaletteAvailable
|
||||
);
|
||||
|
||||
@ -296,6 +303,9 @@ const
|
||||
'Image type "%s" already exists',
|
||||
'Image type "%s" already has a reader class',
|
||||
'Image type "%s" already has a writer class',
|
||||
'Error while determining image type of stream: %s',
|
||||
'Can''t determine image type of stream',
|
||||
'Error while reading stream: %s',
|
||||
'No palette available'
|
||||
);
|
||||
|
||||
@ -313,9 +323,9 @@ begin
|
||||
raise FPImageException.Create (ErrorText[Fmt]);
|
||||
end;
|
||||
|
||||
{$i FPPalette.inc}
|
||||
{$i FPHandler.inc}
|
||||
{$i FPImage.inc}
|
||||
{$i FPHandler.inc}
|
||||
{$i FPPalette.inc}
|
||||
{$i FPColCnv.inc}
|
||||
|
||||
function FPColor (r,g,b,a:word) : TFPColor;
|
||||
|
@ -145,3 +145,7 @@ begin
|
||||
result := Add (AColor);
|
||||
end;
|
||||
|
||||
procedure TFPPalette.Clear;
|
||||
begin
|
||||
SetCount (0);
|
||||
end;
|
||||
|
Loading…
Reference in New Issue
Block a user