{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{             TJPEGImage descendant with CMYK support        }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}

unit sgJPEG;
{$INCLUDE SGDXF.INC}
interface

uses
  Windows, ActiveX, Graphics, Classes
{$IFDEF SGDEL_XE2}
  , Vcl.Imaging.jpeg
{$ELSE}
  , jpeg
{$ENDIF}
  , GDIPLUS;

type
  TsgJPEGDotsMetric = (jdmNone, jdmInch, jdmCm);

  TsgJPEGImage = class(TJPEGImage)
  private
    FDPUX: Integer;
    FJPEGDotsMetric: TsgJPEGDotsMetric;
    FDPUY: Integer;
  protected
    class procedure ReadResParams(Stream: TStream;
      var AHorzRes, AVertRes: Integer; var AJPEGDotsMetric: TsgJPEGDotsMetric);
    class function SeekResPosition(Stream: TStream): Boolean;
    class procedure WriteResParams(Stream: TStream; AHorzRes, AVertRes: Integer;
      const AJPEGDotsMetric: TsgJPEGDotsMetric);
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property DPUX: Integer read FDPUX write FDPUX;
    property DPUY: Integer read FDPUY write FDPUY;
    property JPEGDotsMetric: TsgJPEGDotsMetric read FJPEGDotsMetric
      write FJPEGDotsMetric;
  end;

function LoadWithGDIPlus(const AFileName: string; ABmp: TBitmap): Boolean;

implementation

function LoadWithGDIPlus(const AFileName: string; ABmp: TBitmap): Boolean;
var
  vGDIPlusImage: TsgGDIPlusImage;
  vGDIPlus: TsgGDIPlusGraphics;
  procedure LoadFromPicture;
  var
    vPicture: TPicture;
  begin
    vPicture := TPicture.Create;
    try
      try
        vPicture.LoadFromFile(AFileName);
        ABmp.PixelFormat := pf24bit;
        ABmp.Width := vPicture.Graphic.Width;
        ABmp.Height := vPicture.Graphic.Height;
        ABmp.Canvas.StretchDraw(Rect(0, 0, ABmp.Width, ABmp.Height), vPicture.Graphic);
        Result := True;
      except
        vPicture.Free;
        vPicture := nil;
        Exit;
      end;
    finally
      vPicture.Free;
    end;
  end;

begin
  Result := False;
  if GDIPlusLoaded = 0 then
  begin
    vGDIPlusImage := TsgGDIPlusImage.Create(AFileName);
    try
      if vGDIPlusImage.GetStatusOfFunction = Ok then
      begin
        ABmp.Width := vGDIPlusImage.GetWidth;
        ABmp.Height := vGDIPlusImage.GetHeight;
        ABmp.PixelFormat := pf32bit;
        vGDIPlus := TsgGDIPlusGraphics.Create(ABmp.Canvas.Handle);
        try
          if vGDIPlus.GetStatusOfFunction = Ok then
            Result := vGDIPlus.DrawImage(vGDIPlusImage, 0, 0, vGDIPlusImage.GetWidth, vGDIPlusImage.GetHeight) = Ok
          else
            LoadFromPicture;
          if not Result then LoadFromPicture;
        finally
          vGDIPlus.Free;
        end;
      end;
    finally
      vGDIPlusImage.Free;
    end;
  end
  else
    LoadFromPicture;
end;

{ TsgJPEGImage }

constructor TsgJPEGImage.Create;
begin
  inherited Create;
  FJPEGDotsMetric := jdmInch;
  FDPUX := 300;
  FDPUY := 300;
end;

procedure TsgJPEGImage.LoadFromStream(Stream: TStream);
var
  vGDIPlusImage: TsgGDIPlusImage;
  vGDIPlus: TsgGDIPlusGraphics;
  vBmp: TBitmap;
  vDataHandle: HGlobal;
  vBuffer: Pointer;
  vStrm: IStream;
  vRes: Boolean;
