* clearing palette (if used) before reading image

* determining which handler to use for reading image
This commit is contained in:
luk 2003-10-16 21:56:45 +00:00
parent 580bd29c50
commit 0b9255933d
4 changed files with 130 additions and 11 deletions

View File

@ -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)

View File

@ -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

View File

@ -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;

View File

@ -145,3 +145,7 @@ begin
result := Add (AColor);
end;
procedure TFPPalette.Clear;
begin
SetCount (0);
end;