Sumatra PDF Reader
Здравствуйте уважаемые!
Нашёл в интернете код, который отрисовывает окно программы SumatraPDF на панели формы. Всё переписал вроде бы верно, задал константу, прописал все процедуры. Но чего-то получается не то, что должно быть в итоге. Приложение запускается, программа запускается тоже, файл открывает, НО.....она отображается не на панели, а вне её, как отдельное окно. Вот код собственно:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
const
Sumatra = 'c:\Test\SumatraPDF.exe';
type
TForm1 = class(TForm)
p: TPanel;
bFile: TButton;
OpenDialog1: TOpenDialog;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure bFileClick(Sender: TObject);
procedure pResize(Sender: TObject);
private
{ Private declarations }
function StartApp(App: string): TProcessInformation;
procedure AlignToPanel(const WND: THandle; var Panel: TPanel);
procedure SetToPanel(const WND: Cardinal; var Panel: TPanel);
procedure ViewApp;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if p.Tag <> 0 then
SendMessage(p.Tag, WM_CLOSE, 0, 0);
end;
procedure TForm1.bFileClick(Sender: TObject);
begin
OpenDialog1.FileName := bFile.Caption;
if OpenDialog1.Execute then
begin
TButton(Sender).Caption := OpenDialog1.FileName;
ViewApp;
end;
end;
procedure TForm1.pResize(Sender: TObject);
begin
AlignToPanel(p.Tag, p);
end;
procedure TForm1.ViewApp;
var
pi: TProcessInformation;
begin
pi := StartApp(Sumatra + ' "' + bFile.Caption + '"');
Sleep(500);
p.Tag := FindWindow(PAnsiChar('SUMATRA_PDF_FRAME'), PAnsiChar(SysUtils.ExtractFileName(bFile.Caption) + ' - SumatraPDF'));
SetToPanel(p.Tag, p);
end;
procedure TForm1.AlignToPanel(const WND: THandle; var Panel: TPanel);
begin
if (WND = 0) or (Panel = nil) then
Exit;
SetWindowPos(WND, HWND_TOP, Panel.ClientRect.Left, Panel.ClientRect.Top, Panel.ClientRect.Right, Panel.ClientRect.Bottom, SWP_SHOWWINDOW);
end;
procedure TForm1.SetToPanel(const WND: Cardinal; var Panel: TPanel);
begin
if (WND = 0) or (Panel = nil) then
Exit;
Windows.SetParent(WND, Panel.Handle);
{
SetWindowLong(WND, GWL_STYLE, GetWindowLong(Wnd, GWL_STYLE)
+ WS_MAXIMIZE - WS_BORDER - WS_CAPTION - WS_SYSMENU - WS_THICKFRAME
);
SetWindowLong(WND, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE)
+ WS_EX_CONTROLPARENT - WS_EX_TOOLWINDOW + WS_EX_MDICHILD
);
}
SetWindowLong(WND, GWL_STYLE, $56000000); // STYLE like Panel
SetWindowLong(WND, GWL_EXSTYLE, $00010200);
SetWindowPos(WND, HWND_TOP, Panel.ClientRect.Left, Panel.ClientRect.Top, Panel.ClientRect.Right, Panel.ClientRect.Bottom, SWP_SHOWWINDOW);
Panel.Tag := WND;
end;
function TForm1.StartApp(App: string): TProcessInformation;
var
si: TStartupInfo;
sa: TSecurityAttributes;
begin
GetStartupInfo(si);
FillChar(si, SizeOf(si), #0);
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := 0; //SW_HIDE; //SW_SHOWNORMAL;
FillChar(sa, SizeOf(sa), #0);
sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
if not CreateProcess(nil, // Module Name Pointer
PAnsiChar(App), // Command Line Pointer
nil, // Process Security Attributes Pointer
nil, // Thread Security Attributes Pointer
true, // Inheritance Flag
CREATE_DEFAULT_ERROR_MODE or NORMAL_PRIORITY_CLASS, //Creation Flags
nil, // Environment Block Pointer
nil, // Current Directory Pointer
si, Result) then
RaiseLastOSError;
end;
end.
Тестовый проект прилагаю - Test.7z
Должно получиться что-то подобное Должно.JPG А получается окно вне формы. Что тут не так?
|