首页  编辑  

How to write an absolute on top window

Tags: /超级猛料/VCL/Form,窗体/模态窗体/   Date Created:

How to write an absolute on top window

How to write an absolute on top window ?

That is if and only if this window is closed,I can access other application

windows.

In win2k!

Thank you!

If setting the formstyle to fsStayOnTop does not serve your needs you have to

go the way Windows implements the screensaver: create a new desktop, sw 韙ch

to that, create a window on the new desktop. If that window is closed, switch

back to the normal desktop. All that will not prevent Ctrl-Alt-Del from

bringing up the login screen, of course.

OK, since it's Sunday and i'm a bit bored i decided to investigate the option

of creating a window on another desktop in some detail. This turned out to be

a bit more complex than i had assumed. Basically one has to create a new

thread that then creates the window in the context of the other desktop. This

thread has to have its own message loop. One can in fact use a Delphi form

for the window, but with some strict limitations. One cannot use components

from the Win32 tab of the component palette without problems, for instance,

since the common controls DLL has to be initialized for each thread

separately. Using standard controls like buttons, edits and labels is OK,

though. Using the standard VCL message loop functions (ProcessMesages and

ShowModal(!)) should also be avoided, since the standard message processing

may try to send messages on to the application or main form, which all belong

to a different desktop. Since it is not possible to send messages across

desktops this may cause problems.

Do not use ShowMessage or MessageDlg in the forms code, these use custom

forms using Application.Handle as parent (which is on another desktop!).

Use Windows.MessageBox if you have to show a message dialog.

My test form only had a single button:

unit Unit2;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 ComCtrls, StdCtrls, ExtCtrls;

type

 TForm2 = class(TForm)

   Button1: TButton;

   procedure Button1Click(Sender: TObject);

 private

   { Private declarations }

   procedure wmSyscommand( var msg: TWMSyscommand ); message WM_SYSCOMMAND;

 public

   { Public declarations }

   Procedure CreateParams( var params: TCreateParams ); Override;

 end;

var

 Form2: TForm2;

implementation

{$R *.DFM}

{ TForm2 }

// Need to make sure the form does not use application.handle as wndparent!

procedure TForm2.CreateParams(var params: TCreateParams);

begin

 inherited;

 params.WndParent := GetDesktopWindow;

end;

procedure TForm2.Button1Click(Sender: TObject);

begin

 modalresult := mrOK;

end;

// Trap attempt to close the window via close box or system menu, translate

// to mrCancel result.

procedure TForm2.wmSyscommand(var msg: TWMSyscommand);

begin

 inherited;

 if (msg.CmdType and $FFF0) = SC_CLOSE Then

   Modalresult := mrCancel;

end;

end.

THe main work is done in a thread class:

Unit NewDesktopThreadU;

interface

uses

 Windows, Classes, Controls, Forms;

type

 TNewDesktopThread = class(TThread)

 private

   FFormclass: TFormClass;

   FDesktop: HDESK;

   FResult: TModalResult;

 protected

   procedure Execute; override;

 public

   Constructor Create( aformclass: TFormClass; const aDesktopName: String );

   Destructor Destroy; override;

   class Function ShowMOdalFormOnDesktop( aformclass: TFormClass; const

aDesktopName: String ): TModalResult;

   property ShowResult: TModalResult read FResult;

 end;

implementation

uses sysutils;

{ TNewDesktopThread }

constructor TNewDesktopThread.Create(aformclass: TFormClass;

 const aDesktopName: String);

begin

 Assert( Assigned( aformclass ),

         'TNewDesktopThread.Create needs a form class' );

 Assert( aDesktopName <> '',

         'TNewDesktopThread.Create needs a desktop name' );

 inherited Create( true );

 FFormclass := aFormclass;

 FDesktop := CreateDesktop( Pchar( aDesktopname ), nil, nil, 0,

                            GENERIC_ALL, nil );

 If FDesktop = 0 Then

   RaiseLastOSError;

 Resume;

end;

destructor TNewDesktopThread.Destroy;

begin

 If FDesktop <> 0 Then

   CloseDesktop( FDesktop );

 inherited;

end;

procedure TNewDesktopThread.Execute;

var

 thisDesktop: HDESK;

 msg: TMsg;

begin

 FResult := mrCancel;

 thisdesktop:= GetThreadDesktop( MainthreadID );

 If SwitchDesktop( FDesktop ) Then

   Try

     If SetThreadDesktop( FDesktop ) Then

       with Fformclass.create( nil ) do

       try

         Show;

         Repeat

           While PeekMessage( msg, 0, 0, 0, PM_REMOVE ) Do Begin

             TranslateMessage( msg );

             DispatchMessage( msg );

           End;

           If ModalResult = mrNone Then

             If not WaitMessage Then Break;

         Until ModalResult <> mrNone;

         FResult := ModalResult;

       finally

         free;

       end;

   Finally

     SetThreadDesktop( thisDesktop );

     SwitchDesktop( thisDesktop );

   End { Finally }

end;

class function TNewDesktopThread.ShowMOdalFormOnDesktop(

 aformclass: TFormClass; const aDesktopName: String): TModalResult;

var

 thread: TNewDesktopThread;

begin

 thread := TNewDesktopThread.Create( aformclass, aDesktopname );

 try

   thread.WaitFor;

   Result := thread.ShowResult;

 finally

   thread.Free;

 end;

end;

end.

The class function is used to create an instance of this thread and show the

form on the other desktop:

procedure TForm1.Button1Click(Sender: TObject);

Begin

 case TNewDesktopThread.ShowModalFormOnDesktop( TForm2, 'myOwnDesktop' ) of

   mrOK: label1.Caption := 'OK';

   mrCancel: label1.Caption := 'Cancel';

 end;

End;

Only tested on Win2K SP3 using Delphi 7!

--

Peter Below (TeamB)  

Use the newsgroup archives :

http://www.mers.com/searchsite.html

http://www.tamaracka.com/search.htm

http://groups.google.com

http://www.prolix.be