TurboPack / MustangpeakVirtualshellTools

Delphi and CBuilder Components to create Explorer type programs
Other
49 stars 24 forks source link

ImageEn support back #19

Closed mhietan closed 2 years ago

mhietan commented 2 years ago

Hi,

Please add ImageEn support back. Please note! after 14.5.2022 some changes thumbnail drawing is broken. I'm using these in my project.

in addins.inc: // ImageEn SUPPORT {$DEFINE USEIMAGEEN}

VirtualThumbnails.pas:

{$IFDEF USEIMAGEEN}
function SpMakeThumbFromFileImageEn(Filename: string; OutBitmap: TBitmap; ThumbW, ThumbH: Integer;
  BgColor: TColor; Subsampling, ExifThumbnail, ExifOrientation: Boolean; var ImageWidth, ImageHeight: Integer): Boolean;
{$ENDIF}

uses {$IFDEF USEIMAGEEN} ImageEnIo, ImageEnProc, hyieutils,ievision, iexBitmaps, iexHelperFunctions, {$ENDIF}

{$IFDEF USEIMAGEEN}
function SpMakeThumbFromFileImageEn(Filename: string; OutBitmap: TBitmap;
  ThumbW, ThumbH: Integer; BgColor: TColor; Subsampling, ExifThumbnail, ExifOrientation: Boolean;
  var ImageWidth, ImageHeight: Integer): Boolean;
var
  AttachedIEBitmap: TIEBitmap;
  ImageEnIO: TImageEnIO;
  ImageEnProc: TImageEnProc;
  TempBitmap: TBitmap;
  F: TVirtualFileStream;
  DestR: TRect;
  Ext: string;
  IsRaw, IsVideo: Boolean;
  Orientation: Integer;
