Discussion :

[Invité]

Bonjour,

j'aimerais déplacer une TForm par son background et étendre cette capacité à ses TControls. Par exemple, si je place un TPanel sur la Form, je veux déplacer la Form en me plaçant sur le TPanel, en cliquant dessus puis en le déplaçant, la Form restant évidemment "solidaire" du Panel.

J'ai produit un code qui me donne presque satisfaction. En réalité, il est fonctionnel si je n'utilise pas la méthode OnClick des TControls (s'ils en disposent). Les OnMouseDown, Move et Up utilisés pour gérer le mouvement entrent en "conflit" avec le OnClick [Le relâchement du bouton de la souris déclenchant le OnClick]. J'ai vu des approches avec sleep() mais c'est peu ergonomique car le temps du sleep(), la souris bouge sans entrainer la Form.

J'utilise une autre approche un peu lourde au niveau du code. Il y a longtemps que je n'ai pas utilisé Lazarus. Aussi est-il possible d'envisager une meilleure approche ? Je joins mon code en Zip.

Merci par avance de vos réponses. Cordialement.

[tourlourou]

Bonjour,

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
procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  bPotentiallyMoving := False; // le test en dernière ligne sera donc touours faux
  if iniPos = tmpPos then
    if Sender is TButton then
    begin
      if TButton(Sender).Name = 'Button1' then
        btClick1();
      if TButton(Sender).Name = 'Button2' then
        btClick2();
      if TButton(Sender).Name = 'Button3' then
        btClick3(Sender);
    end
    else
    if bPotentiallyMoving then
      ReleaseCapture;

Pour le OnClick, tu peux peut-être le désactiver au MouseDown en le mettant à nil, puis le déclencher au MouseUp si la souris n'a pas bougé (ou d'un epsilon).

[Invité]

Bonjour,
Merci pour ta réponse.

J'ai envisagé [1] ou essayé d'autres approches [2 & 3] (sans plus de simplicité ou sans succès) :

1. Désactiver l'event et le réactiver serait possible dans un composant surchargé. Mais pour l'instant, c'est pour un usage très ponctuel [un tchat de "bureau"]. On ajoute une propriété et une méthode.
2. On peut utiliser Button3.OnClick := nil; Mais cela suppose de faire une copie de OnClick pour chaque Tcontrol cliquable. C'est en quelque sorte ce que je fais actuellement.
3. Et utiliser TButton.Enabled ne semble pas bien fonctionner dans mon code.

A bientôt. Cordialement.

[Andnotor]

Je ne sais pas dans quelle mesure c'est traduisible sous Lazarus mais en Delphi on pourrait intercepter le message "bouton souris" et faire croire que le pointeur se trouve sur la barre de titre.

A l'aide d'un TApplicationEvents.OnMessage :

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
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var
  Control :TControl;
 
begin
  if Msg.message = WM_LBUTTONDOWN then
  begin
    Control := ControlAtPos(ScreenToClient(Msg.pt), FALSE, TRUE, TRUE);
 
    if not Assigned(Control) or Control.InheritsFrom(TCustomPanel) then
    begin
      SendMessage(Handle, WM_NCLButtonDown, HTCaption, 0);
      Handled := TRUE;
    end;
  end;
end;

Peut-être TApplicationProperties.OnUserInput ?

[Invité]

Bonjour,

je vais essayer... de comprendre l'astuce d'abord puis ensuite de la porter sous Lazarus. Merci pour la piste. Cordialement .

[Invité]

Bonjour Andnotor,

je dois mal m'y prendre.
J'ai essayé ainsi :

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
  //Added
  LCLIntf, LCLType, LMessages, ExtCtrls, StdCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    Button1: TButton;
    Label1: TLabel;
    Panel1: TPanel;
    procedure ApplicationProperties1UserInput(Sender: TObject; Msg: cardinal);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
  i: integer;
 
implementation
 
{$R *.lfm}
 
