mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-31 10:50:14 +02:00
+ Overloaded SaveToFile with version that detects writer to use
This commit is contained in:
parent
e24eb1f631
commit
cdffc6e8b0
@ -72,6 +72,48 @@ begin
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TFPCustomImage.SaveToFile (const filename:String);
|
||||
|
||||
var e,s : string;
|
||||
r : integer;
|
||||
f : TFileStream;
|
||||
h : TFPCustomImageWriterClass;
|
||||
Writer : TFPCustomImageWriter;
|
||||
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.FWriter;
|
||||
if assigned (h) then
|
||||
begin
|
||||
Writer := h.Create;
|
||||
SaveTofile (filename, Writer);
|
||||
break;
|
||||
end;
|
||||
except
|
||||
on e : exception do
|
||||
Msg := e.message;
|
||||
end;
|
||||
dec (r);
|
||||
end
|
||||
end;
|
||||
if (Msg<>'') then
|
||||
FPImgError (StrWriteWithError, [Msg]);
|
||||
end;
|
||||
|
||||
|
||||
procedure TFPCustomImage.LoadFromStream (Str:TStream);
|
||||
var r : integer;
|
||||
h : TFPCustomImageReaderClass;
|
||||
|
@ -130,6 +130,7 @@ type
|
||||
procedure LoadFromFile (const filename:String);
|
||||
procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
|
||||
procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
||||
procedure SaveToFile (const filename:String);
|
||||
// Size and data
|
||||
procedure SetSize (AWidth, AHeight : integer); virtual;
|
||||
property Height : integer read FHeight write SetHeight;
|
||||
@ -291,6 +292,7 @@ type
|
||||
StrCantDetermineType,
|
||||
StrNoCorrectReaderFound,
|
||||
StrReadWithError,
|
||||
StrWriteWithError,
|
||||
StrNoPaletteAvailable
|
||||
);
|
||||
|
||||
@ -311,6 +313,7 @@ const
|
||||
'Error while determining image type of stream: %s',
|
||||
'Can''t determine image type of stream',
|
||||
'Error while reading stream: %s',
|
||||
'Error while writing stream: %s',
|
||||
'No palette available'
|
||||
);
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user