atviewer.pas

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

    FPrintDialog := TPrintDialog.Create(Self);
  end;

  if not Assigned(FPageSetupDialog) then
  begin
    FPageSetupDialog := TPageSetupDialog.Create(Self);
    FPageSetupDialog.Units := pmMillimeters;
  end;
end;
{$endif}

procedure TATViewer.InitEdit;
begin
  if not Assigned(FEdit) then
  begin
    FEdit := TRichEditURL.Create(Self);
    with FEdit do
    begin
      Parent := Self;
      Align := alClient;
      ReadOnly := True;
      ScrollBars := ssBoth;
      HideSelection := False;
      OnSelectionChange := TextSelectionChange;
      TRichEditURL(FEdit).OnURLClick := EditURLClick;
    end;

    FEditMenuItemCopy := TMenuItem.Create(Self);
    with FEditMenuItemCopy do
    begin
      Caption := 'Copy';
      OnClick := EditMenuItemCopyClick;
    end;

    FEditMenuItemSelectAll := TMenuItem.Create(Self);
    with FEditMenuItemSelectAll do
    begin
      Caption := 'Select all';
      OnClick := EditMenuItemSelectAllClick;
    end;

    FEditMenuItemSep := TMenuItem.Create(Self);
    with FEditMenuItemSep do
    begin
      Caption := '-';
    end;

    FEditMenu := TPopupMenu.Create(Self);
    with FEditMenu do
    begin
      Items.Add(FEditMenuItemCopy);
      Items.Add(FEditMenuItemSep);
      Items.Add(FEditMenuItemSelectAll);
    end;

    FEdit.PopupMenu := FEditMenu;
  end;
end;

procedure TATViewer.InitImage;
begin
  if not Assigned(FImageBox) then
  begin
    FImageBox := TATImageBox.Create(Self);
    with FImageBox do
    begin
      Width := 1; //To "hide" control initially during image loading
      Height := 1;
      Parent := Self;
      Align := alClient;
      OnOptionsChange := Self.FOnOptionsChange;
    end;
  end;
end;

procedure TATViewer.InitMediaEndTimer;
begin
  if not Assigned(FMediaEndTimer) then
  begin
    FMediaEndTimer := TTimer.Create(Self);
    with FMediaEndTimer do
    begin
      Enabled := False;
      Interval := 500;
      OnTimer := MediaEndTimerTimer;
    end;
  end;
end;

procedure TATViewer.InitMedia;
begin
  InitMediaEndTimer;

  {$ifdef MEDIA_PLAYER}
  if (FMediaMode = vmmodeMCI) and not Assigned(FMedia) then
  begin
    FMediaPanel := TPanel.Create(Self);
    with FMediaPanel do
    begin
      Caption := '';
      BevelOuter := bvNone;
      Parent := Self;
      Align := alClient;
    end;

    FMediaPanel1 := TPanel.Create(Self);
    with FMediaPanel1 do
    begin
      Caption := '';
      BevelOuter := bvNone;
      Parent := FMediaPanel;
      Align := alBottom;
      Height := 30;
    end;

    FMediaPanel2 := TPanel.Create(Self);
    with FMediaPanel2 do
    begin
      Caption := '';
      BevelOuter := bvNone;
      Parent := FMediaPanel;
      Align := alClient;
    end;

    FMedia := TMediaPlayer.Create(Self);
    with FMedia do
    begin
      Parent := FMediaPanel1;
      Height := FMediaPanel1.Height;
      Display := FMediaPanel2;
      VisibleButtons := [btPlay, btPause, btStop];
      AutoRewind := True;
      Shareable := False;
      TimeFormat := tfMilliseconds;
      Notify := True;
      OnNotify := MediaNotify;
    end;

    FMediaBar := TTrackBar.Create(Self);
    with FMediaBar do
    begin
      Parent := FMediaPanel1;
      Left := 90;
      Top := 2;
      Width := 100;
      Height := FMediaPanel1.Height - 2 * Top;
      PageSize := 10; 
      TickMarks := tmBoth;
      TickStyle := tsNone;
      ThumbLength := 18;
      OnChange := MediaBarChange;
    end;

    FMediaTimer := TTimer.Create(Self);
    with FMediaTimer do
    begin
      OnTimer := MediaTimerTimer;
    end;
  end;
  {$endif}

  {$ifdef MEDIA_WMP64}
  if (FMediaMode = vmmodeWMP64) and not Assigned(FWMP6) then
    try
      FWMP6 := TWMP.Create(Self);
      with FWMP6 do
      begin
        Align := alClient;
        Parent := Self;
        //Parent assignment must be after Align assignment!
        AutoStart := False;
        AutoRewind := True;
        OnPlayStateChange := PlayStateChange_WMP6;
      end;
    except
      MsgError(Format(MsgViewerErrInitControl, ['Windows Media Player 6.4 ActiveX']));
    end;
  {$endif}

  {$ifdef MEDIA_WMP9}
  if (FMediaMode = vmmodeWMP9) and not Assigned(FWMP9) then
    try
      FWMP9 := TWMP9.Create(Self);
      with FWMP9 do
      begin
        Align := alClient;
        Parent := Self;
        //Parent assignment must be after Align assignment!
        Settings.AutoStart := False;
        OnPlayStateChange := PlayStateChange_WMP9;
      end;
    except
      MsgError(Format(MsgViewerErrInitControl, ['Windows Media Player 9 ActiveX']));
    end;
  {$endif}

  HideMedia;