begin
  vBmp := nil;
  vGDIPlusImage := nil;
  vGDIPlus := nil;
  vRes := False;
  vDataHandle := 0;
  vStrm := nil;
  try
    if GDIPlusLoaded = 0 then
    begin
      vDataHandle := GlobalAlloc(GMEM_MOVEABLE, Stream.Size);
      try
        if vDataHandle <> 0 then
        begin
          vBuffer := GlobalLock(vDataHandle);
          if vBuffer <> nil then
          begin
            Stream.Position := 0;
            Stream.Read(vBuffer^, Stream.Size);
            GlobalUnlock(vDataHandle);
            if Succeeded(CreateStreamOnHGlobal(vDataHandle, True, vStrm)) then
            begin
              vGDIPlusImage := TsgGDIPlusImage.Create(vStrm);
              try
                if vGDIPlusImage.GetStatusOfFunction = Ok then
                begin
                  vBmp := TBitmap.Create;
                  try
                    vBmp.Transparent := False;
                    vBmp.Width := vGDIPlusImage.GetWidth;
                    vBmp.Height := vGDIPlusImage.GetHeight;
                    vBmp.PixelFormat := pf32bit;
                    vGDIPlus := TsgGDIPlusGraphics.Create(vBmp.Canvas.Handle);
                    try
                      if vGDIPlus.GetStatusOfFunction = Ok then
                      begin
                        if vGDIPlus.DrawImage(vGDIPlusImage, 0, 0, vGDIPlusImage.GetWidth, vGDIPlusImage.GetHeight) = Ok then
                        begin
                          Assign(vBmp);
                          vRes := True;
                        end;
                      end;
                    finally
                      vGDIPlus.Free;
                      vGDIPlus := nil;
                    end;
                  finally
                    vBmp.Free;
                    vBmp := nil;
                  end;
                end;
              finally
                vGDIPlusImage.Free;
                vGDIPlusImage := nil;
                vStrm := nil;
              end;
            end;
          end;
        end;
      finally
        if vDataHandle <> 0 then GlobalFree(vDataHandle);
        vDataHandle := 0;
      end;
    end;
  except
    vGDIPlus.Free;
    vBmp.Free;
    vGDIPlusImage.Free;
    if vDataHandle <> 0 then GlobalFree(vDataHandle);
    vStrm := nil;
    vRes := False;
  end;
  if not vRes then
  begin
    if Stream.Position <> 0 then
      Stream.Position := 0;
    inherited LoadFromStream(Stream);
  end;
  ReadResParams(Stream, FDPUX, FDPUY, FJPEGDotsMetric);
end;

class procedure TsgJPEGImage.ReadResParams(Stream: TStream; var AHorzRes,
  AVertRes: Integer; var AJPEGDotsMetric: TsgJPEGDotsMetric);
var
  vPosition: Int64;
begin
  vPosition := Stream.Position;
  try
    if SeekResPosition(Stream) then
    begin
      AHorzRes := 0;
      AVertRes := 0;
      Stream.Read(AJPEGDotsMetric, 1);
      Stream.Read(AHorzRes, 2);
      Stream.Read(AVertRes, 2);
      AHorzRes := Swap(AHorzRes);
      AVertRes := Swap(AVertRes);
    end;
  finally
    Stream.Position := vPosition;
  end;
end;

procedure TsgJPEGImage.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  WriteResParams(Stream, FDPUX, FDPUY, FJPEGDotsMetric);
end;

class function TsgJPEGImage.SeekResPosition(Stream: TStream): Boolean;
var
  vBufferSize, vIndex: integer;
  vStrBuf: array[1..50] of AnsiChar;
begin
  Result := False;
  Stream.Seek(0, soFromBeginning);
  vBufferSize := High(vStrBuf);
  FillChar(vStrBuf, SizeOf(vStrBuf), #0);
  //SetLength(vStrBuf, vBufferSize);
  Stream.Read(vStrBuf[1], vBufferSize);
  vIndex := Pos(AnsiString('JFIF' + #0), AnsiString(vStrBuf));
  if vIndex > 0 then
  begin
    Stream.Seek(vIndex + 6, soFromBeginning);
    Result := True;
  end;
end;

class procedure TsgJPEGImage.WriteResParams(Stream: TStream; AHorzRes,
  AVertRes: Integer; const AJPEGDotsMetric: TsgJPEGDotsMetric);
var
  vPosition: Int64;
begin
  vPosition := Stream.Position;
  try
    if SeekResPosition(Stream) then
    begin
      Stream.Write(AJPEGDotsMetric, 1);
      AHorzRes := Swap(AHorzRes);
      AVertRes := Swap(AVertRes);
      Stream.Write(AHorzRes, 2);
      Stream.Write(AVertRes, 2);
    end;
  finally
    Stream.Position := vPosition;
  end;
end;

initialization

 // TPicture.UnRegisterGraphicClass(TJPEGImage);
  TPicture.RegisterFileFormat('jpeg', 'JPEG Image File', TsgJPEGImage);
  TPicture.RegisterFileFormat('jpg', 'JPEG Image File', TsgJPEGImage);

finalization
  TPicture.UnRegisterGraphicClass(TsgJPEGImage);

end.
