
{*******************************************************}
{                                                       }
{       RVLister                                        }
{       DLL - plugin for Total Commander.               }
{       Viewing and printing RVF files.                 }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       svt@trichview.com                               }
{       https://www.trichview.com                        }
{                                                       }
{       Total Commander (c) Christian Ghisler           }
{       http://www.ghisler.com                          }
{                                                       }
{*******************************************************}

{
  History:
  2021-Jan-24: v2.1 - 32-bit version fixed
  2021-Jan-22: v2.0 - DOCX and RTF support, thumbnails
  2015-May-04: Unicode support, 64-bit support
  2008-Feb-19: Support for gif animation
  2004-Jan-01: Initial release
}

{
 1. This viewer overrides the default viewer for RTF files.
 To disable RTF, find the line:
    // comment the next line to disable viewing RTF files
 and comment the next line after it.

 2. When making thumbnails, this plugin reads the initial MAX_FILE_SIZE bytes
 from a file (200Kb by default).

}

library RVLister;

uses
  AnsiStrings, SysUtils, Windows, Messages, Classes, Forms, Controls,
  Graphics, Math, Dialogs, Printers, ShellApi, StdCtrls,
  RVStyle, RVScroll, RichView, RVReport, PtblRV,
  PngImage, CRVFData, RVGifAnimate2007, RVUni,
  listplug in 'listplug.pas';

{$R *.res}

const RVFExt = 'RVF';

// Fake object for event processing
type
  TFakeObject = class
    procedure DoJump(Sender: TObject; id: Integer);
    procedure DoVScrolled(Sender: TObject);
  end;

procedure TFakeObject.DoJump(Sender: TObject; id: Integer);
var RVData: TCustomRVFormattedData;
    ItemNo: Integer;
begin
  TRichView(Sender).GetJumpPointLocation(id, RVData, ItemNo);
  ShellExecute(0, 'open', PChar(RVData.GetItemTag(ItemNo)), nil, nil, SW_SHOW);
end;

procedure TFakeObject.DoVScrolled(Sender: TObject);
var rv: TRichView;
    pos: Integer;
begin
  rv := TRichView(Sender);
  pos := rv.VScrollPos*rv.VSmallStep+rv.ClientHeight;
  pos := MulDiv(pos,100,rv.DocumentHeight);
  if pos>100 then
    pos := 100;
  PostMessage(rv.ParentWindow,WM_COMMAND, MAKELONG(pos,itm_percent), rv.Handle);
end;

var obj: TFakeObject = nil;
{------------------------------------------------------------------------------}
// Returning string which will be used by TC for determining if this plugin
// can display the given file
procedure ListGetDetectString(DetectString: PAnsiChar; maxlen: Integer); stdcall;
var
  S: AnsiString;
begin
  S :=
   '(EXT="'+RVFExt+'" & [0]="-" & [1]="8" & [2]=" " & [3]="1")|' +
   // comment the next line to disable viewing RTF files
   '(EXT="RTF" & [0]="{" & [1]="\" & [2]="r" & [3]="t" & [4]="f")|'+
   '(EXT="DOCX")';
  // MessageBoxA(0, PAnsiChar(S), 'ListGetDetectString', 0);
  AnsiStrings.StrCopy(DetectString, PAnsiChar(S));
end;
{------------------------------------------------------------------------------}
procedure SetRVProps(rv: TCustomRichView);
begin
  rv.RTFReadProperties.TextStyleMode := rvrsAddIfNeeded;
  rv.RTFReadProperties.ParaStyleMode := rvrsAddIfNeeded;
  rv.RVFTextStylesReadMode := rvf_sInsertMerge;
  rv.RVFParaStylesReadMode := rvf_sInsertMerge;
  rv.RVFOptions := rv.RVFOptions + [rvfoIgnoreUnknownPicFmt,
    rvfoIgnoreUnknownCtrls, rvfoConvUnknownStylesToZero,
    rvfoConvLargeImageIdxToZero, rvfoLoadBack, rvfoLoadLayout];
end;
{------------------------------------------------------------------------------}
// Creating viewer control
function ListLoadW(ParentWin:THandle; FileToLoad:PChar;
  ShowFlags:Integer):THandle; stdcall;
var
  rv: TRichView;
  Stream: TFileStream;
begin
  // MessageBox(0, 'ListLoad', 'ListLoad', 0);
  rv := TRichView.Create(nil);
  rv.ParentWindow := ParentWin;
  Result := rv.Handle;
  rv.Style := TRVStyle.Create(rv);
  rv.AnimationMode := rvaniOnFormat;
  if (ShowFlags and lcp_wraptext)<>0 then
    rv.Options := rv.Options + [rvoClientTextWidth];
  SetRVProps(rv);

  rv.OnJump := obj.DoJump;
  rv.OnVScrolled := obj.DoVScrolled;
  rv.OnResize := obj.DoVScrolled;

  try
    Stream := TFileStream.Create(FileToLoad, fmOpenRead or fmShareDenyWrite);
    try
      Screen.Cursor := crHourGlass;
      rv.LoadFromStream(Stream, rvynaAuto);
    finally
      Stream.Free;
      Screen.Cursor := crDefault;
    end;
    rv.Format;
  except
    rv.Free;
    Result := 0;
  end;
end;
{------------------------------------------------------------------------------}
// Creating viewer control (non-Unicode)
function ListLoad(ParentWin:THandle; FileToLoad:PAnsiChar;
  ShowFlags:Integer):THandle; stdcall;
var
  S: String;
begin
  S := RVU_AnsiToUnicode(CP_ACP, FileToLoad);
  Result := ListLoadW(ParentWin, PChar(S), ShowFlags);
end;
{------------------------------------------------------------------------------}
// Destroying viewer control
procedure ListCloseWindow(ListWin: THandle); stdcall;
begin
  //MessageBox(0, 'ListCloseWindow', 'ListCloseWindow', 0);
  FindControl(ListWin).Free;
end;
{------------------------------------------------------------------------------}
// Processing commands from TC
function ListSendCommand(ListWin: THandle;
  Command,Parameter: Integer):Integer; stdcall;
var rv: TRichView;
begin
  //MessageBox(0, 'ListSendCommand', 'ListSendCommand', 0);
  Result := LISTPLUGIN_ERROR;
  rv := TRichView(FindControl(ListWin));
  if rv=nil then begin
    exit;
  end;
  case Command of
    lc_copy:
      rv.CopyDef;
    lc_selectall:
      begin
        rv.SelectAll;
        rv.Invalidate;
      end;
    lc_setpercent:
      begin
        Parameter := MulDiv(Parameter, rv.DocumentHeight, 100);
        dec(Parameter, rv.ClientHeight);
        rv.ScrollTo(Parameter);
      end;
    lc_newparams:
      begin
        if ((lcp_wraptext and Parameter)<>0) and
           not (rvoClientTextWidth in rv.Options) then begin
          rv.Options := rv.Options + [rvoClientTextWidth];
          rv.Format;
          end
        else if ((lcp_wraptext and Parameter)=0) and
          (rvoClientTextWidth in rv.Options) then begin
          rv.Options := rv.Options - [rvoClientTextWidth];
          rv.Format;
        end;
      end;
  end;
  Result := LISTPLUGIN_OK;
end;
{------------------------------------------------------------------------------}
// Searching text
function ListSearchTextW(ListWin: THandle; SearchString: PChar;
  SearchParameter:integer):integer; stdcall;
var Options: TRVSearchOptions;
  rv: TRichView;
begin
  Result := LISTPLUGIN_ERROR;
  rv := TRichView(FindControl(ListWin));
  if rv=nil then begin
    exit;
  end;
  if (SearchParameter and lcs_matchcase)<>0 then
    Include(Options, rvsroMatchCase);
  if (SearchParameter and lcs_wholewords)<>0 then
    Include(Options, rvsroWholeWord);
  if (SearchParameter and lcs_backwards)=0 then
    Include(Options, rvsroDown);
  if rv.SearchText(SearchString, Options) then
    Result := LISTPLUGIN_OK
  else
    Result := LISTPLUGIN_ERROR;
end;
{------------------------------------------------------------------------------}
// Searching text (non-Unicode)
function ListSearchText(ListWin: THandle; SearchString: PAnsiChar;
  SearchParameter:integer):integer; stdcall;
var
  S: String;
begin
  S := RVU_AnsiToUnicode(CP_ACP, SearchString);
  Result := ListSearchTextW(ListWin, PChar(S), SearchParameter);
end;
{------------------------------------------------------------------------------}
{ Printing }
function ListPrintW(ListWin: THandle; FileToPrint, DefPrinter:PChar;
  PrintFlags: Integer;var Margins:TRect): Integer; stdcall;
var
  rv: TRichView;
  rvp: TRVPrint;
  pd: TPrintDialog;
begin
  Result := LISTPLUGIN_ERROR;
  rv := TRichView(FindControl(ListWin));
  if (rv=nil) or (rv.ItemCount=0) then
    exit;
  if DefPrinter=nil then
    Printer.PrinterIndex := -1
  else
    Printer.PrinterIndex := Printer.Printers.IndexOf(DefPrinter);
  rvp := TRVPrint.Create(rv);
  try
    rvp.LeftMarginMM   := Round(Margins.Left/10);
    rvp.RightMarginMM  := Round(Margins.Right/10);
    rvp.TopMarginMM    := Round(Margins.Top/10);
    rvp.BottomMarginMM := Round(Margins.Bottom/10);
    rvp.AssignSource(rv);
    rvp.FormatPages(rvdoALL);
    pd := TPrintDialog.Create(nil);
    try
      pd.Options := [poPageNums];
      pd.MinPage := 1;
      pd.MaxPage := rvp.PagesCount;
      pd.FromPage := 1;
      pd.ToPage := rvp.PagesCount;
      if pd.Execute then
        case pd.PrintRange of
          prAllPages:
            rvp.Print(ExtractFileName(FileToPrint), pd.Copies, False);
          prPageNums:
            rvp.PrintPages(pd.FromPage, pd.ToPage, ExtractFileName(FileToPrint),
              pd.Copies, False);
        end;
    finally
      pd.Free;
    end;
  finally
    rvp.Free;
  end;
  Result := LISTPLUGIN_OK
end;
{------------------------------------------------------------------------------}
{ Printing (non-Unicode) }
function ListPrint(ListWin: THandle; FileToPrint,DefPrinter: PAnsiChar;
  PrintFlags: Integer; var Margins: TRect): Integer; stdcall;
var
  FTP, DP: String;
begin
  FTP := RVU_AnsiToUnicode(CP_ACP, FileToPrint);
  DP  := RVU_AnsiToUnicode(CP_ACP, DefPrinter);
  Result := ListPrintW(ListWin, PChar(FTP), PChar(DP), PrintFlags, Margins);
end;
{------------------------------------------------------------------------------}
const
  THUMB_ZOOMOUT = 2;
  MAX_FILE_SIZE = 200 * 1024;

{ Thumbnails }
function ListGetPreviewBitmapW(FileToLoad: PChar; width, height: Integer;
  contentbuf: PAnsiChar; contentbuflen: Integer): HBITMAP; stdcall;
var
  RVReport: TRVReportHelper;
  bmp: TBitmap;
  Stream: TMemoryStream;
  FileStream: TFileStream;
  Ext: String;
  {............................................................................}
  procedure LoadFile;
  begin
    if Ext = '.RVF' then
      RVReport.RichView.LoadRVFFromStream(Stream)
    else if Ext = '.RTF' then
      RVReport.RichView.LoadRTFFromStream(Stream)
    else if Ext = '.DOCX' then
      RVReport.RichView.LoadDocXFromStream(Stream);
  end;
  {............................................................................}
begin
  Result := 0;
  if contentbuflen = 0 then
    exit;
  try
    Ext := String(FileToLoad);
    Ext := AnsiUpperCase(ExtractFileExt(Ext));

    RVReport := TRVReportHelper.Create(nil);
    try
      RVReport.RichView.Style := TRVStyle.Create(RVReport);
      RVReport.RichView.Options := RVReport.RichView.Options + [rvoClientTextWidth];
      SetRVProps(RVReport.RichView);
      Stream := TMemoryStream.Create;
      try
        {
        // uncomment these lines to trying checking TotalCommander's data first
        // (should be 8K)
        Stream.Size := contentbuflen;
        CopyMemory(Stream.Memory, contentbuf, contentbuflen);
        LoadFile;
        }
        if RVReport.RichView.ItemCount = 0 then
        begin
          FileStream := TFileStream.Create(FileToLoad, fmOpenRead or fmShareDenyWrite);
          try
            Stream.Clear;
            Stream.CopyFrom(FileStream, Min(MAX_FILE_SIZE, FileStream.Size));
            Stream.Position := 0;
          finally
            FileStream.Free;
          end;
          LoadFile;
          if RVReport.RichView.ItemCount = 0 then
            exit;
        end;
      finally
        Stream.Free;
      end;
      bmp := TBitmap.Create;
      try
        bmp.SetSize(width, height);
        RVReport.Init(bmp.Canvas, width * THUMB_ZOOMOUT);
        RVReport.FormatNextPage(height * THUMB_ZOOMOUT);
        RVReport.DrawPreview(1, bmp.Canvas, Rect(0, 0, width, height));
        Result := bmp.ReleaseHandle;
      finally
        bmp.Free;
      end;
    finally
      RVReport.Free;
    end;
  except
    Result := 0;
  end;
end;
{------------------------------------------------------------------------------}
{ Thumbnails (non-Unicode) }
function ListGetPreviewBitmap(FileToLoad: PAnsiChar; width, height: Integer;
  contentbuf: PAnsiChar; contentbuflen: Integer): HBITMAP; stdcall;
var
  S: String;
begin
  S := RVU_AnsiToUnicode(CP_ACP, FileToLoad);
  Result := ListGetPreviewBitmapW(PChar(S), width, height, contentbuf,
    contentbuflen);
end;
{------------------------------------------------------------------------------}
exports
  ListLoadW, ListLoad,
  ListCloseWindow, ListGetDetectString, ListSendCommand,
  ListSearchTextW, ListSearchText,
  ListPrintW, ListPrint,
  ListGetPreviewBitmapW, ListGetPreviewBitmap;

{------------------------------------------------------------------------------}

begin
  RegisterClasses([TButton, TEdit, TCheckBox, TListBox, TComboBox, TMemo, TLabel]);

end.
