⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 atviewer.pas

📁 支持版本:Delphi 5-2009, C++Builder 5-2009 ATViewer特性: Text, Binary, Hex, Unicode:所有文件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      end;
    finally
      Bmp.Free;
    end;
  end;
  {$endif}

  //
  procedure LoadImageWithDelphi;
  begin
    FImageBox.Image.Picture.LoadFromFile(FFileName);
    FImageBox.UpdateImageInfo;
  end;

  //
  {$ifdef IJL}
  function LoadImageWithIJL: Boolean;
  var
    bmp: TBitmap;
  begin
    Result := False;
    FIsImageIJL := True;

    //Load IJL dinamycally here
    if (ijlLib = 0) then
      if not LoadIJL then Exit;

    bmp := TBitmap.Create;
    try
      if LoadBmpFromJpegFile(bmp, FFileNameWideToAnsi(FFileName), True) then
      begin
        FImageBox.Image.Transparent := False;
        FImageBox.Image.Picture.Assign(bmp);
        FImageBox.UpdateImageInfo;
        Result := True;
      end;
    finally
      bmp.Free;
    end;
  end;
  {$endif}

  //
  procedure LoadImageFromPicture(APicture: TPicture);
  begin
    FImageBox.Image.Picture.Assign(APicture);
    FImageBox.UpdateImageInfo;
  end;

  //
  procedure UnloadImage;
  begin
    FImageBox.Image.Picture := nil;
    FImageBox.UpdateImageInfo;
  end;

  //
  procedure ShowImageError(const Msg: AnsiString);
  begin
    UnloadImage;
    FImageError := True;
    FImageErrorMessage := Msg;
    if FImageErrorMessageBox then
      MsgError(Msg);
  end;
  //

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

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

        //Load from TPicture object
        if Assigned(APicture) then
        begin
          LoadImageFromPicture(APicture);
          Exit;
        end;

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

        {$ifdef ANI}
        //1a) Load ANI
        if SFileExtensionMatch(FFileName, 'ani') then
        begin
          if not LoadAni then
            raise EInvalidGraphic.Create(Format(MsgViewerErrCannotLoadFile, ['AmnAni.dll']));
          Exit;
        end;
        {$endif}

        //1b) Load CUR
        if SFileExtensionMatch(FFileName, 'cur') then
        begin
          if not LoadCur then
            raise Exception.Create('');
          Exit;
        end;

        {$ifdef IJL} 
        //2) Load with IJL
        if FIJLIntegration.Enabled then
          if SFileExtensionMatch(FFileName, FIJLIntegration.ExtList) then
          begin
            if LoadImageWithIJL then Exit;
          end;
        {$endif}

        //3) Load with Delphi
        if SFileExtensionMatch(FFileName, ATViewerOptions.ExtImages) then
        begin
          try
            LoadImageWithDelphi;
          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}
        //4) 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;
        FImageBPP := GetImageBPP; //Updated only on image reading
      end;
    except
      on E: EInvalidGraphic do
        ShowImageError(E.Message)
      else
        ShowImageError(MsgViewerErrImage);
    end;
end;

procedure TATViewer.LoadMedia(APicture: TPicture = nil);
  //
  procedure ShowMediaError(const Msg: AnsiString);
  begin
    if Msg <> '' then
      MsgError(Msg)
    else
      MsgError(MsgViewerErrMedia);
  end;
  //
begin
  Assert(FFileName <> '', 'FileName not assigned');

  if SFileExtensionMatch(FFileName, ActualExtImages) then
    try
      FreeData(False);
      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 := SFileExtensionMatch(FFileName, 'ico'); //FImageBox.Image.Picture.Graphic is TIcon;
        FIsMetafile := FImageBox.Image.Picture.Graphic is TMetafile;
      end;
    except
    end

  else
  begin
    FreeData;
    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;
          ShowControls := FWMP6Controls;
          ShowTracker := FWMP6Tracker;

          Show;
          if CanSetFocus then
            SetFocus;

          Volume:= Vol_AtoW6(FMediaVolume);
          Mute:= FMediaMute;
          if FMediaLoop then
            PlayCount := MaxInt
          else
            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;
          if FMediaLoop then
            Settings.PlayCount := MaxInt
          else
            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
  Assert(FFileName <> '', 'FileName not assigned');

  //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);

    Show;
    if CanSetFocus then
      SetFocus;
  end;
end;

procedure TATViewer.LoadRTF;
begin
  Assert(FFileName <> '', 'FileName not assigned');
  FreeData;

  InitEdit;
  if Assigned(FEdit) then
    with FEdit do
    begin
      //work around RichEdit bug, reset font
      Font.Name := 'Webdings';
      Font.Size := 8;
      Font.Color := clWhite;
      Font := GetTextFont;

      //RichEdit bug: WordWrap assignment must be after Font assignment, or font will be broken
      Color := FTextColor;
      WordWrap := FTextWrap;
      BorderStyle := FBorderStyleInner;
      
      try
        try
          DoCursorHours;
          RE_LoadFile(FEdit, FFileName, 0, 0);
          TextSelectionChange(Self);
        finally
          DoCursorDefault;
        end;
      except
        MsgError(SFormatW(MsgViewerErrCannotLoadFile, [FFileName]));
      end;

      Show;
      if CanSetFocus then
        SetFocus;
    end;
end;

procedure TATViewer.LoadWeb;
begin
  Assert(FFileName <> '', 'FileName not assigned');
  FreeData;

  InitWeb;
  if Assigned(FBrowser) then
    try
      if WebBrowserSafe then
        if FBorderStyleInner = bsNone then
          WB_Set3DBorderStyle(FBrow

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -