Delphi: Detect when a new form has been created - delphi

I'd like to detect when a new form has been created.
Now I use the Screen.ActiveFormChange event and check for new forms in Screen.CustomForms but ActiveFormChange is fired after the OnShow event of the form.
I'd like to detect the form even before OnShow was fired. Is there any way to do this without modifying the Vcl.Forms unit?
I'd like to detect all forms (also Delphi modal messages etc.) therefore inheriting all forms from a custom class is not possible (correct me if I am wrong).
Alternatively, is it possible to detect that a new component was added to some TComponent.FComponents list?

You can use the SetWindowsHookEx function to install a WH_CBT Hook, then you must implement a CBTProc callback function and finally intercept one of the possible code values for this hook. in this case you can try with HCBT_ACTIVATE or HCBT_CREATEWND.
Check this sample for the HCBT_ACTIVATE Code.
var
hhk: HHOOK;
function CBT_FUNC(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
const
ClassNameBufferSize = 1024;
var
hWindow: HWND;
RetVal : Integer;
ClassNameBuffer: Array[0..ClassNameBufferSize-1] of Char;
begin
Result := CallNextHookEx(hhk, nCode, wParam, lParam);
if nCode<0 then exit;
case nCode of
HCBT_ACTIVATE:
begin
hWindow := HWND(wParam);
if (hWindow>0) then
begin
RetVal := GetClassName(wParam, ClassNameBuffer, SizeOf(ClassNameBuffer));
if RetVal>0 then
begin
//do something
OutputDebugString(ClassNameBuffer);
end;
end;
end;
end;
end;
Procedure InitHook();
var
dwThreadID : DWORD;
begin
dwThreadID := GetCurrentThreadId;
hhk := SetWindowsHookEx(WH_CBT, #CBT_FUNC, hInstance, dwThreadID);
if hhk=0 then RaiseLastOSError;
end;
Procedure KillHook();
begin
if (hhk <> 0) then
UnhookWindowsHookEx(hhk);
end;
initialization
InitHook();
finalization
KillHook();
end.
Note : if you uses the HCBT_CREATEWND code instead you will
intercept any window created by the system not just "forms".

Track Screen.CustomFormCount in Application.OnIdle:
private
FPrevFormCount: Integer;
end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
if Screen.CustomFormCount > FPrevFormCount then
Caption := Caption + ' +1';
if Screen.CustomFormCount <> FPrevFormCount then
FPrevFormCount := Screen.CustomFormCount;
end;
procedure TForm1.TestButton1Click(Sender: TObject);
begin
TForm2.Create(Self).Show;
end;
procedure TForm1.TestButton2Click(Sender: TObject);
begin
ShowMessage('Also trackable?'); // Yes!
end;
procedure TForm1.TestButton3Click(Sender: TObject);
begin
OpenDialog1.Execute; // Doesn't update Screen.CustomFormCount
end;
Native dialogs managed and shown by Windows (TOpenDialog, TFontDialog, etc...) are created apart from the VCL and to track them also, you need a hacking unit. Try this one then.

Thanks to David I found a solution: The clue is to replace Screen.AddForm method with your own. The way how to do it is described in these SO answers:
How I can patch a private method of a delphi class?
How to change the implementation (detour) of an externally declared function
Patch routine call in delphi
Thanks again!

Related

Launch HTML Help as Separate Process

I am using XE7 64 and I am looking for a strategy to solve several problems I am having when displaying HTMLHelp files from within my applications (I have added the HTMLHelpViewer to my uses clause). The issues are the following: 1) Ctrl-c does not copy text from topics; 2) The helpviewer cannot be accessed when a modal dialog is active.
The source of the problems are presumably attributable to the htmlhelpviewer running in the same process as the application. Is there a way to have the built-in htmlhelpviewer launch a new process? If not, then will I need to launch HH.EXE with Createprocess?
You could launch the help file viewer as a separate process, but I think that will make controlling it even more complex. My guess is that the supplied HTML help viewer code is the root cause of your problems. I've always found that code to be extremely low quality.
I deal with that by implementing an OnHelp event handler that I attach to the Application object. This event handler calls the HtmlHelp API directly. I certainly don't experience any of the problems that you describe.
My code looks like this:
unit Help;
interface
uses
SysUtils, Classes, Windows, Messages, Forms;
procedure ShowHelp(HelpContext: THelpContext);
procedure CloseHelpWindow;
implementation
function RegisterShellHookWindow(hWnd: HWND): BOOL; stdcall; external user32;
function DeregisterShellHookWindow(hWnd: HWND): BOOL; stdcall; external user32;
procedure ShowHelp(HelpContext: THelpContext);
begin
Application.HelpCommand(HELP_CONTEXTPOPUP, HelpContext);
end;
type
THelpWindowManager = class
private
FMessageWindow: HWND;
FHelpWindow: HWND;
FHelpWindowLayoutPreference: TFormLayoutPreference;
function ApplicationHelp(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
protected
procedure WndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure RestorePosition;
procedure StorePosition;
procedure StorePositionAndClose;
end;
{ THelpWindowManager }
constructor THelpWindowManager.Create;
function DefaultRect: TRect;
var
i, xMargin, yMargin: Integer;
Monitor: TMonitor;
begin
Result := Rect(20, 20, 1000, 700);
for i := 0 to Screen.MonitorCount-1 do begin
Monitor := Screen.Monitors[i];
if Monitor.Primary then begin
Result := Monitor.WorkareaRect;
xMargin := Monitor.Width div 20;
yMargin := Monitor.Height div 20;
inc(Result.Left, xMargin);
dec(Result.Right, xMargin);
inc(Result.Top, yMargin);
dec(Result.Bottom, yMargin);
break;
end;
end;
end;
begin
inherited;
FHelpWindowLayoutPreference := TFormLayoutPreference.Create('Help Window', DefaultRect, False);
FMessageWindow := AllocateHWnd(WndProc);
RegisterShellHookWindow(FMessageWindow);
Application.OnHelp := ApplicationHelp;
end;
destructor THelpWindowManager.Destroy;
begin
StorePositionAndClose;
Application.OnHelp := nil;
DeregisterShellHookWindow(FMessageWindow);
DeallocateHWnd(FMessageWindow);
FreeAndNil(FHelpWindowLayoutPreference);
inherited;
end;
function THelpWindowManager.ApplicationHelp(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
var
hWndCaller: HWND;
HelpFile: string;
DoSetPosition: Boolean;
begin
CallHelp := False;
Result := True;
//argh, WinHelp commands
case Command of
HELP_CONTEXT,HELP_CONTEXTPOPUP:
begin
hWndCaller := GetDesktopWindow;
HelpFile := Application.HelpFile;
DoSetPosition := FHelpWindow=0;//i.e. if the window is not currently showing
FHelpWindow := HtmlHelp(hWndCaller, HelpFile, HH_HELP_CONTEXT, Data);
if FHelpWindow=0 then begin
//the topic may not have been found because the help file isn't there...
if FileExists(HelpFile) then begin
ReportError('Cannot find help topic for selected item.'+sLineBreak+sLineBreak+'Please report this error message to Orcina.');
end else begin
ReportErrorFmt(
'Cannot find help file (%s).'+sLineBreak+sLineBreak+'Reinstalling the program may fix this problem. '+
'If not then please contact Orcina for assistance.',
[HelpFile]
);
end;
end else begin
if DoSetPosition then begin
RestorePosition;
end;
HtmlHelp(hWndCaller, HelpFile, HH_DISPLAY_TOC, 0);//ensure that table of contents is showing
end;
end;
end;
end;
procedure THelpWindowManager.RestorePosition;
begin
if FHelpWindow<>0 then begin
RestoreWindowPosition(FHelpWindow, FHelpWindowLayoutPreference);
end;
end;
procedure THelpWindowManager.StorePosition;
begin
if FHelpWindow<>0 then begin
StoreWindowPosition(FHelpWindow, FHelpWindowLayoutPreference);
end;
end;
procedure THelpWindowManager.StorePositionAndClose;
begin
if FHelpWindow<>0 then begin
StorePosition;
SendMessage(FHelpWindow, WM_CLOSE, 0, 0);
FHelpWindow := 0;
end;
end;
var
WM_SHELLHOOKMESSAGE: UINT;
procedure THelpWindowManager.WndProc(var Message: TMessage);
begin
if (Message.Msg=WM_SHELLHOOKMESSAGE) and (Message.WParam=HSHELL_WINDOWDESTROYED) then begin
//need cast to HWND to avoid range errors
if (FHelpWindow<>0) and (HWND(Message.LParam)=FHelpWindow) then begin
StorePosition;
FHelpWindow := 0;
end;
end;
Message.Result := DefWindowProc(FMessageWindow, Message.Msg, Message.wParam, Message.lParam);
end;
var
HelpWindowManager: THelpWindowManager;
procedure CloseHelpWindow;
begin
HelpWindowManager.StorePositionAndClose;
end;
initialization
if not ModuleIsPackage then begin
Application.HelpFile := ChangeFileExt(Application.ExeName, '.chm');
WM_SHELLHOOKMESSAGE := RegisterWindowMessage('SHELLHOOK');
HelpWindowManager := THelpWindowManager.Create;
end;
finalization
FreeAndNil(HelpWindowManager);
end.
Include that unit in your project and you will be hooked up to handle help context requests. Some comments on the code:
The implementation of the OnHelp event handler is limited to just my needs. Should you need more functionality you'd have to add it yourself.
You won't have TFormLayoutPrefernce. It's one of my preference classes that manages per-user preferences. It stores away the window's bounds rectangle, and whether or not the window was maximised. This is used to ensure that the help window is shown at the same location as it was shown in the previous session. If you don't want such functionality, strip it away.
ReportError and ReportErrorFmt are my helper functions to show error dialogs. You can replace those with calls to MessageBox or similar.
Based on David's comments that he calls HtmlHelp directly and does not encounter the problems noted above, I tried that approach and it solved the problems. Example of calling HTMLHelp directly to open a topic by id:
HtmlHelp(Application.Handle,'d:\help study\MyHelp.chm',
HH_HELP_CONTEXT, 70);

Screen.Cursor in Firemonkey

In Delphi 6, I could change the Mouse Cursor for all forms using Screen.Cursor:
procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourglass;
end;
I am searching the equivalent in Firemonkey.
Following function does not work:
procedure SetCursor(ACursor: TCursor);
var
CS: IFMXCursorService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then
begin
CS := TPlatformServices.Current.GetPlatformService(IFMXCursorService) as IFMXCursorService;
end;
if Assigned(CS) then
begin
CS.SetCursor(ACursor);
end;
end;
When I insert a Sleep(2000); at the end of the procedure, I can see the cursor for 2 seconds. But the Interface probably gets freed and therefore, the cursor gets automatically resetted at the end of the procedure. I also tried to define CS as a global variable, and add CS._AddRef at the end of the procedure to prevent the Interface to be freed. But it did not help either.
Following code does work, but will only work for the main form:
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.MainForm.Cursor := crHourGlass;
end;
Since I want to change the cursor for all forms, I would need to iterate through all forms, but then the rollback to the previous cursors is tricky, as I need to know the previous cursor for every form.
My intention:
procedure TForm1.Button1Click(Sender: TObject);
var
prevCursor: TCursor;
begin
prevCursor := GetCursor;
SetCursor(crHourglass); // for all forms
try
Work;
finally
SetCursor(prevCursor);
end;
end;
You'd have to implement your own cursor service that makes it possible to enforce a certain cursor.
unit Unit2;
interface
uses
FMX.Platform, FMX.Types, System.UITypes;
type
TWinCursorService = class(TInterfacedObject, IFMXCursorService)
private
class var FPreviousPlatformService: IFMXCursorService;
class var FWinCursorService: TWinCursorService;
class var FCursorOverride: TCursor;
class procedure SetCursorOverride(const Value: TCursor); static;
public
class property CursorOverride: TCursor read FCursorOverride write SetCursorOverride;
class constructor Create;
procedure SetCursor(const ACursor: TCursor);
function GetCursor: TCursor;
end;
implementation
{ TWinCursorService }
class constructor TWinCursorService.Create;
begin
FWinCursorService := TWinCursorService.Create;
FPreviousPlatformService := TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; // TODO: if not assigned
TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;
function TWinCursorService.GetCursor: TCursor;
begin
result := FPreviousPlatformService.GetCursor;
end;
procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin
if FCursorOverride = crDefault then
begin
FPreviousPlatformService.SetCursor(ACursor);
end
else
begin
FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end;
class procedure TWinCursorService.SetCursorOverride(const Value: TCursor);
begin
FCursorOverride := Value;
TWinCursorService.FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end.
MainUnit:
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
TWinCursorService.CursorOverride := crHourGlass;
try
Sleep(2000);
finally
TWinCursorService.CursorOverride := crDefault;
end;
end;
The IFMXCursorService is how the FMX framework manages cursors. It is not intended for your use. The mechanism that you are meant to use is the form's Cursor property.
This means that you will need to remember the cursor for each form in order to restore it. I suggest that you use a dictionary to do that. Wrap the functionality up into a small class and then at least the pain is localized to the implementation of that class. You can make the code at the call site reasonable.

How to know that a form was created?

I want to find a way to know that a form was created at run time (or destroyed).
This for Delphi or fpc.
Many thanks
PS : Is there a way to retrieve that info for all objects ?
I want to have a event that tells me that a new object was just created at run time (or destroyed).
There are no built in events that fire whenever an object is created or destroyed.
Because I like writing code hooks, I offer the following unit. This hooks the _AfterConstruction method in the System unit. Ideally it should use a trampoline but I've never learnt how to implement those. If you used a real hooking library you'd be able to do it better. Anyway, here it is:
unit AfterConstructionEvent;
interface
var
OnAfterConstruction: procedure(Instance: TObject);
implementation
uses
Windows;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, #OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
function System_AfterConstruction: Pointer;
asm
MOV EAX, offset System.#AfterConstruction
end;
function System_BeforeDestruction: Pointer;
asm
MOV EAX, offset System.#BeforeDestruction
end;
var
_BeforeDestruction: procedure(const Instance: TObject; OuterMost: ShortInt);
function _AfterConstruction(const Instance: TObject): TObject;
begin
try
Instance.AfterConstruction;
Result := Instance;
if Assigned(OnAfterConstruction) then
OnAfterConstruction(Instance);
except
_BeforeDestruction(Instance, 1);
raise;
end;
end;
initialization
#_BeforeDestruction := System_BeforeDestruction;
RedirectProcedure(System_AfterConstruction, #_AfterConstruction);
end.
Assign a handler to OnAfterConstruction and that handler will be called whenever an object is created.
I leave it as an exercise to the reader to add an OnBeforeDestruction event handler.
Note that I am not saying that such an approach is a good thing to do. I'm just answering the direct question that you asked. You can decide for yourself whether or not you want to use this. I know I would not do so!
Use TForm's OnCreate event to inform whoever you want in whatever way you want.
In MS Windows you can hook events of your process using this small template:
{$mode objfpc}{$H+}
uses
Windows, JwaWinUser;
function ShellProc(nCode: longint; wParam: WPARAM; lParam: LPARAM): longint; stdcall;
var
wnd: HWND;
begin
Result := 0;
case nCode of
HSHELL_WINDOWCREATED:
begin
wnd := wParam;
// Check window
// Get task handle
// Get window icon
// Add task to the list
// Call event
end;
HSHELL_WINDOWDESTROYED:
begin
wnd := wParam;
// Check window
// Get task handle
// Get window icon
// Remove task to the list
// Call event
end;
HSHELL_LANGUAGE:
begin
// Get language
// Call event
end;
HSHELL_REDRAW:
begin
// Call event
end;
HSHELL_WINDOWACTIVATED:
begin
// Get language
// Call event
end;
//HSHELL_APPCOMMAND:
//begin
// { TODO 1 -ond -csys : Specify return value for this code }
// Result := -1;
//end;
end;
// Call next hook in the chain
Result := CallNextHookEx(
0,
nCode,
wParam,
lParam);
end;
var
FCallbackProc: HOOKPROC;
function InitShellHook(AProc: HOOKPROC): HHOOK; stdcall; export;
begin
FCallbackProc := AProc;
Result := SetWindowsHookEx(WH_SHELL, #ShellProc, 0, 0);
end;
procedure DoneShellHook(AHook: HHOOK); stdcall; export;
begin
UnhookWindowsHookEx(AHook);
end;
HSHELL_WINDOWCREATED will inform you that your process was create new window.
Call InitShellHook with your procedure address (see HOOCPROC declaration).

Geting a reference to a dialog window form (ShowMessage, MsgDialog etc)

Is there any event I could use so I'd catch the moment when ShowMessage appears on the screen? I'd also need pass a reference to the TForm which has shown the Message.
So far I tried OnDeactivate, but it seems, ShowMessage is not causing it...
In.NET there is methon on Application that catches every MessageBox (Application.AddFilterMessage or smth like this), I'd need something like this in delphi
What I'm trying to achive is:
I must catch the moment while a dialog window appears (or just a modal window, but it's not that comfortable). I need to do couple of instructions then. Goal of those instructions is to give me a refference to the just recieved DialogWindow so I could for example get a number of buttons that lies on it.
In modern Delphi versions, on modern Windows versions, ShowMessage results in a Windows dialog window. You can use a WH_CBT hook to catch the activation of that dialog window.
function CBTProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
wnd: HWND;
ClassName: string;
begin
if nCode=HCBT_ACTIVATE then
begin
wnd := wParam;
SetLength(ClassName, 256);
SetLength(ClassName, GetClassName(wnd, PChar(ClassName), Length(ClassName)));
if (ClassName='#32770') or (ClassName='TMessageForm') then
Beep;
end;
Result := CallNextHookEx(0, nCode, wParam, lParam);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Hook: HHOOK;
begin
Hook := SetWindowsHookEx(WH_CBT, CBTProc, HInstance, GetCurrentThreadId);
if Hook=0 then
RaiseLastOSError;
try
ShowMessage('hello');
finally
if not UnhookWindowsHookEx(Hook) then
RaiseLastOSError;
end;
end;
Note that the actual window class name varies from system to system. On XP the class name will be TMessageForm because the dialog is actually a Delphi TForm. However, on Vista and later the dialog is a standard window message box dialog with window class name #32770.
I've shown this wrapped around a single call to ShowMessage, but you could install this at startup if you want to hook all message dialogs shown in your app.
You can also use an application-wide hook installed in the main form's OnCreate event (uninstalled in OnDestroy):
procedure TMainForm.FormCreate(Sender: TObject);
begin
...
Application.HookMainWindow(ApplicationHook);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
...
Application.UnhookMainWindow(ApplicationHook);
end;
function TMainForm.ApplicationHook(var Message: TMessage): Boolean;
var
I: Integer;
begin
Result := False;
if (Message.Msg = WM_ENABLE) and not TWMEnable(Message).Enabled then // disabling
for I := 0 to Screen.FormCount - 1 do
with Screen.Forms[I] do
if Enabled and (ClassNameIs('TMessageForm') or // ShowMessage, MessageDlg
ClassNameIs('TForm') or // InputQuery
ClassNameIs('TMyLoginDialog')) then // your own dialogs, etc.
begin
Screen.Forms[I].Position := poScreenCenter; // for example
Result := True;
Break;
end;
end;
Why not just use OnActiveFormChange?
procedure TForm3.FormCreate(Sender: TObject);
begin
Screen.OnActiveFormChange := ScreenActiveFormChange;
end;
procedure TForm3.ScreenActiveFormChange(Sender: TObject);
begin
if Screen.ActiveForm is TOKRightDlg then
Screen.ActiveForm.Caption := 'Found';
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
with TOKRightDlg.Create(nil) do
try
ShowModal;
finally
Free;
end;
end;
There are TApplication.OnModalBegin and TApplicationEvents.OnModalBegin. I haven't really tried them, so I can't comment on whether you can get the owner and/or the modal form inside these events.

Start program and dock with an existing program Delphi 2010

Is there a way in Delphi 2010 to start an application using ShellExecute then dock that application inside another?
I.e. Program A written in Delphi contains 1 form. When the form is shown, Program B, written in C# is started up and docked client into Program A's form?
Paul
Yes you can do this. You need to get hold of the window handle of the main form in the other process (call EnumWindows). Then call SetParent to make that window a child of your window.
You'll likely want to modify window style, position etc. Also call WaitForInputIdle before trying to find a window handle in the new process. You've got to give the new process a chance to get started.
What you now have is a pretty queer beast. Inside one container you have two processes. Each process has its own UI thread. You can show and interact with two modal dialogs at once. There's really no end to the fun you can have with this!
EDIT
Just for a bit of fun I had a go at writing a simple Delphi app to do this. It's rather brittle and only seems to work for very basic apps. I think you could spend a long time trying to make this work well and still end up with an unsatisfactory result. If I were you I'd look for other solutions, especially as you have the source for this C# app. Surely you could expose its functionality as an ActiveX?
Anyway, for your amusement I offer the following exceedingly un-polished piece of code:
program AppHost;
uses
Windows, Messages, SysUtils, Forms, Controls, ComCtrls;
{$R *.res}
procedure ResizePage(Page: TTabSheet);
var
hwnd: Windows.HWND;
Rect: TRect;
begin
hwnd := Page.Tag;
Rect := Page.ClientRect;
MoveWindow(hwnd, Rect.Left, Rect.Top, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, True);
end;
type
PEnumData = ^TEnumData;
TEnumData = record
ProcessID: DWORD;
hwnd: HWND;
end;
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
ProcessId: DWORD;
EnumData: PEnumData;
begin
EnumData := PEnumData(lParam);
GetWindowThreadProcessId(hwnd, ProcessId);
if EnumData.ProcessID=ProcessID then begin
EnumData.hwnd := hwnd;
Result := False;
exit;
end;
Result := True;
end;
procedure Absorb(PageControl: TPageControl; const App: string; StartupInfo: TStartupInfo);
var
Page: TTabSheet;
ProcessInformation: TProcessInformation;
EnumData: TEnumData;
begin
Page := TTabSheet.Create(PageControl);
Page.PageControl := PageControl;
Page.Caption := ChangeFileExt(ExtractFileName(App), '');
CreateProcess(PChar(App), nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInformation);
WaitForInputIdle(ProcessInformation.hProcess, INFINITE);
EnumData.ProcessID := ProcessInformation.dwProcessId;
EnumData.hwnd := 0;
EnumWindows(#EnumWindowsProc, LPARAM(#EnumData));
Page.Tag := Integer(EnumData.hwnd);
SetParent(HWND(Page.Tag), Page.Handle);
ResizePage(Page);
end;
type
TEventProvider = class
private
FForm: TForm;
FPageControl: TPageControl;
procedure FormResize(Sender: TObject);
public
constructor Create(Form: TForm; PageControl: TPageControl);
end;
{ TEventProvider }
constructor TEventProvider.Create(Form: TForm; PageControl: TPageControl);
begin
inherited Create;
FForm := Form;
FPageControl := PageControl;
FForm.OnResize := FormResize;
end;
procedure TEventProvider.FormResize(Sender: TObject);
var
i: Integer;
begin
for i := 0 to FPageControl.PageCount-1 do begin
ResizePage(FPageControl.Pages[i]);
end;
end;
procedure Main(Form: TForm);
var
StartupInfo: TStartupInfo;
PageControl: TPageControl;
begin
Form.ClientHeight := 600;
Form.ClientWidth := 800;
Form.Caption := 'All your processes are belong to us';
PageControl := TPageControl.Create(Form);
PageControl.Parent := Form;
PageControl.Align := alClient;
StartupInfo.cb := SizeOf(StartupInfo);
GetStartupInfo(StartupInfo);
Absorb(PageControl, 'C:\Windows\Notepad.exe', StartupInfo);
Absorb(PageControl, 'C:\Program Files\CommandLine\depends.exe', StartupInfo);
TEventProvider.Create(Form, PageControl);
end;
var
Form: TForm;
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm, Form);
Main(Form);
Application.Run;
Form.Free;
end.
Yes I have access to the C# program
I need a solution that works irrespective of the language, but any program that is loaded in this way will be one that we write
GetProcessID returns 0?
All I have done for now is to produce 2 programs in Delphi, 1 calls the other
I then want to get dockapp2 to dock inside of dockapp1 and for the user to have no idea that this is a seperate program.
Having GetProcessID returning 0 is not ideal!
procedure TForm2.BitBtn1Click(Sender: TObject);
var
n: Integer;
n2: Integer;
begin
n := ShellExecute(0, 'open', PChar('c:\temp\dockapp2\dockapp2.exe'), nil, nil, SW_SHOWNORMAL);
n2:= GetProcessId(n);
Caption := IntToStr(n2);
end;

Resources