atviewer.pas

ATViewer is a component for Delphi/C++Builder, which allows to view files of various types. There is

  FBinHex.Open('', False);

  FIsImageBefore := Assigned(FImageBox) and Assigned(FImageBox.Image.Picture.Graphic);
  if FIsImageBefore then
    FImageBox.Image.Picture := nil;

  if not (csDestroying in ComponentState) then
  begin
    if Assigned(FEdit) and (FEdit.Lines.Count > 0) then
      FEdit.Lines.Clear;

    {$ifdef MEDIA_PLAYER}
    if Assigned(FMedia) and (FMedia.FileName <> '') then
    begin
      FMedia.Close;
      FMedia.FileName := '';
    end;
    {$endif}

    {$ifdef MEDIA_WMP64}
    if Assigned(FWMP6) and (FWMP6.FileName <> '') then
      FWMP6.FileName := '';
    {$endif}

    {$ifdef MEDIA_WMP9}
    if Assigned(FWMP9) and (FWMP9.URL <> '') then
      FWMP9.URL := '';
    {$endif}

    if Assigned(FBrowser) then
      WB_NavigateBlank(FBrowser);
  end;

  FIsImage := False;
  FIsIcon := False;
  FIsMetafile := False;
  FIsMedia := False;

  FreeSearch;
end;

procedure TATViewer.DetectMode;
begin
  //Reset encoding
  if FTextDetectOEM then
    FTextEncoding := vencANSI;

  {$ifdef WLX}
  if (not (vmodeWLX in FModesDisabledForDetect)) and
    FPluginsHighPriority and OpenByPlugins(True) then FMode := vmodeWLX else
  {$endif}

  if (not (vmodeRTF in FModesDisabledForDetect)) and
    SFileExtensionMatch(FFileName, ATViewerOptions.ExtRTF) then FMode := vmodeRTF else

  if (not (vmodeText in FModesDisabledForDetect)) and
    SFileExtensionMatch(FFileName, ATViewerOptions.ExtText) then FMode := vmodeText else

  if (not (vmodeMedia in FModesDisabledForDetect)) and
    SFileExtensionMatch2(FFileName, ActualExtImages, ATViewerOptions.ExtMedia)
                                                 then FMode := vmodeMedia else

  if (not (vmodeWeb in FModesDisabledForDetect)) and
    SFileExtensionMatch(FFileName, ATViewerOptions.ExtWeb) then FMode := vmodeWeb else

  //Test for FModesDisabledForDetect is in DetectTextAndUnicode
  if FTextDetect and DetectTextAndUnicode then begin end else

  {$ifdef WLX}
  if (not (vmodeWLX in FModesDisabledForDetect)) and
    (not FPluginsHighPriority) and OpenByPlugins(True) then FMode := vmodeWLX else
  {$endif}

  //If no other modes were detected, set default mode
  FMode := FModeUndetected;
end;

{$ifdef MEDIA_WMP64}
procedure TATViewer.SetMediaFit_WMP6(WMP: TWMP);
const
  cWMPDisplaySize: array[Boolean] of MPDisplaySizeConstants =
    (mpDefaultSize, mpFitToSize);
begin
  if Assigned(WMP) then
    WMP.DisplaySize := cWMPDisplaySize[FMediaFit];
end;

procedure TATViewer.PlayStateChange_WMP6(Sender: TObject; OldState: Integer; NewState: Integer);
begin
  if NewState = MediaPlayer_TLB.mpStopped then
  begin
    PreparePlaybackEnd;
  end;
end;
{$endif}

{$ifdef MEDIA_WMP9}
procedure TATViewer.SetMediaFit_WMP9(WMP: TWMP9);
begin
  if Assigned(WMP) then
  try
    with WMP do
      (IDispatch(OleObject) as IWMPPlayer4).StretchToFit := FMediaFit;
  except
  end;
end;

procedure TATViewer.PlayStateChange_WMP9(Sender: TObject; NewState: Integer);
begin
  if NewState = MediaPlayer9_TLB.wmppsStopped then
  begin
    PreparePlaybackEnd;
  end;
end;
{$endif}


function TATViewer.ActualExtImages: string;
begin
  Result := ATViewerOptions.ExtImages;
  {$ifdef IVIEW}
  if IViewIntegration.Enabled then
    Result := Result + ',' + IViewIntegration.ExtList;
  {$endif}
end;

