Create a gist now

Instantly share code, notes, and snippets.

Adobe Reader(X以降)で指定したファイルの指定したページを開く
unit Unit2;
interface
uses
{$IF RTLVersion >= 23.00}
Winapi.Windows, System.SysUtils, System.Win.Registry, System.AnsiStrings,
Vcl.DdeMan;
{$ELSE}
Windows, SysUtils, Registry, {$IFDEF UNICODE}AnsiStrings, {$ENDIF}DdeMan;
{$IFEND}
procedure OpenPDF(const Filename: String; Page: Integer);
implementation
function GetAcrobatPathname: String;
begin
with TRegistry.Create do
begin
try
RootKey := HKEY_CLASSES_ROOT;
OpenKeyReadOnly('Software\Adobe\Acrobat\Exe');
try
Result := AnsiDequotedStr(ReadString(''),'"');
finally
CloseKey;
end;
finally
Free;
end;
end;
end;
procedure OpenPDF(const Filename: String; Page: Integer);
const
CDdeCommand: AnsiString = '[DocOpen("%s")][DocGoTo(NULL,%d)]';
var
Macro: AnsiString;
Pathname: String;
ServiceName: String;
MajorVersion: Integer;
AcrobatType: String;
begin
Macro := {$IFDEF UNICODE}{$IF RTLVersion >= 23.00}System.{$IFEND}AnsiStrings.{$ENDIF}
Format(CDdeCommand,[Filename,Page - 1]);
Pathname := GetAcrobatPathname;
ServiceName := 'Acroview';
MajorVersion := GetFileVersion(Pathname) shr 16;
if MajorVersion >= 10 then
begin
if CompareText(ExtractFileName(Pathname),'AcroRd32.exe') = 0 then
begin
AcrobatType := 'R';
end
else
begin
AcrobatType := 'A';
end;
ServiceName := ServiceName + Format('%s%d',[AcrobatType,MajorVersion]);
end;
with TDdeClientConv.Create(nil) do
begin
try
ConnectMode := ddeManual;
ServiceApplication := ChangeFileExt(Pathname,'');
SetLink(ServiceName,'Control');
if (OpenLink or ((MajorVersion >= 15) and OpenLink)) = True then
begin
ExecuteMacro(PAnsiChar(Macro),False);
CloseLink;
end;
finally
Free;
end;
end;
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment