Problème de persistance de Screen.Cursor

**Gilbert Geyer** · 07/04/2010, 13h53

Bonjour,

J'affecte un nouveau cursor à l'écran comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
implementation

{$R *.dfm}
{$R Cursor2.res}

        ....
        ....
        Screen.Cursors[5]:=LoadCursor(HInstance,'CURSDELIM');
        Screen.Cursor:=5;
        ....

... et le curseur de la souris prend effectivement la forme du nouveau curseur
mais uniquement tant que je le déplace sur ma fiche et dès qu'il dépasse le bord de la fiche il reprend une autre forme bien que je l'ai affecté à Screen et non à la Form. Or je veux utiliser ce curseur justement en dehors de la fiche pour une capture d'écran localisée.
Comment faire pour rendre ce curseur persitant en-dehors des limites de ma fiche S.V.P ??? (ça doit encore être un truc tout simple, mais comme je galère depuis un moment...)

A+

**Andnotor** · 07/04/2010, 16h05

Screen représente l'écran dans le contexte de ton application. Je ne pense pas que ce soit aussi simple que ça

.

La seule chose qui me vienne à l'esprit est de faire un hook et d'intercepter WM_SETCURSOR.

**Gilbert Geyer** · 07/04/2010, 16h22

Re-bonjour,

faire un hook et d'intercepter WM_SETCURSOR

... oui, mais on fait comment ???

A+.

**Andnotor** · 07/04/2010, 17h29

L'exe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    DLL  :THandle;
    Hook :hHook;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  HookProc    :pointer;
  SetHookInfo :procedure (aHook :HHook); stdCall;
 
begin
  DLL := LoadLibrary(PChar(ExtractFilePath(Application.ExeName) +'SetCurHook.dll'));
 
  if DLL <> 0 then
  begin
    HookProc     := GetProcAddress(DLL, 'HookProc');
    @SetHookInfo := GetProcAddress(DLL, 'SetHookInfo');
 
    Hook := SetWindowsHookEx(WH_CALLWNDPROCRET, HookProc, DLL, 0);
    SetHookInfo(Hook);
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if DLL <> 0 then
  begin
    UnhookWindowsHookEx(Hook);
    FreeLibrary(DLL);
  end;
end;
 
end.

La DLL (SetCurHook.DLL) à placer dans le même répertoire que l'exe:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
library SetCurHook;
 
uses
  Windows, Messages;
 
{$R *.res}
 
var
  Hook :HHook;
 
procedure SetHookInfo(aHook :HHook); stdCall;
begin
  Hook := aHook;
end;
 
function HookProc(nCode: integer; wParam: WPARAM; lParam: LPARAM):LRESULT; stdcall;
var
  Cur :hCursor;
 
begin
  if (nCode >= 0) and
     (PCWPRetStruct(lParam).Message = WM_SETCURSOR) then
  begin
    Cur := LoadCursorFromFile('C:\Windows\Cursors\3dsmove.cur');
    SetCursor(Cur);
    Result := 0;
  end
  else Result := CallNextHookEx(Hook, nCode, wParam, lParam);
end;
 
Exports
  SetHookInfo,
  HookProc;
 
begin
end.

Tu peux bien sûr placer et retirer le hook dans d'autres événements.

**Andnotor** · 07/04/2010, 18h12

Une autre variante pour simplifier au maximum les déclarations dans l'exe

.

Exe:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
  end;
 
var
  Form1: TForm1;
 
  procedure StartCursorHook; stdcall external 'SetCurHook.dll';
  procedure StopCursorHook;  stdcall external 'SetCurHook.dll';
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  StartCursorHook;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  StopCursorHook;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  StopCursorHook;
end;
 
end.

DLL:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
library SetCurHook;
 
uses
  Windows,
  Messages;
 
{$R *.res}
 
var
  Hook :HHook;
 
function HookProc(nCode: integer; wParam: WPARAM; lParam: LPARAM):LRESULT; stdcall;
var
  Cur :hCursor;
begin
  if (nCode >= 0) and
     (PCWPRetStruct(lParam).Message = WM_SETCURSOR) then
  begin
    Cur := LoadCursorFromFile('C:\Windows\Cursors\3dsmove.cur');
    SetCursor(Cur);
    Result := 0;
  end
  else Result := CallNextHookEx(Hook, nCode, wParam, lParam);
end;
 
procedure StartCursorHook; stdCall;
begin
  Hook := SetWindowsHookEx(WH_CALLWNDPROCRET, HookProc, hInstance, 0);
end;
 
procedure StopCursorHook; stdCall;
begin
  UnhookWindowsHookEx(Hook);
end;
 
Exports
  StartCursorHook,
  StopCursorHook;
 
begin
end.

**Gilbert Geyer** · 08/04/2010, 10h46

Bonjour,

Mille fois merci Andnotor : Je vais tester tout ça.

A+.

**Gilbert Geyer** · 08/04/2010, 12h19

Re,

Ok, j'ai déjà testé la première variante qui marche sous D5.
Mille fois merci.

A+.

**Gilbert Geyer** · 08/04/2010, 12h46

Re,

La deuxième variante marche également et est effectivement plus simple à utiliser : Mille fois merci

A+.

**Gilbert Geyer** · 09/04/2010, 11h13

Bonjour,

Juste une dernière question : Est-ce-une obligation technique qui est à l'origine de la création d'une DLL ou tout simplement une préférence ???
S'il s'agit d'une obligation technique cela m'intéresserait de savoir laquelle ???

Cordialement, et à +.

**Andnotor** · 09/04/2010, 11h49

Tout simplement parce que le code doit être injecté et exécuté dans chaque processus et non pas seulement dans celui de ton application.
Cette injection se fait obligatoirement par DLL

.

**Gilbert Geyer** · 09/04/2010, 14h08

Re,

Merci beaucoup pour ta réponse. Je me disais bien qu'il y avait une raison pour laquelle il fallait passer par une DLL.

En tous cas mille fois merci : ça marche impec.

A+.

**Andnotor** · 09/04/2010, 16h18

Juste une petite correction dans mon premier exemple:

La procédure SetHookInfo() ne sert bien sûr à rien ! L'initialisation de la variable Hook définie dans la DLL ne sera de toute façon pas partagée entre processus. Quant à CallNextHookEx, il ne requière plus cette donnée depuis... un bout de temps !

**Gilbert Geyer** · 09/04/2010, 18h17

Re,

Merci pour les infos concernant la petite correction dans le premier exemple.
Mais il se trouve que j'ai retenu la deuxième variante qui simplifie au maximum les déclarations dans l'exe.

Cordialement, en tous cas merci, et à +.