end;

procedure TATViewer.InitWeb;
begin
  if not Assigned(FBrowser) then
  begin
    FBrowser := TWebBrowser.Create(Self);
    with FBrowser do
    begin
      TControl(FBrowser).Parent := Self;
      Align := alClient;
      Silent := True;
      //Workaround for WebBrowser bug: it first opens BMP files
      //in a new window:
      Navigate('about:blank');
      OnDocumentComplete := WebBrowserDocumentComplete;
      OnNavigateComplete2 := WebBrowserNavigateComplete2;
      {$ifdef IE4X}
      OnFileDownload := WebBrowserFileDownload;
      {$endif}
    end;
    HideWeb;
  end;
end;

procedure TATViewer.FreeMedia;
begin
  {$ifdef MEDIA_PLAYER}
  if Assigned(FMedia) then
  begin
    FMediaTimer.Free;
    FMediaBar.Free;
    FMedia.Free;
    FMediaPanel1.Free;
    FMediaPanel2.Free;
    FMediaPanel.Free;

    FMediaTimer := nil;
    FMediaBar := nil;
    FMedia := nil;
    FMediaPanel1 := nil;
    FMediaPanel2 := nil;
    FMediaPanel := nil;
  end;
  {$endif}
    
  {$ifdef MEDIA_WMP64}
  if Assigned(FWMP6) then
  begin
    FWMP6.Parent := nil;
    FWMP6.Free;
    FWMP6 := nil;
  end;
  {$endif}

  {$ifdef MEDIA_WMP9}
  if Assigned(FWMP9) then
  begin
    FWMP9.Parent := nil;
    FWMP9.Free;
    FWMP9 := nil;
  end;
  {$endif}
end;

procedure TATViewer.HideAll;
var
  IsEmpty, IsImage: Boolean;
begin
  IsEmpty := (FFileName = '');
  IsImage := (FFileName <> '') and SFileExtensionMatch(FFileName, ActualExtImages);

  //Hide Edit/BinHex/Browser controls when different mode is set
  if IsEmpty or not (FMode in [vmodeText, vmodeBinary, vmodeHex, vmodeUnicode]) then
    FBinHex.Hide;

  if IsEmpty or (FMode <> vmodeRTF) then
    HideEdit;

  if IsEmpty or (FMode <> vmodeWeb) then
    HideWeb;

  //Hide image control when non-image is to be loaded
  if IsEmpty or (FMode <> vmodeMedia) or (not IsImage) then
    HideImage;

  //Hide media control when non-media is to be loaded
  if IsEmpty or (FMode <> vmodeMedia) or IsImage then
    HideMedia;

  //Hide plugins when different mode is set
  {$ifdef WLX}
  if IsEmpty or (FMode <> vmodeWLX) then
    HideWLX;
  {$endif}
end;

procedure TATViewer.HideMedia;
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;
      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.FreeSearch;
begin
  {$ifdef SEARCH}
  FFindText := '';
  FFindOptions := [];
  FFindFinished := False;
  {$endif}
end;

procedure TATViewer.FreeData;
begin