wlxproc.pas

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

  {$ifdef WLX_FORM}
  if Assigned(FTCWindow) then
  begin
    FTCWindow.Release;
    FTCWindow := nil;
  end;
  {$endif}
end;

function TWlxPlugins.Load(n: Word): Boolean;
var
  dps: TListDefaultParamStruct;
begin
  Result := False;
  if not IsIndexValid(n) then Exit;

  {$ifdef WLX_FORM}
  if not Assigned(FTCWindow) then
  begin
    FTCWindow := TTOTAL_CMD.Create(nil);
    FTCWindow.Visible := False;
  end;
  {$endif}

  with FPlugins[n] do
  begin
    if HLib <> 0 then
      begin Result := True; Exit end;

    Unload(n);
    
    HLib := LoadLibrary(PChar(FileName));
    if HLib = 0 then Exit;

    ListLoad := GetProcAddress(HLib, 'ListLoad');
    ListLoadNext := GetProcAddress(HLib, 'ListLoadNext');
    ListCloseWindow := GetProcAddress(HLib, 'ListCloseWindow');
    ListSetDefaultParams := GetProcAddress(HLib, 'ListSetDefaultParams');
    ListSendCommand := GetProcAddress(HLib, 'ListSendCommand');
    ListPrint := GetProcAddress(HLib, 'ListPrint');
    ListSearchText := GetProcAddress(HLib, 'ListSearchText');
    ListSearchDialog := GetProcAddress(HLib, 'ListSearchDialog');

    if Assigned(ListSetDefaultParams) then
      try
        FillChar(dps, SizeOf(dps), 0);
        dps.Size := SizeOf(dps);
        dps.PluginInterfaceVersionLow := 50;
        dps.PluginInterfaceVersionHi := 1;
        lstrcpy(dps.DefaultIniName, PChar(FIniFileName));
        ListSetDefaultParams(@dps);
      except
        MsgErrorWlx(FileName, 'ListSetDefaultParams');
        Exit;
      end;
  end;

  Result := True;
end;

procedure TWlxPlugins.CloseWnd(n: Word);
begin
  if IsIndexValid(n) then
    with FPlugins[n] do
      if HLib <> 0 then
        if HWnd <> 0 then
        begin
          try
            if Assigned(ListCloseWindow) then
              ListCloseWindow(HWnd)
            else
              DestroyWindow(HWnd);
          except
            MsgErrorWlx(FileName, 'ListCloseWindow/DestroyWindow');
          end;
          HWnd := 0;
        end;
end;

function TWlxPlugins.OpenWnd(n: Word; const AFileName: AnsiString; AFlags: Integer): Boolean;
begin
  Result := False;
  if not IsIndexValid(n) then Exit;

  CloseWnd(n);

  if Assigned(FBeforeLoading) then
    FBeforeLoading(GetName(n));

  with FPlugins[n] do
    if Assigned(ListLoad) then
      try
        HWnd := ListLoad(FParent.Handle, PChar(AFileName), AFlags);
        Result := HWnd <> 0;
        if Result then
        begin
          FActive := n;
          FActiveFileName := AFileName;
          FActivePosPercent := 0;

          SetParent(HWnd, FParent.Handle);

          if FFocused then
            SetFocus(HWnd);

          if Assigned(TWinControlCracker(FParent).OnResize) then
            TWinControlCracker(FParent).OnResize(FParent);
        end;
      except
        MsgErrorWlx(FileName, 'ListLoad');
      end;

  if Assigned(FAfterLoading) then
    FAfterLoading(GetName(n));
end;

function TWlxPlugins.ReopenWnd(const AFileName: AnsiString; AFlags: Integer): Boolean;
begin
  Result := False;

  if IsIndexValid(FActive) then
    with FPlugins[FActive] do
      if Assigned(ListLoadNext) and
        WlxDetectMatch(AFileName, DetectStr, False{ForceMode}) and
        (ListLoadNext(FParent.Handle, HWnd, PChar(AFileName), AFlags) = LISTPLUGIN_OK) then
          Result := True;
end;

procedure TWlxPlugins.ResizeWnd(n: Word; const ARect: TRect);
begin
  if IsIndexValid(n) then
    with FPlugins[n] do
      if (HLib <> 0) and (HWnd <> 0) then
        with ARect do
          MoveWindow(HWnd, Left, Top, Right - Left, Bottom - Top, True{bRepaint});
end;

procedure TWlxPlugins.SendCommandWnd(n: Word; ACmd, AParam: Integer);
begin
  if IsIndexValid(n) then
    with FPlugins[n] do
      if (HLib <> 0) and (HWnd <> 0) then
        if Assigned(ListSendCommand) then
          try
            ListSendCommand(HWnd, ACmd, AParam);
          except
            MsgErrorWlx(FileName, 'ListSendCommand');
          end;
end;

procedure TWlxPlugins.ResizeActive(const ARect: TRect);
begin
  ResizeWnd(FActive, ARect);
end;

procedure TWlxPlugins.CloseActive;
begin
  Unload(FActive);
  FActive := 0;
  FActiveFileName := '';
  FActivePosPercent := 0;
end;

procedure TWlxPlugins.SendCommandToActive(ACmd, AParam: Integer);
begin
  SendCommandWnd(FActive, ACmd, AParam);
  SetFocusToActive;
end;

procedure TWlxPlugins.SendParamsToActive(AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP: Boolean);
begin
  SendCommandToActive(lc_newparams,
    ParamsToFlags(AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP, FActiveForceMode));
end;

procedure TWlxPlugins.SetActivePosPercent(AValue: Word);
begin
  FActivePosPercent := AValue;
  if FActivePosPercent > 100 then
    FActivePosPercent := 100;
end;

