Get foreground CHILD window - delphi

Whenever Skype is in Default View, the TConversationWindow's become children of the tSkMainForm Window.
I am having problems finding out which TConversationWindow is active - however it's not like an MDI interface - only one TConversationWindow is visible, like if it was a Tab/Page.
When I do GetForegroundWindow, Skype's MainForm handle is returned (tSkMainForm). Is there any way that I can get the foreground TConversationWindow within Skype?
This question of mine has screenshots of Skype's Default View, if you need it. :)
EDIT: Here is a screenshot of the Winspector Hierachy:
EDIT2: I tried going thru the windows like this:
procedure TForm1.Button1Click(Sender: TObject);
function GetClassName(Handle: HWND): String;
var
Buffer: array[0..MAX_PATH] of Char;
begin
Windows.GetClassName(Handle, #Buffer, MAX_PATH);
Result := String(Buffer);
end;
Var
Wnd: HWND;
SkypeWnd: HWND;
begin
SkypeWnd := FindWindow('tSkMainForm',nil);
Wnd := GetTopWindow(SkypeWnd);
while (GetClassName(Wnd) <> 'TConversationForm') and (Wnd <> 0) and (not IsWindowVisible(Wnd)) do
begin
Wnd := GetNextWindow(Wnd,GW_HWNDNEXT);
end;
Label1.Caption := GetClassName(Wnd)+' - '+GetHandleText(wnd);
end;
The above is supposed to find the visible window, however when I debug it, it never enters the Begin End within the While loop, and Label1 displays "TChromeMenu - ChromeToolbar". When I remove the IsWindowVisible check, it atleast finds a TConversationForm. What am I doing wrong?
EDIT3: By placing the IsWindowVisible and getClassName check inside the loop, and break when true, I managed to do it. :)

By placing the IsWindowVisible and getClassName check inside the loop, and break when true, I managed to do it. :)

Related

`EOleException: Call was rejected by callee` while iterating through `Office.Interop.Word.Documents`

I've been working with Word2010.pas for the past week and everything went well, until I found out that if you open a document manually, edit it (but don't save), press Alt+F4, a prompt will show up saying if you want to save your document or not, leave it like that. Go into code and try to access that document, all calls will result in EOleException: Call was rejected by callee. Once you cancel that Word save prompt, everything works fine.
I came across this while writing code that periodically checks if a document is open. Here is the function that checks if the document is open: (function runs in a timer every 2 seconds)
function IsWordDocumentOpen(FileName: string): Boolean;
var
WordApp: TWordApplication;
I: Integer;
begin
Result := False;
try
WordApp := TWordApplication.Create(nil);
try
WordApp.Connect;
for I := 1 to WordApp.Documents.Count do
begin
try
if WordApp.Documents.Item(I).FullName = FileName then
begin
Result := True;
System.Break;
end;
except
on E: EOleException do
// I always end up here while the document has the prompt
end;
end;
finally
FreeAndNil(WordApp);
end;
finally
//
end;
end;
Does anyone have any experience with this? Is there some sort of a lock that I'm not aware of?
UPDATE #1: So far the only solution I could find was to implement IOleMessageFilter, this way I do not receive any exceptions but the program stops and waits on the line WordApp.Documents.Item(I).FullName, but that is not what I want. Implementation of IOleMessageFilter goes like this:
type
IOleMessageFilter = class(TInterfacedObject, IMessageFilter)
public
function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask;
dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall;
function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint;
dwRejectType: Longint): Longint;stdcall;
function MessagePending(htaskCallee: HTask; dwTickCount: Longint;
dwPendingType: Longint): Longint;stdcall;
procedure RegisterFilter();
procedure RevokeFilter();
end;
implementation
function IOleMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint;
begin
Result := 0;
end;
function IOleMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint;
begin
Result := 2 //PENDINGMSG_WAITDEFPROCESS
end;
procedure IOleMessageFilter.RegisterFilter;
var
OldFilter: IMessageFilter;
NewFilter: IMessageFilter;
begin
OldFilter := nil;
NewFilter := IOleMessageFilter.Create;
CoRegisterMessageFilter(NewFilter,OldFilter);
end;
function IOleMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint;
begin
Result := -1;
if dwRejectType = 2 then
Result := 99;
end;
procedure IOleMessageFilter.RevokeFilter;
var
OldFilter: IMessageFilter;
NewFilter: IMessageFilter;
begin
OldFilter := nil;
NewFilter := nil;
CoRegisterMessageFilter(NewFilter,OldFilter);
end;
end;
BEST SOLUTION SO FAR: I used IOleMessageFilter implementation like this: (remember this will stop and wait on the line where I previously got an exception)
function IsWordDocumentOpen(FileName: string): Boolean;
var
OleMessageFilter: IOleMessageFilter;
WordApp: TWordApplication;
I: Integer;
begin
Result := False;
try
OleMessageFilter := IOleMessageFilter.Create;
OleMessageFilter.RegisterFilter;
WordApp := TWordApplication.Create(nil);
try
WordApp.Connect;
for I := 1 to WordApp.Documents.Count do
begin
if WordApp.Documents.Item(I).FullName = FileName then
begin
Result := True;
System.Break;
end;
end;
finally
OleMessageFilter.RevokeFilter;
FreeAndNil(WordApp);
FreeAndNil(OleMessageFilter);
end;
finally
//
end;
end;
Actually, I think that the problem is simply that Word is busy doing a modal dialog and so can't respond to external COM calls. This trivial code produces the same error:
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := MSWord.ActiveDocument.Name;
end;
Probably the simplest way to avoid this problem is to head it off before if happens. If you are using the TWordApplication server that comes with Delphi (on the Servers components tab), you can attach an event handler to its OnDocumentBeforeClose and use that to present your own "Save Y/N?" dialog and set the event's Cancel param to True to prevent Word's dialog from appearing.
Update: If you try experimenting with this code while the Save dialog is popped up
procedure TForm1.Button1Click(Sender: TObject);
var
vWin,
vDoc,
vApp : OleVariant;
begin
vWin := MSWord.ActiveWindow;
Caption := vWin.Caption;
vDoc := vWin.Document;
vApp := vDoc.Application; // Attempt to read Word Document property
Caption := vDoc.Path + '\';
Caption := Caption + vDoc.Name;
end;
I think you'll find that any attempt to read from the vDoc object will result in the "Call was rejected ..." message, so I am beginning to think that this behaviour is by design - it's telling you that the object is not in a state that it can be interacted with.
Interestingly, it is possible to read the Caption property of the vWin Window object, which will tell you the filename of the file but not the file's path.
Realistically, I still think your best option is to try and get the OnDocumentBeforeClose event working. I don't have Word 2010 installed on this machine by Word 2007 works fine with the Word server objects derived from Word2000.Pas so you might try those instead of Word2010.Pas, just to see.
Another possibility is simply to catch the "Call was rejected ..." exception, maybe return "Unavailable" as the document FullName, and try again later.
If you're not using TWordApplication and don't know how to catch the OnDocumentBeforeClose for the method your using to access Word, let me know how you are accessing it and I'll see if I can dig out some code to do it.
I vaguely recall there's a way of detecting that Word is busy with a modal dialog - I'll see if I can find where I saw that a bit later if you still need it. Your IOleMessageFilter looks more promising than anything I've found as yet, though.

Firemonkey do stuff in background Form Delphi 10 Seattle

I've created a pop-up loadscreen Form that I want to show above any other form in a Firmonkey Multi device project. Now i've run into the problem that the loadscreen doesn't get updated with the things I do in the background Form. How can I solve this?
In the code below is an example of what i've tried:
procedure TForm1.Button1Click(Sender: TObject);
var
loadScreen:TfrmLoadScreen;
begin
loadScreen := TfrmLoadScreen.Create(nil);
loadScreen.ShowModal(
procedure(ModalResult: TModalResult)
var
i:Integer;
begin
for i := 0 to 200 do
begin
loadScreen.CurrentItem := i;
loadScreen.TextMessage := 'Item:' + loadScreen.CurrentItem.ToString;
Sleep(100);
end;
ModalResult := mrCancel;
end);
end;
I guess I have to do some multi-threading, but I don't have any experience doing this! How should I do this for my loadscreen?
I've also tried the following, but the form doesn't get shown:
procedure TForm1.Button1Click(Sender: TObject);
var
loadScreen:TfrmLoadScreen;
begin
loadScreen := TfrmLoadScreen.Create(nil);
loadScreen.OnShow := FormShowLoadScreen;
loadScreen.Show;
end;
procedure TForm1.FormShowLoadScreen(Sender: TObject);
var
i:Integer;
loadScreen:TfrmLoadScreen;
begin
loadScreen := TfrmLoadScreen(Sender);
for i := 0 to 200 do
begin
loadScreen.CurrentItem := i;
Sleep(100);
end;
loadScreen.Close;
end;
In your first code block, the annonymous method is only called after loadscreen.modalresult is set to something other than 0. This never happens (that we can see)
In your second block, you have 2 different loadscreen instances. They are not the same one. The FormShowLoadScreen handler is called after the firstly loadscreen.show, but it creates a 2nd loadscreen, with it's own displays. In fact, this might happen so fast, you wouldn't see it happen.
You really need to learn more about Delphi multi-threading. To display a "progress" form, you will have to put it's processing (display updates) inside the synchronise event of a separate thread that is started just after the loadscreen form is shown.
Actually... It's actually much easier in FMX to show an animation indicator before starting an annonymous thread, and then hide it again in the thread terminate block.
See Marco Cantu's blog post here Background Operations on Delphi Android, with Threads and Timers

How to call objects that were cloned

I clone a panel and its contents(A image and a checkbox) 20 times.
Sample of the panel being cloned:
This is the procedure used to clone a whole panel:
procedure TForm1.ClonePanel(pObjectName: Tpanel);
var apanel : Tpanel;
Ctrl, Ctrl_: TComponent;
i: integer;
begin
//handle the Control itself first
TComponent(apanel) := CloneComponent(pObjectName);
with apanel do
begin
Left := 24;
Top :=64;
end;
//now handle the childcontrols
for i:= 0 to pObjectName.ControlCount-1 do
begin
Ctrl := TComponent(pObjectName.Controls[i]);
Ctrl_ := CloneComponent(Ctrl);
TControl(Ctrl_).Parent := apanel;
TControl(Ctrl_).Left := TControl(Ctrl).Left;
TControl(Ctrl_).top := TControl(Ctrl).top;
end;
end;
The following is the the code that physically does the cloning(called above):
function TForm1.CloneComponent(AAncestor: TComponent): TComponent;
var
XMemoryStream: TMemoryStream;
XTempName: string;
begin
Result:=nil;
if not Assigned(AAncestor) then
exit;
XMemoryStream:=TMemoryStream.Create;
try
XTempName:= AAncestor.Name;
AAncestor.Name:='clone_' + XTempName + inttostr(panels);
inc(panels);
XMemoryStream.WriteComponent(AAncestor);
AAncestor.Name:=XTempName;
XMemoryStream.Position:=0;
Result:=TComponentClass(AAncestor.ClassType).Create(AAncestor.Owner);
if AAncestor is TControl then TControl(Result).Parent:=TControl(AAncestor).Parent;
XMemoryStream.ReadComponent(Result);
finally
XMemoryStream.Free;
end;
end;
So now I want to use the cloned objects but how do I call them in my code?
For example how can I call the checked function of one of the cloned check boxes?
Thanks for your help :)
Others are right and it is better to use frame but if we want just use your code we must fix it first. there is a problem in your code and that is the Inc(panles); position. you must put this line after loop of for i:= 0 to pObjectName.ControlCount-1 do in the ClonePanle procedure, not in the CloneComponent function.
If you fix that, then you can use FindComponent function to access the components that you want as Marko Paunovic said.
For example the name of the component that you put on the first Panel that you defined as the first instance which other cloned panels are cloned from that is TestCheckBox. If you cloned 20 times the Panel that we talked about; you can access the TCheckBox of the 16th Cloned obejct like this and changing it's caption to whatever you want:
(I suppose that the panels variable was 0, when the program started.)
TCheckBox(FindComponent('clone_TestCheckBox15')).Caption:='aaaaa';

How to get TextWidth of string (without Canvas)?

I would like to get text width of a string before an application starts. Everything works fine until Application.MainForm canvas present. The problem is, when I try dynamically create TOrdinarium in the OnCreate event of the app. main form, "Canvas does not allow drawing" error occurs. (Application.MainForm is nil....). I tried several ways to create Canvas dynamically (one of them is written below), but it can not measure text sizes without being attached to parented control.
Is there way how to make it work somehow?
Thanx
I tried this:
TOrdinarium = class (TCustomControl)
private
function GetVirtualWidth:integer;
end;
constructor TOrdinarium.Create(AOwner:TComponent);
begin
inherited;
Width:=GetVirtualWidth;
end;
function TOrdinarium.GetVirtualWidth:integer;
var ACanvas : TControlCanvas;
begin
ACanvas := TControlCanvas.Create;
TControlCanvas(ACanvas).Control := Application.MainForm;
ACanvas.Font.Assign(Font);
result:=ACanvas.TextWidth('0');
ACanvas.Free;
end;
This works:
procedure TForm1.FormCreate(Sender: TObject);
var
c: TBitmap;
begin
c := TBitmap.Create;
try
c.Canvas.Font.Assign(self.Font);
Caption := IntToStr(c.Canvas.TextWidth('My String'));
finally
c.Free;
end;
end;
I'm not sure if this can be done, but if by "before the app starts" you mean "before the main form is displayed", you could always put your canvas-related code in the main form's OnCreate event. You'll have a valid canvas by that point.