procedure TForm1.ApplicationProperties1UserInput(Sender: TObject; Msg: cardinal);
begin
  if Msg = LM_LBUTTONDOWN then
  begin
    if i = 1 then
    begin
      ReleaseCapture();
      SendMessage(Self.Handle, LM_NCLButtonDown, HTCaption, 0);
      Inc(i);
      label1.Caption := IntToStr(i);
    end;
    // else
    //  SendMessage(Self.Handle ,LM_NCLButtonDown, HTCLIENT, 0);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Inc(i);
  label1.Caption := IntToStr(i);
  ShowMessage('Button ' + IntToStr(i));
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  i := 0;
  label1.Caption := IntToStr(i);
end;
 
procedure TForm1.Panel1Click(Sender: TObject);
begin
  Inc(i);
  label1.Caption := IntToStr(i);
  ShowMessage('Panel ' + IntToStr(i));
end;
 
end.

Lorsque i vaut 1, la fenêtre doit pouvoir bouger lorsqu'un LM_LBUTTONDOWN est "engagé", désactivant alors l'exécution de la méthode OnClick du contrôle sur lequel s'exécute l'action. Si i <> 1 alors un MouseDown entraine l'exécution de la méthode OnClick du Tcontrol.
Je n'en suis pas loin.

Lorsque i vaut 1, si je clique sur le Tbutton ou le TPanel, effectivement la fenêtre peut bouger et i passe à 2. Mais normalement, si je clique sur le bouton, le panel ou le close de la Form, puisque i vaut 2, la méthode Showmessage(...) ou Close() devrait fonctionner; Or il faut attendre que i ait pour valeur 3 (donc un clic supplémentaire) pour qu'ils fonctionnent (à nouveau). Au niveau ergonomie, c'est un peu ennuyeux.

En supposant que l'on puisse pallier ce petit défaut ergonomique, quel indicateur permettra de décider si la fenêtre doit bouger (et dans ce cas le OnClick ne fonctionne pas) ou si c'est le OnClick qui prévaut ? J'ai utilisé i mais évidemment il faut procéder autrement. Or dans la cinématique des évènements on a d'abord OnMouseDown puis onMouseMove si on veut déplacer un objet. Si j'intercepte le OnMoseDown (LM_LBUTTONDOWN), je ne peux plus tester le OnMouseMove comme point de repère comme je l'ai fait dans mon approche de base (d'autant que le Msg est un "simple" cardinal dans ApplicationProperties1UserInput. J'ai du mal à imaginer le fonctionnement de cette approche mais cela vient probablement du fait que je suis encore dans ma précédente approche.

Si tu as un petit peu de temps, merci pour ton éclairage. Cordialement.

[Invité]

Bonsoir,

je pense que cela fonctionne maintenant :

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
53
54
55
56
57
58
59
60
61
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
  //Added
  LCLIntf, LCLType, LMessages, ExtCtrls, StdCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    Button1: TButton;
    Panel1: TPanel;
    procedure ApplicationProperties1UserInput(Sender: TObject; Msg: cardinal);
    procedure Button1Click(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
  private
    bPotentiallyMoving: boolean;
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
procedure TForm1.ApplicationProperties1UserInput(Sender: TObject; Msg: cardinal);
 
begin
  if Msg = LM_LBUTTONDOWN then
    bPotentiallyMoving := True;
  if Msg = LM_LBUTTONUP then
    bPotentiallyMoving := False;
  if Msg = LM_MOUSEMOVE then
    if bPotentiallyMoving then
    begin
      ReleaseCapture();
      SendMessage(Self.Handle, LM_NCLButtonDown, HTCaption, 0);
    end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Button1Click');
end;
 
 
procedure TForm1.Panel1Click(Sender: TObject);
begin
  ShowMessage('Panel1Click');
end;
 
end.

En tout cas sous Windows. Je testerai demain sur Nux. Dans la mesure où je n'utilise pas les unités Windows ni ShellApi, il se pourrait que cela fonctionne aussi . Je mets cela au conditionnel : j'ai appris à méfier des "portages".
Merci beaucoup pour l'aide Andnotor.
Cordialement.