lazarus/lcl/include/fpimagebitmap.inc

{%MainUnit ../graphics.pp}

{******************************************************************************
                              TFPImageBitmap
 ******************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{ TFPImageBitmap }

class function TFPImageBitmap.GetFileExtensions: string;
begin
  Result:='';
end;

class function TFPImageBitmap.IsStreamFormatSupported(Stream: TStream): Boolean;
var
  Pos: Int64;
  Reader: TFPCustomImageReader;
begin
  Pos := Stream.Position;
  Reader := GetReaderClass.Create;
  try
    Result := Reader.CheckContents(Stream);
  finally
    Reader.Free;
    Stream.Position := Pos;
  end;
end;

procedure TFPImageBitmap.FinalizeReader(AReader: TFPCustomImageReader);
begin
end;

procedure TFPImageBitmap.FinalizeWriter(AWriter: TFPCustomImageWriter);
var
  LazWriter: ILazImageWriter;
begin
  if Supports(AWriter, ILazImageWriter, LazWriter)
  then LazWriter.Finalize;
end;

function TFPImageBitmap.GetMimeType: string;
{$IFDEF VerboseLCLTodos}{$note implement}{$ENDIF}
var
  DefaultFileExt: String;
  i: Integer;
begin
  DefaultFileExt := GetFileExtensions;
  i := 1;
  while (i <= Length(DefaultFileExt)) and (DefaultFileExt[i] <> ';') do
    inc(i);
  if i <= Length(DefaultFileExt) then
    DefaultFileExt := copy(DefaultFileExt, 1, i - 1);
  Result := 'image/' + DefaultFileExt;
end;

procedure TFPImageBitmap.InitializeReader(AImage: TLazIntfImage; AReader: TFPCustomImageReader);
begin
  AReader.OnProgress := @Progress;
end;

procedure TFPImageBitmap.InitializeWriter(AImage: TLazIntfImage; AWriter: TFPCustomImageWriter);
var
  LazWriter: ILazImageWriter;
begin
  AWriter.OnProgress := @Progress;
  if Supports(AWriter, ILazImageWriter, LazWriter)
  then LazWriter.Initialize(AImage);
end;

class function TFPImageBitmap.IsFileExtensionSupported(
  const FileExtension: string): boolean;
var
  Extensions: String;
  StartPos: Integer;
  EndPos: Integer;
  i: Integer;
  Ext: String;
begin
  Result:=false;
  if FileExtension='' then exit;
  Extensions:=GetFileExtensions;
  if Extensions='' then exit;
  Ext:=FileExtension;
  if Ext[1]='.' then begin
    delete(Ext,1,1);
    if Ext='' then exit;
  end;
  StartPos:=1;
  while StartPos<=length(Extensions) do begin
    if not (Extensions[StartPos] in [';',' ']) then begin
      EndPos:=StartPos;
      while (EndPos<=length(Extensions)) and (Extensions[EndPos]<>';') do
        inc(EndPos);
      if EndPos-StartPos=length(Ext) then begin
        i:=1;
        while (i<=length(Ext))
        and (upcase(Extensions[StartPos+i-1])=upcase(Ext[i])) do
          inc(i);
        if i>length(Ext) then begin
          Result:=true;
          exit;
        end;
      end;
      StartPos:=EndPos;
    end else
      inc(StartPos);
  end;
end;

function TFPImageBitmap.LazarusResourceTypeValid(const ResourceType: string): boolean;
begin
  Result:=IsFileExtensionSupported(ResourceType);
end;

procedure TFPImageBitmap.ReadStream(AStream: TMemoryStream; ASize: Longint);
var
  SCB: TSharedCustomBitmap;
  IntfImg: TLazIntfImage;
  ImgReader: TFPCustomImageReader;
  LazReader: ILazImageReader;
begin
  IntfImg := nil;
  ImgReader := nil;
  try
    // read image
    ImgReader := GetReaderClass.Create;
    ImgReader.OnProgress := Self.OnProgress;
    IntfImg := TLazIntfImage.Create(0,0,[]);
    InitializeReader(IntfImg, ImgReader);
    if Supports(ImgReader, ILazImageReader, LazReader)
    then LazReader.UpdateDescription := True
    else IntfImg.DataDescription := GetDescriptionFromDevice(0, 0, 0); // fallback to default
    ImgReader.ImageRead(AStream, IntfImg);
    FinalizeReader(ImgReader);

    // no need to care about unsharing image, thats done by calling proc
    SCB := TSharedCustomBitmap(FSharedImage);
    SCB.FImage.FreeData;
    IntfImg.GetRawImage(SCB.FImage, True);
    SCB.FHasMask := IntfImg.HasMask;
    if not SCB.FHasMask
    then SCB.FImage.Description.MaskBitsPerPixel := 0;
    FPixelFormatNeedsUpdate := True;
  finally
    LazReader := nil;
    IntfImg.Free;
    ImgReader.Free;
  end;
end;

procedure TFPImageBitmap.WriteStream(AStream: TMemoryStream);
var
  IntfImg: TLazIntfImage;
  ImgWriter: TFPCustomImageWriter;
  RawImg: PRawImage;
begin
  // write image to temporary stream
  ImgWriter := nil;
  RawImg:=GetRawImagePtr;
  if RawImg^.DataSize > 0 then begin
    IntfImg := TLazIntfImage.Create(0,0,[]);
    try
      ImgWriter := GetWriterClass.Create;
      IntfImg.SetRawImage(RawImg^, False);
      InitializeWriter(IntfImg, ImgWriter);
      IntfImg.SaveToStream(AStream, ImgWriter);
      FinalizeWriter(ImgWriter);
    finally
      IntfImg.Free;
      ImgWriter.Free;
    end;
  end;
end;