begin
  Result := False;
  ImageWidth := 0;
  ImageHeight := 0;
  Orientation := 0;
  if not Assigned(OutBitmap) then Exit;
  Ext := WideLowerCase(ExtractFileExt(Filename));

  IsRaw := (ext = '.crw') or (ext = '.cr2') or (ext = '.dng')
        or (ext = '.nef') or (ext = '.raw') or (ext = '.raf')
        or (ext = '.x3f') or (ext = '.orf') or (ext = '.srf')
        or (ext = '.mrw') or (ext = '.dcr') or (ext = '.bay')
        or (ext = '.pef') or (ext = '.sr2') or (ext = '.arw')
        or (ext = '.kdc') or (ext = '.mef') or (ext = '.3fr')
        or (ext = '.k25') or (ext = '.erf') or (ext = '.cam')
        or (ext = '.cs1') or (ext = '.dc2') or (ext = '.dcs')
        or (ext = '.fff') or (ext = '.mdc') or (ext = '.mos')
        or (ext = '.nrw') or (ext = '.ptx') or (ext = '.pxn')
        or (ext = '.rdc') or (ext = '.rw2') or (ext = '.rwl')
        or (ext = '.iiq') or (ext = '.srw');

  IsVideo := (ext = '.avi') or (ext = '.mpg') or (ext = '.mpeg') or (ext = '.wmv');

  TempBitmap := TBitmap.Create;
  TempBitmap.Canvas.Lock;
  try
    AttachedIEBitmap := TIEBitmap.Create;
    ImageEnIO := TImageEnIO.Create(nil);
    ImageEnProc := TImageEnProc.Create(Nil);
    try
      ImageEnIO.AttachedIEBitmap := AttachedIEBitmap;
      ImageEnProc.AttachedIEBitmap := AttachedIEBitmap;
      ImageEnIO.Params.Width := ThumbW;
      ImageEnIO.Params.Height := ThumbH;
      ImageEnIO.Params.JPEG_Scale := ioJPEG_AUTOCALC;
      ImageEnIO.Params.JPEG_DCTMethod := ioJPEG_IFAST;
      ImageEnIO.Params.EnableAdjustOrientation := ExifOrientation;
      // ImageEn bug: TImageEnIO.LoadFromStream doesn't work with wmf/emf/sun files
      if (Ext = '.wmf') or (Ext = '.emf') or (Ext = '.sun') then
      begin
        ImageEnIO.LoadFromFile(Filename);
        ImageWidth := ImageEnIO.Params.Width;
        ImageHeight := ImageEnIO.Params.Height;
        AttachedIEBitmap.CopyToTBitmap(TempBitmap);
      end;
      if IsVideo then
      begin
        ImageEnIO.OpenMediaFile(Filename);
        ImageEnIO.LoadFromMediaFile(5);
        ImageWidth := ImageEnIO.Params.Width;
        ImageHeight := ImageEnIO.Params.Height;
        AttachedIEBitmap.CopyToTBitmap(TempBitmap);
        ImageEnIO.CloseMediaFile;
      end
      else
      begin
        F := TVirtualFileStream.Create(Filename, fmOpenRead or fmShareDenyNone);
        try
          if IsRaw then
          begin
            ImageEnIO.Params.GetThumbnail := True;
            ImageEnIO.LoadFromStreamRAW(F);
            if ExifOrientation then
              if (ext = '.crw') then
                Orientation := GetCrwOrientation(F) // CRW doesn't have Exif, read the CIFF data
              else
                Orientation := ImageEnIO.Params.EXIF_Orientation;
            if (Orientation = 6) or (Orientation = 8) then
              IEAdjustEXIFOrientation(AttachedIEBitmap, Orientation);
            ImageWidth := AttachedIEBitmap.Width;
            ImageHeight := AttachedIEBitmap.Height;
          end
          else
          // If it's not a digital camera RAW file
          begin
            ImageEnIO.Params.GetThumbnail := ExifThumbnail;
            ImageEnIO.LoadFromStream(F);
            if ImageEnIO.Params.JPEG_Scale_Used > 1 then
            begin
              ImageWidth := AttachedIEBitmap.Width;
              ImageHeight := AttachedIEBitmap.Height;
            end
            else
            begin
              ImageWidth := ImageEnIO.Params.Width;
              ImageHeight := ImageEnIO.Params.Height;
            end;
          end;
          AttachedIEBitmap.CopyToTBitmap(TempBitmap);
        finally
          F.Free;
        end;
      end;
    finally
      ImageEnIO.Free;
      ImageEnProc.Free;
      AttachedIEBitmap.Free;
    end;
    // Resize the thumb
    // Need to lock/unlock the canvas here
    OutBitmap.Canvas.Lock;
    try
      DestR := SpRectAspectRatio(ImageWidth, ImageHeight, ThumbW, ThumbH, talNone, True);
      SpInitBitmap(OutBitmap, DestR.Right, DestR.Bottom, BgColor);
      // StretchDraw is NOT THREADSAFE!!! Use SpStretchDraw instead
      SpStretchDraw(TempBitmap, OutBitmap.Canvas, DestR, Subsampling);
      Result := True;
    finally
      OutBitmap.Canvas.UnLock;
    end;
    Result := True;
  finally
    TempBitmap.Canvas.Unlock;
    TempBitmap.Free;
  end;
end;
{$ENDIF}
in function SpCreateThumbInfoFromFile...
        {$IFDEF USEIMAGEEN}
        ThumbnailExtracted := SpMakeThumbFromFileImageEn(NS.NameForParsing, B, ThumbW, ThumbH,
          clRed, UseSubsampling, UseExifThumbnail, UseExifOrientation, W, H);
        {$ELSE}
        // Jim: Changed the Background so images that use the Alpha Channel for Transparency work correctly
        ThumbnailExtracted := SpMakeThumbFromFile(NS.NameForParsing, B, ThumbW, ThumbH,
          BackgroundColor, UseSubsampling, UseExifThumbnail, UseExifOrientation, W, H);
procedure TCustomThumbsManager.FillImageFormats(FillColors: Boolean = True);
var
  I: Integer;
  Ext: string;