function TWlxPlugins.SendMessageToActive(const AMessage: TMessage): LRESULT;
begin
  Result := 0;
  if IsIndexValid(FActive) then
    with FPlugins[FActive] do
      Result := SendMessage(HWnd, AMessage.Msg, AMessage.WParam, AMessage.LParam);
end;


function TWlxPlugins.PrintActive(const ARect: TRect): Boolean;
begin
  Result := True;
  if IsIndexValid(FActive) and (FActiveFileName <> '') then
    with FPlugins[FActive] do
      if Assigned(ListPrint) then
        try
          Result := ListPrint(HWnd, PChar(FActiveFileName), nil, 0, ARect) = LISTPLUGIN_OK;
        except
          MsgErrorWlx(FileName, 'ListPrint');
        end;
end;

function TWlxPlugins.SearchActive(const AString: string; AFindFirst, AWholeWords, ACaseSens, ABackwards: Boolean): Boolean;
var
  AFlags: Integer;
begin
  Result := True;
  if IsIndexValid(FActive) then
    with FPlugins[FActive] do
      if Assigned(ListSearchText) then
        try
          AFlags := 0;
          if AFindFirst then Inc(AFlags, lcs_findfirst);
          if AWholeWords then Inc(AFlags, lcs_wholewords);
          if ACaseSens then Inc(AFlags, lcs_matchcase);
          if ABackwards then Inc(AFlags, lcs_backwards);
          Result := ListSearchText(HWnd, PChar(AString), AFlags) = LISTPLUGIN_OK;
        except
          MsgErrorWlx(FileName, 'ListSearchText');
        end;
end;

function TWlxPlugins.SearchDialogActive(AFindNext: Boolean): Boolean;
const
  cModes: array[Boolean] of Integer = (cWlxFindFirst, cWlxFindNext);
begin
  Result := False;
  if IsIndexValid(FActive) then
    with FPlugins[FActive] do
      if Assigned(ListSearchDialog) then
        try
          Result := ListSearchDialog(HWnd, cModes[AFindNext]) = LISTPLUGIN_OK;
        except
          MsgErrorWlx(FileName, 'ListSearchDialog');
        end;
end;

function TWlxPlugins.GetName(n: Word): string;
begin
  Result := '';
  if IsIndexValid(n) then
    Result := ChangeFileExt(ExtractFileName(FPlugins[n].FileName), '');
end;

function TWlxPlugins.GetActiveName: string;
begin
  Result := GetName(FActive);
end;

procedure TWlxPlugins.SetFocusToActive;
begin
  if IsIndexValid(FActive) then
    with FPlugins[FActive] do
      if HWnd <> 0 then
        if GetFocus <> HWnd then
          SetFocus(HWnd);
end;

function TWlxPlugins.OpenMatched(
  const AFileName: WideString;
  AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP, ANewFile: Boolean): Boolean;
var
  OldActive, i: Word;
  AFlags: Integer;
  fn: AnsiString;
begin
  Result := False;
  if FCount = 0 then Exit;

  if not Assigned(FParent) then
    begin MsgError(MsgViewerWlxParentNotSpecified); Exit end;


  //Convert Unicode name to plugin-acceptable form

  fn := FFileNameWideToAnsi(AFileName);
  if fn = '' then Exit;
  
  //Try to load file in active plugin (TC 7 feature)

  FActiveForceMode := not ANewFile;
  AFlags := ParamsToFlags(AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP, FActiveForceMode);

  if ANewFile and ReopenWnd(fn, AFlags) then
    begin Result := True; Exit end;


  //Calculate OldActive: plugin to start cycling from

  if FActive = 0 then
    OldActive := 0
  else
  begin
    if not ANewFile then
      OldActive := FActive
    else
      OldActive := FActive - 1;
  end;

  CloseActive;

  //Cycling through all plugins from OldActive

  i := OldActive;
  repeat
    Inc(i);

    if i > FCount then i := 1;
    if i > FCount then Break;

    with FPlugins[i] do
    begin
      //1. Test for DetectString
      if WlxDetectMatch(fn, DetectStr, FActiveForceMode) then
       //2. Load
       if Load(i) then
        //3. Test for opening
        if OpenWnd(i, fn, AFlags) then
          Break
        else
          Unload(i);
    end;

    //Stop cycling at last plugin, if OldActive=0
    if (i = FCount) and (OldActive = 0) then Break;

    //Stop cycling at OldActive plugin
    if i = OldActive then Break;
  until False;

  Result := IsIndexValid(FActive);
end;

procedure TWlxPlugins.ShowDebugInfo;
var
  S: string;
  i: Word;
begin
  S := '';
  for i := 1 to FCount do
    with FPlugins[i] do
      S := S + Format('%d: FileName: "%s", DetectString: "%s"',
        [i, FileName, DetectStr]) + #13;
  MsgInfo(S);
end;

function TWlxPlugins.ActiveSupportsSearch: Boolean;
begin
  Result :=
    IsIndexValid(FActive) and
    ( Assigned(FPlugins[FActive].ListSearchText) or
      Assigned(FPlugins[FActive].ListSearchDialog) );
end;

function TWlxPlugins.ActiveSupportsPrint: Boolean;
begin
  Result :=
    IsIndexValid(FActive) and
    Assigned(FPlugins[FActive].ListPrint);
end;

function TWlxPlugins.ActiveSupportsCommands: Boolean;
begin
  Result :=
    IsIndexValid(FActive) and
    Assigned(FPlugins[FActive].ListSendCommand);
end;

function TWlxPlugins.ActiveWindowHandle: THandle;
begin
  if IsIndexValid(FActive) then
    Result := FPlugins[FActive].HWnd
  else
    Result := 0;
end;

end.