procedure TATViewer.LoadImage(APicture: TPicture = nil);
  //
  {$ifdef IVIEW}
  function LoadImageWithIView: Boolean;
  var
    Bmp: TBitmap;
  begin
    FIsImageIView := True;
    Bmp := TBitmap.Create;
    try
      if not Assigned(FIViewObject) then
        FIViewObject := TIrfanXnView.Create('');
      with TIrfanXnView(FIViewObject) do
      begin
        Host := IViewIntegration.ExeName;
        Bmp.PixelFormat := pf24bit;
        Bmp.Handle := GetBitmap(FFileName);
        Host := '';
      end;
      Result := Bmp.Handle <> 0;
      if Result then
      begin
        //If IView could load a file, put it into Image object:
        FImageBox.Image.Transparent := FImageTransparent and SFileExtensionMatch(FFileName, 'bmp');
        FImageBox.Image.Picture.Assign(Bmp);
        FImageBox.UpdateImageInfo;
      end
      else
      begin
        //If IView could not load a file, raise an exception that
        //will be immediately handled and "Unsupported image format"
        //message will be shown:
        raise Exception.Create('');
      end;
    finally
      Bmp.Free;
    end;
  end;
  {$endif}
  //
  procedure LoadImageWithLibrary;
  begin
    FIsImageIView := False;
    FImageBox.Image.Picture.LoadFromFile(FFileName);
    FImageBox.UpdateImageInfo;
  end;
  //
  procedure LoadImageFromPicture(APicture: TPicture);
  begin
    FIsImageIView := False;
    FImageBox.Image.Picture.Assign(APicture);
    FImageBox.UpdateImageInfo;
  end;
  //
  procedure UnloadImage;
  begin
    FImageBox.Image.Picture := nil;
    FImageBox.UpdateImageInfo;
  end;
  //
  procedure ShowImageError(const Msg: string);
  begin
    UnloadImage;
    FImageError := True;
    FImageErrorMessage := Msg;
    if FImageErrorMessageBox then
      MsgError(Msg);
  end;
  //

{$ifdef IVIEW}
var
  IViewHighPriority: Boolean;
{$endif}
begin
  FImageError := False;
  FImageErrorMessage := '';

  //If an image was loaded before, then we need to switch between
  //"internal library" and "IrfanView" modes. We do this by setting the
  //IViewHighPriority local variable to False/True, otherwise it's set 
  //according to IViewIntegration.HighPriority property.

  {$ifdef IVIEW}
  if FIsImageBefore then
    IViewHighPriority := not FIsImageIView
  else
    IViewHighPriority := FIViewIntegration.HighPriority;
  {$endif}

  if Assigned(FImageBox) then
    try
      try
        DoCursorHours;

        if Assigned(APicture) then
        begin
          LoadImageFromPicture(APicture);
          Exit;
        end;

        {$ifdef IVIEW}
        //a) Load with IView with high priority
        if IViewIntegration.Enabled and IViewHighPriority then
          if SFileExtensionMatch(FFileName, IViewIntegration.ExtList) then
            begin
              LoadImageWithIView;
              Exit;
            end;
        {$endif}
        
        //b) Load with internal library
        if SFileExtensionMatch(FFileName, ATViewerOptions.ExtImages) then
        begin
          try
            LoadImageWithLibrary;
          except
            {$ifdef IVIEW}
            //If library couldn't load an image, switch to IView implicitly
            //(so useless error messagebox won't appear)
            if IViewIntegration.Enabled then
              if SFileExtensionMatch(FFileName, IViewIntegration.ExtList) then
              begin
                LoadImageWithIView;
                Exit;
              end;
            {$endif}
            //If IView couldn't help here, show error messagebox finally
            raise;
          end;
          Exit;
        end;

        {$ifdef IVIEW}
        //c) Load with IView with low priority
        if IViewIntegration.Enabled and (not IViewHighPriority) then
          if SFileExtensionMatch(FFileName, IViewIntegration.ExtList) then
            begin
              LoadImageWithIView;
              Exit;
            end;
        {$endif}

        UnloadImage;

      finally
        DoCursorDefault;
      end;
    except
      on E: EInvalidGraphic do
        ShowImageError(E.Message)
      else
        ShowImageError(MsgViewerErrImage);
    end;
end;

procedure TATViewer.LoadMedia(APicture: TPicture = nil);
  //
  procedure ShowMediaError(const Msg: string);
  begin
    if Msg <> '' then
      MsgError(Msg)
    else
      MsgError(MsgViewerErrMedia);
  end;
  //
