atviewer.pas

支持版本:Delphi 5-2009, C++Builder 5-2009 ATViewer特性： Text, Binary, Hex, Unicode：所有文件

begin
  {$ifdef MEDIA_PLAYER}
  if Assigned(FMedia) then
  begin
    FMediaPanel.Hide;
    FMedia.Enabled := False;
    FMediaBar.Enabled := False;
  end;
  {$endif}

  {$ifdef MEDIA_WMP64}
  if Assigned(FWMP6) then
    FWMP6.Hide;
  {$endif}

  {$ifdef MEDIA_WMP9}
  if Assigned(FWMP9) then
    FWMP9.Hide;
  {$endif}
end;

procedure TATViewer.HideEdit;
begin
  if Assigned(FEdit) then
    FEdit.Hide;
end;

procedure TATViewer.HideImage;
begin
  if Assigned(FImageBox) then
    FImageBox.Hide;
end;

procedure TATViewer.HideWeb;
begin
  if Assigned(FBrowser) then
    FBrowser.Hide;
end;


function TATViewer.Open(const AFileName: WideString; APicture: TPicture = nil): Boolean;
var
  NewFileName: WideString;
begin
  Result := True;

  //Need to expand given filename, since filename can be passed from application
  //without path at all, and this causes problems with WebBrowser and plugins.
  NewFileName := FGetFullPathName(AFileName);

  if (FFileName <> NewFileName) then
  begin
    DoFileUnload;

    FFileName := NewFileName;
    FGetFileInfo(FFileName, FFileSize, FFileTime);
    FreeData;

    if FFileName = '' then
    begin
      HideAll;
      //Wait for PDF:
      while WebBusy do Application.ProcessMessages;
      Exit
    end;

    if not IsFileExist(FFileName) then
    begin
      FFileName := '';
      HideAll;
      MsgError(SFormatW(MsgViewerErrCannotFindFile, [NewFileName]));
      Result := False;
      Exit
    end;

    if not IsFileAccessed(FFileName) then
    begin
      FFileName := '';
      HideAll;
      MsgError(SFormatW(MsgViewerErrCannotOpenFile, [NewFileName]));
      Result := False;
      Exit
    end;

    if FModeDetect then
      DetectMode; //LoadWLX called implicitly

    HideAll;

    case FMode of
      vmodeText,
      vmodeBinary,
      vmodeHex,
      vmodeUnicode:
        LoadBinary;
      vmodeRTF:
        LoadRTF;
      vmodeMedia:
        LoadMedia(APicture);
      vmodeWeb:
        LoadWeb;
      {$ifdef WLX}
      vmodeWLX:
        begin
          //When FModeDetect=True, there is no need to call LoadWLX here,
          //it's already called in DetectMode above.
          if not FModeDetect then
            LoadWLX;
        end;
      {$endif}
    end;

    DoFileLoad;
  end;
end;


{$ifdef WLX}
function TATViewer.OpenFolder(const AFolderName: WideString): Boolean;
var
  NewFolderName: WideString;
begin
  Result := True;

  //Need to expand given filename, since filename can be passed from application
  //without path at all, and this causes problems with WebBrowser and plugins.
  NewFolderName := FGetFullPathName(AFolderName);

  if (FFileName <> NewFolderName) then
  begin
    DoFileUnload;

    FFileName := NewFolderName;
    FFileSize := 0;
    FillChar(FFileTime, SizeOf(FFileTime), 0);

    FMode := vmodeWLX;
    FreeData;
    HideAll;

    if FFileName = '' then
    begin
      Exit
    end;

    if not IsDirExist(FFileName) then
    begin
      MsgError(SFormatW(MsgViewerErrCannotFindFolder, [NewFolderName]));
      FFileName := '';
      Result := False;
      Exit
    end;

    if not OpenByPlugins(True) then
    begin
      FFileName := '';
      Result := False;
      Exit;
    end;

    DoFileLoad;
  end;
end;
{$endif}

procedure TATViewer.Reload;
begin
  Assert(FFileName <> '', 'File not loaded: Reload');

  SetMode(FMode);
end;


procedure TATViewer.FreeSearch;
begin
  {$ifdef SEARCH}
  FFindText := '';
  FFindOptions := [];
  FFindFinished := False;
  {$endif}
end;

