mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 23:30:30 +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
|
with ih do
|
||||||
begin
|
begin
|
||||||
FTypeName := ATypeName;
|
FTypeName := ATypeName;
|
||||||
FExtention := TheExtentions;
|
FExtention := lowercase(TheExtentions);
|
||||||
FDefaultExt := CalcDefExt (TheExtentions);
|
FDefaultExt := CalcDefExt (TheExtentions);
|
||||||
FReader := AReader;
|
FReader := AReader;
|
||||||
FWriter := AWriter;
|
FWriter := AWriter;
|
||||||
@ -77,7 +77,7 @@ begin
|
|||||||
with ih do
|
with ih do
|
||||||
begin
|
begin
|
||||||
FTypeName := ATypeName;
|
FTypeName := ATypeName;
|
||||||
FExtention := TheExtentions;
|
FExtention := Lowercase(TheExtentions);
|
||||||
FDefaultExt := CalcDefExt (TheExtentions);
|
FDefaultExt := CalcDefExt (TheExtentions);
|
||||||
FReader := AReader;
|
FReader := AReader;
|
||||||
FWriter := nil;
|
FWriter := nil;
|
||||||
@ -104,7 +104,7 @@ begin
|
|||||||
with ih do
|
with ih do
|
||||||
begin
|
begin
|
||||||
FTypeName := ATypeName;
|
FTypeName := ATypeName;
|
||||||
FExtention := TheExtentions;
|
FExtention := lowercase(TheExtentions);
|
||||||
FDefaultExt := CalcDefExt (TheExtentions);
|
FDefaultExt := CalcDefExt (TheExtentions);
|
||||||
FReader := nil;
|
FReader := nil;
|
||||||
FWriter := AWriter;
|
FWriter := AWriter;
|
||||||
@ -131,6 +131,14 @@ begin
|
|||||||
result := nil;
|
result := nil;
|
||||||
end;
|
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;
|
function TImageHandlersManager.GetTypeName (index:integer) : string;
|
||||||
var ih : TIHData;
|
var ih : TIHData;
|
||||||
begin
|
begin
|
||||||
@ -216,6 +224,8 @@ begin
|
|||||||
else
|
else
|
||||||
result := Img;
|
result := Img;
|
||||||
FImage := result;
|
FImage := result;
|
||||||
|
if FImage.UsePalette then
|
||||||
|
FImage.Palette.Clear;
|
||||||
if CheckContents (Str) then
|
if CheckContents (Str) then
|
||||||
begin
|
begin
|
||||||
InternalRead (Str, result)
|
InternalRead (Str, result)
|
||||||
|
@ -39,10 +39,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TFPCustomImage.LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
|
procedure TFPCustomImage.LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
|
||||||
|
var
|
||||||
var
|
|
||||||
fs : TStream;
|
fs : TStream;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if FileExists (filename) then
|
if FileExists (filename) then
|
||||||
begin
|
begin
|
||||||
@ -63,10 +61,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TFPCustomImage.SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
procedure TFPCustomImage.SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
||||||
|
var
|
||||||
var
|
|
||||||
fs : TStream;
|
fs : TStream;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
fs := TFileStream.Create (filename, fmCreate);
|
fs := TFileStream.Create (filename, fmCreate);
|
||||||
try
|
try
|
||||||
@ -76,6 +72,105 @@ begin
|
|||||||
end
|
end
|
||||||
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);
|
procedure TFPCustomImage.SetHeight (Value : integer);
|
||||||
begin
|
begin
|
||||||
if Value <> FHeight then
|
if Value <> FHeight then
|
||||||
|
@ -83,6 +83,7 @@ type
|
|||||||
procedure Merge (pal : TFPPalette); virtual;
|
procedure Merge (pal : TFPPalette); virtual;
|
||||||
function IndexOf (const AColor: TFPColor) : integer; virtual;
|
function IndexOf (const AColor: TFPColor) : integer; virtual;
|
||||||
function Add (const Value: TFPColor) : integer; virtual;
|
function Add (const Value: TFPColor) : integer; virtual;
|
||||||
|
procedure Clear; virtual;
|
||||||
property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
|
property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
|
||||||
property Count : integer read GetCount write SetCount;
|
property Count : integer read GetCount write SetCount;
|
||||||
end;
|
end;
|
||||||
@ -124,7 +125,9 @@ type
|
|||||||
procedure Assign(Source: TPersistent); override;
|
procedure Assign(Source: TPersistent); override;
|
||||||
// Saving and loading
|
// Saving and loading
|
||||||
procedure LoadFromStream (Str:TStream; Handler:TFPCustomImageReader);
|
procedure LoadFromStream (Str:TStream; Handler:TFPCustomImageReader);
|
||||||
|
procedure LoadFromStream (Str:TStream);
|
||||||
procedure LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
|
procedure LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
|
||||||
|
procedure LoadFromFile (const filename:String);
|
||||||
procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
|
procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
|
||||||
procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
|
||||||
// Size and data
|
// Size and data
|
||||||
@ -229,6 +232,7 @@ type
|
|||||||
function GetDefExt (const TypeName:string) : string;
|
function GetDefExt (const TypeName:string) : string;
|
||||||
function GetTypeName (index:integer) : string;
|
function GetTypeName (index:integer) : string;
|
||||||
function GetData (const ATypeName:string) : TIHData;
|
function GetData (const ATypeName:string) : TIHData;
|
||||||
|
function GetData (index : integer) : TIHData;
|
||||||
function GetCount : integer;
|
function GetCount : integer;
|
||||||
public
|
public
|
||||||
constructor Create;
|
constructor Create;
|
||||||
@ -279,6 +283,9 @@ type
|
|||||||
StrTypeAlreadyExist,
|
StrTypeAlreadyExist,
|
||||||
StrTypeReaderAlreadyExist,
|
StrTypeReaderAlreadyExist,
|
||||||
StrTypeWriterAlreadyExist,
|
StrTypeWriterAlreadyExist,
|
||||||
|
StrCantDetermineType,
|
||||||
|
StrNoCorrectReaderFound,
|
||||||
|
StrReadWithError,
|
||||||
StrNoPaletteAvailable
|
StrNoPaletteAvailable
|
||||||
);
|
);
|
||||||
|
|
||||||
@ -296,6 +303,9 @@ const
|
|||||||
'Image type "%s" already exists',
|
'Image type "%s" already exists',
|
||||||
'Image type "%s" already has a reader class',
|
'Image type "%s" already has a reader class',
|
||||||
'Image type "%s" already has a writer 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'
|
'No palette available'
|
||||||
);
|
);
|
||||||
|
|
||||||
@ -313,9 +323,9 @@ begin
|
|||||||
raise FPImageException.Create (ErrorText[Fmt]);
|
raise FPImageException.Create (ErrorText[Fmt]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$i FPPalette.inc}
|
|
||||||
{$i FPHandler.inc}
|
|
||||||
{$i FPImage.inc}
|
{$i FPImage.inc}
|
||||||
|
{$i FPHandler.inc}
|
||||||
|
{$i FPPalette.inc}
|
||||||
{$i FPColCnv.inc}
|
{$i FPColCnv.inc}
|
||||||
|
|
||||||
function FPColor (r,g,b,a:word) : TFPColor;
|
function FPColor (r,g,b,a:word) : TFPColor;
|
||||||
|
@ -145,3 +145,7 @@ begin
|
|||||||
result := Add (AColor);
|
result := Add (AColor);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TFPPalette.Clear;
|
||||||
|
begin
|
||||||
|
SetCount (0);
|
||||||
|
end;
|
||||||
|
Loading…
Reference in New Issue
Block a user