begin
  FreeData;
  if FFileName = '' then Exit;

  if SFileExtensionMatch(FFileName, ActualExtImages) then
    try
      FIsImage := True;
      InitImage;

      if Assigned(FImageBox) then
      begin
        FImageBox.Color := FImageColor;
        FImageBox.ImageDrag := FImageDrag;
        FImageBox.Image.Cursor := FImageCursor;
        FImageBox.ImageDragCursor := FImageDragCursor;
        FImageBox.Image.Transparent := FImageTransparent;
        FImageBox.Image.Resample := FImageResample;
        FImageBox.Image.ResampleBackColor := FImageColor;

        LoadImage(APicture);

        {$ifdef GIF}
        if Assigned(FImageBox.Image.Picture.Graphic) and
          (FImageBox.Image.Picture.Graphic is TGifImage) then
          with (FImageBox.Image.Picture.Graphic as TGifImage) do
          begin
            if FImageTransparent or 
              ((Images.Count > 1) and IsTransparent) //Always set transparency for (animaged + transparent) images
            then
              DrawOptions := DrawOptions + [goTransparent]
            else
              DrawOptions := DrawOptions - [goTransparent];
          end;
        {$endif}

        FImageBox.ImageFitToWindow := FMediaFit;
        FImageBox.ImageFitOnlyBig := FMediaFitOnlyBig;
        FImageBox.ImageCenter := FMediaCenter;
        FImageBox.ImageKeepPosition := FImageKeepPosition;
        FImageBox.BorderStyle := FBorderStyleInner;
        FImageBox.Show;
        if CanSetFocus then
          FImageBox.SetFocus;

        FIsIcon := FImageBox.Image.Picture.Graphic is TIcon;
        FIsMetafile := FImageBox.Image.Picture.Graphic is TMetafile;
        if FIsIcon then
          FixIcon(FImageBox.Image.Picture.Graphic as TIcon);
      end;
    except
    end

  else
  begin
    FIsMedia := True;
    MediaSyncVolume;
    InitMedia;

    {$ifdef MEDIA_PLAYER}
    if (FMediaMode = vmmodeMCI) and Assigned(FMedia) then
      try
        try
          DoCursorHours;
          FMediaPanel.Show;
          SetMediaPosition;
          FMedia.FileName := FFileName;
          FMedia.Notify := True;
          FMedia.Open;
          FMedia.Enabled := True;
          FMediaBar.Enabled := True;
          FMediaBar.Max := FMedia.Length;
          if CanSetFocus then
            FMedia.SetFocus;
          if FMediaAutoPlay then
            FMedia.Play;
        finally
          DoCursorDefault;
        end;
      except
        on E: EMCIDeviceError do
          ShowMediaError(E.Message)
        else
          ShowMediaError('');
      end;
    {$endif}

    {$ifdef MEDIA_WMP64}
    if (FMediaMode = vmmodeWMP64) and Assigned(FWMP6) then
      try
        with FWMP6 do
        begin
          VideoBorder3D := FBorderStyleInner <> bsNone;
          ShowStatusBar := True;
          Show;
          if CanSetFocus then
            SetFocus;

          Volume:= Vol_AtoW6(FMediaVolume);
          Mute:= FMediaMute;
          PlayCount := FMediaPlayCount;
          AutoStart := FMediaAutoPlay;
          SetMediaFit_WMP6(FWMP6);
          SetMediaPosition;

          FileName := FFileName;
        end;
      except
        on E: Exception do
          ShowMediaError(E.Message);
      end;
    {$endif}

    {$ifdef MEDIA_WMP9}
    if (FMediaMode = vmmodeWMP9) and Assigned(FWMP9) then
      try
        with FWMP9 do
        begin
          Show;
          if CanSetFocus then
            SetFocus;

          Settings.Volume:= Vol_AtoW9(FMediaVolume);
          Settings.Mute:= FMediaMute;
          Settings.PlayCount := FMediaPlayCount;
          Settings.AutoStart := FMediaAutoPlay;
          SetMediaFit_WMP9(FWMP9);
          SetMediaPosition;

          URL := FFileName;
        end;
      except
        on E: Exception do
          ShowMediaError(E.Message);
      end;
    {$endif}
  end;
end;

procedure TATViewer.LoadBinary;
var
  ANewFile: Boolean;
begin
  //Is file new for ATBinHex component?
  ANewFile := FFileName <> FBinHex.FileName;

  //Clear data only when file is new,
  //and clear search anyway:
  if ANewFile then
    FreeData;
  FreeSearch;

  with FBinHex do
  begin
    Color := FTextColor;
    BorderStyle := FBorderStyleInner;
    TextEncoding := FTextEncoding;
    TextWrap := FTextWrap;

    case Self.FMode of
      vmodeText:
        Mode := vbmodeText;
      vmodeBinary:
        Mode := vbmodeBinary;
      vmodeHex:
        Mode := vbmodeHex;
      vmodeUnicode:
        //If Unicode mode already activated, switch to UHex mode:
        if (not ANewFile) and (Mode = vbmodeUnicode) then
          Mode := vbmodeUHex
        else
          Mode := vbmodeUnicode;
    end;

    if ANewFile then
      Open(FFileName);