procedure TATViewer.FreeData(AFreeImage: Boolean = True);
begin
  FBinHex.Open('', False);

  FIsImageBefore := Assigned(FImageBox) and Assigned(FImageBox.Image.Picture.Graphic);
  if FIsImageBefore and AFreeImage 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: AnsiString;
begin
  Result := ATViewerOptions.ExtImages;
  {$ifdef IVIEW}
  if IViewIntegration.Enabled then
    Result := Result + ',' + IViewIntegration.ExtList;
  {$endif}
end;

procedure TATViewer.LoadImage(APicture: TPicture = nil);
  //
  {$ifdef ANI}
  function LoadAni: Boolean;
  var
    b: TBitmap;
    IL: TImageList;
    h: THandle;
    i: Integer;
    s1, s2: AnsiString;
  const
    CH = 16; //row height
    CF = 9; //font size
    C2 = 2; //border 2px
  begin
    Result := False;
    h := _GetFrames(Handle, PAnsiChar(FFileNameWideToAnsi(FFileName)));
    if h = 0 then Exit;

    s1 := MsgViewerAniTitle + _GetCursorTitle(Handle, PAnsiChar(FFileNameWideToAnsi(FFileName)));
    s2 := MsgViewerAniCreator + _GetCursorCreator(Handle, PAnsiChar(FFileNameWideToAnsi(FFileName)));

    IL := TImageList.Create(Self);
    b := TBitmap.Create;
    try
      IL.Handle := h;

      b.PixelFormat := pf16bit;
      b.Canvas.Font.Name := Font.Name;
      b.Canvas.Font.Size := CF;
      b.Canvas.Font.Color := clBtnText;
      b.Width := IMax(IMax(
        IL.Width * IL.Count,
        b.Canvas.TextWidth(s1)),
        b.Canvas.TextWidth(s2)) + C2 * 2;
      b.Height := IL.Height + CH * 2 + C2 * 3;

      b.Canvas.Brush.Color := clBtnface;
      b.Canvas.FillRect(Rect(0, 0, b.Width, b.Height));
      b.Canvas.TextOut(C2, C2, s1);
      b.Canvas.TextOut(C2, C2 + CH, s2);
      for i := 0 to IL.Count - 1 do
        IL.Draw(b.Canvas, C2 + i * IL.Width, CH * 2 + C2 * 2, i);

      FImageBox.Image.Transparent := False;
      FImageBox.Image.Picture.Assign(b);
      FImageBox.UpdateImageInfo;
      Result := True;
    finally
      b.Free;
      IL.Free;
    end;
  end;
  {$endif}

  //
  function LoadCur: Boolean;
  const
    cSize = 32; //max cursor size
  var
    h: HCursor;
    B: TBitmap;
  begin
    {if Win32Platform = VER_PLATFORM_WIN32_NT then
      h := LoadCursorFromFileW(PWideChar(FFileName))
    else }
      h := LoadCursorFromFileA(PAnsiChar(FFileNameWideToAnsi(FFileName)));

    Result := h <> 0;
    if Result then
    begin
      B := TBitmap.Create;
      try
        B.PixelFormat := pf16bit;
        B.Width := cSize;
        B.Height := cSize;
        B.Canvas.Brush.Color := clBtnface;
        B.Canvas.FillRect(Rect(0, 0, b.Width, b.Height));
        DrawIcon(B.Canvas.Handle, 0, 0, h);

        FImageBox.Image.Transparent := False;
        FImageBox.Image.Picture.Assign(b);
        FImageBox.UpdateImageInfo;
      finally
        B.Free;
        DestroyCursor(h);
      end;
    end;
  end;

  //
  {$ifdef IVIEW}
  function LoadImageWithIView: Boolean;
  var
    Bmp: TBitmap;
  begin
    FIsImageIView := True;

    //if IView exe does not exist, raise special exception:
    if not IsFileExist(IViewIntegration.ExeName) then
    begin
      raise EInvalidGraphic.Create(
        SFormatW(MsgViewerErrCannotFindFile, [IViewIntegration.ExeName]) );
    end;

    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(FFileNameWideToAnsi(FFileName));
        Host := '';
      end;
      Result := Bmp.Handle <> 0;
      if Result then
      begin
        //If IView could load 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 file, raise an exception that
        //will be immediately handled and "Unsupported image format"
        //message will be shown:
        raise Exception.Create('');