begin
  FValidImageFormats.Clear;

  with FValidImageFormats do begin
    CommaText := '.jpg, .jpeg, .jpe, .jif, .bmp, .emf, .wmf';
    {$IFDEF USEIMAGEEN}
    CommaText := CommaText + ', .tif, .tiff, .fax, .g3n, .g3f, .xif, .gif, .pcx, .dib, .rle, .ico, .cur, .png, .dcm, .dic, .dicom' +
      ', .v2, .tga, .targa, .vda, .icb, .vst, .pix, .pxm, .ppm, .pgm, .pbm, .wbmp, .jp2, .j2k, .jpc, .j2c, .dcx' +
      ', .crw, .cr2, .dng, .nef, .raw, .raf, .x3f, .orf, .srf, .mrw, .dcr, .bay, .pef, .sr2, .arw, .kdc, .mef, .3fr, .k25, .erf, .cam, .cs1, .dc2, .dcs, .fff, .mdc, .mos, .nrw, .ptx, .pxn, .rdc, .rw2, .rwl, .iiq, .srw' +
      ', .psd, .psb, .wdp, .hdp, .jxr, .dds, .heic, .heif, .heics, .avcs, .heifs, .webp, .avi, .mpe, .mpg, .mpeg, .wmv';
    {$ELSE}
    {$IFDEF USEENVISION}
      //version 1.1
      CommaText := CommaText + ', .png, .pcx, .pcc, .tif, .tiff, .dcx, .tga, .vst, .afi';
      //version 2.0, eps (Encapsulated Postscript) and jp2 (JPEG2000 version)
      //CommaText := CommaText + ', .eps, .jp2'; <<<<<<< still in beta
    {$ENDIF}
    {$ENDIF}
  end;

  if FillColors then begin
    for I := 0 to FValidImageFormats.Count - 1 do begin
      Ext := FValidImageFormats[I];

      if Pos(Ext, '.jpg, .jpeg, .jpe, .jif, .bmp, .emf, .wmf') > 0 then FValidImageFormats.Colors[I] := $BADDDD
      else if Pos(Ext, '.tif, .tiff, .fax, .g3n, .g3f, .xif, .gif, .pcx, .dib, .rle, .ico, .cur, .png, .dcm, .dic, .dicom') > 0 then FValidImageFormats.Colors[I] := $EFD3D3
      else if Pos(Ext, '.v2, .tga, .targa, .vda, .icb, .vst, .pix, .pxm, .ppm, .pgm, .pbm, .wbmp, .jp2, .j2k, .jpc, .j2c, .dcx') > 0 then FValidImageFormats.Colors[I] := $7DC7B0
      else if Pos(Ext, '.crw, .cr2, .dng, .nef, .raw, .raf, .x3f, .orf, .srf, .mrw, .dcr, .bay, .pef, .sr2, .arw, .kdc, .mef, .3fr, .k25, .erf, .cam, .cs1, .dc2, .dcs, .fff, .mdc, .mos, .nrw, .ptx, .pxn, .rdc, .rw2, .rwl, .iiq, .srw') > 0 then FValidImageFormats.Colors[I] := $CCDBCC
      else if Pos(Ext, '.psd, .psb, .wdp, .hdp, .jxr, .dds, .heic, .heif, .heics, .avcs, .heifs, .webp, .avi, .mpe, .mpg, .mpeg, .wmv') > 0 then FValidImageFormats.Colors[I] := $0BBDFF;
      // $7DC7B0 = green, $0BBDFF = orange, CFCFCF = grey
    end;
  end;

  FInvalidImageFormats.CommaText := '.url, .lnk, .ico, .exe, .com, .sys, .dll, .bpl';
end;

Thanks. :)

romankassebaum commented 2 years ago

I readded the code for USEIMAGEEN. I cannot say if the code is compiling or working.

mhietan commented 2 years ago

Thanks. I will test it tomorrow.

mhietan commented 2 years ago

Hello,

Thank you, it works now perfectly.

Only few additions needed: To VirtualThumbnails.pas, cause now it misses few uses:

uses
{$IFDEF USEIMAGEEN} ImageEnIo, ImageEnProc, hyieutils, iexBitmaps, iexHelperFunctions,{$ENDIF}
  Types,
  Math;
procedure TCustomThumbsManager.FillImageFormats(FillColors: Boolean = True);
var
  I: Integer;
  Ext: string;