How do do things during Delphi form startup

I have a form one which I want to show a file open dialog box before the full form opens.
I already found that I can't do UI related stuff in FormShow, but it seems that I can in FormActivate (which I protect from being called a second time...)
However, if the user cancels out of the file open dialog, I want to close the form without proceeding.
But, a form close in the activate event handler generates an error that I can't change the visibility of the form.
So how does one do some UI related operation during form start up and then perhaps abort the form (or am I trying to stuff a function into the form that should be in another form?)
TIA
It would be best (i think) to show the file open dialog BEFORE you create and show the form. If you want to keep all code together you might add a public class procedure OpenForm() or something:
class procedure TForm1.OpenForm( ... );
var
O: TOpenDialog;
F: TForm1;
begin
O := TOpenDialog.Create();
try
// set O properties.
if not O.Execute then Exit
F := TForm1.Create( nil );
try
F.Filename := O.FIlename;
F.ShowModal();
finally
F.Free();
end;
finally
O.Free();
end;
end;
Set a variable as a condition of the opendialog and close the form on the formshow event if the flag is not set correctly.
procedure TForm1.FormCreate(Sender: TObject);
begin
ToClose := not OpenDialog1.Execute;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if ToClose then Close();
end;
or even more simply
procedure TForm1.FormShow(Sender: TObject);
begin
if not OpenDialog1.Execute then Close();
end;
If you want to keep the logic conditioning the opening self-contained in the Form, you can put a TOpenDialog in your Form and use a code like this in your OnShow event:
procedure TForm2.FormShow(Sender: TObject);
begin
if OpenDialog1.Execute(Handle) then
Color := clBlue
else
PostMessage(Handle, WM_CLOSE, 0, 0); // NB: to avoid any visual glitch use AlpaBlend
end;
If you don't need this encapsulation, a better alternative can be to check the condition before trying to show the form, for instance by embedding the Form2.Show call in a function that tests all the required conditions first.
Two Ways....
1. using oncreate and onactivate
create a global flag or even 2
var
aInitialized:boolean;
Set the flag to false in the oncreate handler.
aInitialized := false; //we have not performed our special code yet.
Inside onActivate have something like this
if not aInitialized then
begin
//our one time init code. special stuff or whatever
If successful
then set aInitialized := true
else aInitialized := false
end;
And how to close it without showing anything just add your terminate to the formshow. of course you need to test for some reason to close.. :)
Procedure Tmaindlg.FormShow(Sender: TObject);
Begin
If (shareware1.Sharestatus = ssExpired) or (shareware1.Sharestatus = ssTampered) Then
application.Terminate;
End;
In your DPR you will need to add a splash screen type effect. In my case I am showing progress as the application starts. You could also just show the form and get some data.
Code from the splash.pas
Procedure tsplashform.bumpit(str: string);
Begin
label2.Caption := str;
gauge1.progress := gauge1.progress + trunc(100 / items);
update;
If gauge1.progress >= items * (trunc(100 / items)) Then Close;
End;
Program Billing;
uses
Forms,
main in 'main.pas' {maindlg},
Splash in 'splash.pas' {splashform};
{$R *.RES}
Begin
Application.Initialize;
Application.Title := 'Billing Manager';
SplashForm := TSplashForm.Create(Application);
SplashForm.Show;
SplashForm.Update;
splash.items := 5;
SplashForm.bumpit('Loading Main...');
Application.CreateForm(Tmaindlg, maindlg);
SplashForm.bumpit('Loading Datamodule...');
Application.CreateForm(TfrmSingleWorkorder, frmSingleWorkorder);
SplashForm.bumpit('Loading SQL Builder...');
Application.CreateForm(TDm, Dm);
SplashForm.bumpit('Loading Security...');
Application.CreateForm(TSQLForm, SQLForm);
SplashForm.bumpit('Loading Reports...');
Application.CreateForm(Tpickrptdlg, pickrptdlg);
Application.Run;
End.

Resources