unit MainForm;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
CodeSiteLogging,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ExtCtrls,
Vcl.StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Panel1: TPanel;
Button2: TButton;
Panel2: TPanel;
procedure Button1Click(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FAppWnd: DWORD;
procedure PADoEmbeddApp(APanel: TPanel;
const AAppToExec, AParam:
string);
procedure PADoReleaseEmbeddedApp;
procedure PADelay(Milliseconds: Integer; APanel: Tpanel);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Winapi.ShellAPI;
procedure SimplePADelay(Milliseconds: Integer);
var
Tick: DWORD;
Event: THandle;
begin
Event := CreateEvent(
nil, False, False,
nil);
try
Tick := GetTickCount + DWORD(Milliseconds);
while (Milliseconds > 0)
and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT)
do
begin
Application.ProcessMessages;
if Application.Terminated
then
EXIT;
Milliseconds := Tick - GetTickCount;
end;
finally
CloseHandle(Event);
end;
end;
procedure TForm1.PADelay(Milliseconds: Integer; APanel: Tpanel);
var
Tick: DWORD;
Event: THandle;
WindRect, OldRect: TRect;
begin
Event := CreateEvent(
nil, False, False,
nil);
try
Tick := GetTickCount + DWORD(Milliseconds);
GetWindowRect(FAppWnd, OldRect);
while (Milliseconds > 0)
and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT)
do
begin
Application.ProcessMessages;
if Application.Terminated
then
EXIT;
GetWindowRect(FAppWnd, WindRect);
if OldRect <> WindRect
then
begin
APanel.Repaint;
APanel.Update;
Application.ProcessMessages;
EXIT;
end;
OldRect := WindRect;
Milliseconds := Tick - GetTickCount;
end;
finally
CloseHandle(Event);
end;
end;
procedure TForm1.PADoEmbeddApp(APanel: TPanel;
const AAppToExec, AParam:
string);
// App starten und einbetten
// uses Winapi.ShellAPI;
var
ExecuteFile:
string;
SEInfo: TShellExecuteInfo;
RetryCount: Integer;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0);
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
with SEInfo
do
begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := APanel.Handle;
lpFile := PChar(AAppToExec);
lpParameters := PChar(AParam);
nShow := SW_HIDE;
end;
if ShellExecuteEx(@SEInfo)
then // wenn Programm erfolgreich gestartet wurde
begin
RetryCount := 0;
CodeSite.Send('
VOR repeat');
repeat
FAppWnd := FindWindow(PChar('
HH Parent'),
nil);
//Sleep(100);
SimplePADelay(100);
Inc(RetryCount);
until (FAppWnd <> 0)
or (RetryCount > 10);
CodeSite.Send('
NACH until');
if FAppWnd <> 0
then // wenn das Fenster der ViewerApp gefunden wurde
begin
APanel.Visible := False;
try
Screen.Cursor := crHourGlass;
try
Winapi.Windows.SetParent(FAppWnd, SEInfo.Wnd);
SetWindowLong(FAppWnd, GWL_STYLE, GetWindowLong(
Handle, GWL_STYLE)
and not WS_BORDER
and not WS_THICKFRAME
and not WS_DLGFRAME);
SetWindowPos(FAppWnd, 0, 0, 0, APanel.Width, APanel.Height, SWP_ASYNCWINDOWPOS);
CodeSite.Send('
VOR PADelay');
PADelay(2000, APanel);
CodeSite.Send('
NACH PADelay');
ShowWindow(FAppWnd, SW_SHOWMAXIMIZED);
ShowWindow(FAppWnd, SW_SHOWMAXIMIZED);
finally
Screen.Cursor := crDefault;
end;
finally
APanel.Visible := True;
end;
end;
end;
end;
procedure TForm1.PADoReleaseEmbeddedApp;
// Eingebettetes Programm beenden
begin
if FAppWnd <> 0
then
begin
PostMessage(FAppWnd, WM_Close, 0, 0);
FAppWnd := 0;
end;
end;
procedure TForm1.Panel1Resize(Sender: TObject);
// Größe von Embedded App zusammen mit Fenster verändern
begin
if IsWindow(FAppWnd)
then
begin
SetWindowPos(FAppWnd, 0, 0, 0, Panel1.Width, Panel1.Height, SWP_ASYNCWINDOWPOS);
ShowWindow(FAppWnd, SW_SHOWMAXIMIZED);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
PADoEmbeddApp(Panel2, '
hh.exe', '
R:\Example.chm');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
PADoReleaseEmbeddedApp;
end;
end.