begin
  FValidImageFormats.Clear;

  with FValidImageFormats do begin
    CommaText := '.jpg, .jpeg, .jpe, .jif, .bmp, .emf, .wmf';
    {$IFDEF USEIMAGEEN}
    CommaText := CommaText + ', .tif, .tiff, .fax, .g3n, .g3f, .xif, .gif, .pcx, .dib, .rle, .ico, .cur, .png, .dcm, .dic, .dicom' +
      ', .v2, .tga, .targa, .vda, .icb, .vst, .pix, .pxm, .ppm, .pgm, .pbm, .wbmp, .jp2, .j2k, .jpc, .j2c, .dcx' +
      ', .crw, .cr2, .dng, .nef, .raw, .raf, .x3f, .orf, .srf, .mrw, .dcr, .bay, .pef, .sr2, .arw, .kdc, .mef, .3fr, .k25, .erf, .cam, .cs1, .dc2, .dcs, .fff, .mdc, .mos, .nrw, .ptx, .pxn, .rdc, .rw2, .rwl, .iiq, .srw' +
      ', .psd, .psb, .wdp, .hdp, .jxr, .dds, .heic, .heif, .heics, .avcs, .heifs, .webp, .avi, .mpe, .mpg, .mpeg, .wmv';
    {$ELSE}

  if FillColors then begin
    for I := 0 to FValidImageFormats.Count - 1 do begin
      Ext := FValidImageFormats[I];

      if Pos(Ext, '.jpg, .jpeg, .jpe, .jif, .bmp, .emf, .wmf') > 0 then FValidImageFormats.Colors[I] := $BADDDD
      else if Pos(Ext, '.tif, .tiff, .fax, .g3n, .g3f, .xif, .gif, .pcx, .dib, .rle, .ico, .cur, .png, .dcm, .dic, .dicom') > 0 then FValidImageFormats.Colors[I] := $EFD3D3
      else if Pos(Ext, '.v2, .tga, .targa, .vda, .icb, .vst, .pix, .pxm, .ppm, .pgm, .pbm, .wbmp, .jp2, .j2k, .jpc, .j2c, .dcx') > 0 then FValidImageFormats.Colors[I] := $7DC7B0
      else if Pos(Ext, '.crw, .cr2, .dng, .nef, .raw, .raf, .x3f, .orf, .srf, .mrw, .dcr, .bay, .pef, .sr2, .arw, .kdc, .mef, .3fr, .k25, .erf, .cam, .cs1, .dc2, .dcs, .fff, .mdc, .mos, .nrw, .ptx, .pxn, .rdc, .rw2, .rwl, .iiq, .srw') > 0 then FValidImageFormats.Colors[I] := $CCDBCC
      else if Pos(Ext, '.psd, .psb, .wdp, .hdp, .jxr, .dds, .heic, .heif, .heics, .avcs, .heifs, .webp, .avi, .mpe, .mpg, .mpeg, .wmv') > 0 then FValidImageFormats.Colors[I] := $0BBDFF;
      // $7DC7B0 = green, $0BBDFF = orange, CFCFCF = grey
    end;
  end;

Also in to Addins.inc file:

// ImageEn SUPPORT
// You may need to add Path to ImageEn: Delphi Compiler, Windows 64bit, Search path \ImageEn\Source\Delphi11Alexandria_64

// {$DEFINE USEIMAGEEN}
romankassebaum commented 2 years ago

I added your changes. Please check again.

mhietan commented 2 years ago

Now its okay. Big thank you!

Note for other users: About the FillImageFormats. It depends on your needs, for ex. coloring might need to change. :)

mhietan commented 2 years ago

For the Addins.inc one more note, sorry :)

// ImageEn SUPPORT // You must add the ImageEn package to the VirtualShellToolsD.dpk "Requires" section PKIECtrl28 // You may need to add Path to ImageEn: Delphi Compiler, Windows 64bit, Search path \ImageEn\Source\Delphi11Alexandria_64

// {$DEFINE USEIMAGEEN}

romankassebaum commented 2 years ago

I improved the notes.