Discussion :

[ti-ben]

Bonjour,

J'ai un programme dans lequel je crée des composants à volonté et je les place où je veux dans la fenêtre (je l'utilise pour faire des design d'écran).

Je voudrais savoir comment faire un rectangle en maintenant le bouton de la souris et en la déplaçant pour sélectionner tous les composants qui se trouvent dans ce rectangle. Comme on fait en Windows sur le desktop, ça fait un rectangle en ligne pointillée...

J'ai beaucoup cherché sur le site mais je ne trouve pas. Alors est-ce que quelqu'un peut m'aiguiller?

Merci.

[ti-ben]

Alors personne? Sinon, à la limite, dessiner un rectangle transparent et, d'après les coordonnées, je sélectionnerai les composants qui s'y trouvent.

[skywaukers]

bonjour,

essaye avec :

Code :

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

Canvas.Rectangle( R);

@++
Dany

[ti-ben]

Merci, j'arrive <a dessiner un rectangle transparent. Mais il se dessine quand je lâche le bouton de la souris (onMouseUp). Y a-t-il moyen qu'il se dessine en bougeant la souris (Comme quand on sélectionne plusieurs items sur le desktop Windows par exemple)?

Merci.

[ti-ben]

Ça va, j'ai trouvé.

Merci encore.

[skywaukers]

bonjour,

oui, il suffit de le faire dans le OnMouseMove. Mais attention à effacer l'ancien

voici une petite unité écrite vite fait sur le gaz qui doit faire ce que tu veux :

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
77
78
79
80
81
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, LSUtils;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Déclarations privées }
    FDraw : Boolean;
    FOrigine : TPoint;
    FRect : TRect;
    procedure ClearSelection;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDraw then
  begin
    ClearSelection;
    FRect.Top := FOrigine.y;
    FRect.Left := FOrigine.X;
    FRect.Bottom := Y;
    FRect.Right := X;
    Canvas.Pen.Style := psDot;
    Canvas.Rectangle( FRect);
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  FDraw := False;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDraw := true;
  FOrigine.X := X;
  FOrigine.Y := Y;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDraw := false;
  ClearSelection;
end;
 
procedure TForm1.ClearSelection;
begin
  Canvas.Pen.Style := psClear;
  FRect.Bottom := FRect.Bottom + 1;
  FRect.Right := FRect.Right + 1;
  Canvas.Rectangle( FRect);
end;
 
end.

@++
Dany

[ti-ben]

Merci, c'est à peu près ce que j'avais fait. Maintenant j'essaie de faire la même chose sur un panel (J'ai une forme avec un panel dans lequel je veux dessiner) mais il n'existe pas de canvas alors j'essaie d'en créer un avec monCanvas := Tcanvas.create; et quand j'essaie de dessiner dessus (MonCanvas.rectangle...) j'ai le message "Canvas does not allow drawing"... Ça veut dire quoi?

[skywaukers]

bonjour,

oui, je suppose qu'il faut jouer sur les propriétés Top et Left de la même façon que j'ai joué sur les propriétés Rigth et bottom. Il faut donc tester dans quel sens s'efffectue le déplacement pour effacer correctement.

@++
Dany qui n'avait pas tout testé

[Thierry G.]

salut,

voici le code :

le dpr:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
program SelectionRectangle;
 
uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};
 
{$R *.res}
 
begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

le dfm:

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
object Form1: TForm1
  Left = 240
  Top = 107
  Width = 696
  Height = 466
  Caption = 'Utiliser un rectangle de s'#233'lection'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 8
    Top = 16
    Width = 241
    Height = 377
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
  end
  object Panel1: TPanel
    Left = 288
    Top = 24
    Width = 393
    Height = 369
    Color = clBtnShadow
    TabOrder = 1
    OnMouseDown = Panel1MouseDown
    OnMouseMove = Panel1MouseMove
    OnMouseUp = Panel1MouseUp
    object Panel2: TPanel
      Left = 8
      Top = 15
      Width = 185
      Height = 41
      Caption = 'Panel2'
      TabOrder = 0
    end
    object Panel3: TPanel
      Left = 200
      Top = 15
      Width = 185
      Height = 41
      Caption = 'Panel3'
      TabOrder = 1
    end
    object Panel4: TPanel
      Left = 8
      Top = 65
      Width = 185
      Height = 41
      Caption = 'Panel4'
      TabOrder = 2
    end
    object Panel5: TPanel
      Left = 200
      Top = 65
      Width = 185
      Height = 41
      Caption = 'Panel5'
      TabOrder = 3
    end
    object Panel6: TPanel
      Left = 8
      Top = 115
      Width = 185
      Height = 41
      Caption = 'Panel6'
      TabOrder = 4
    end
    object Panel7: TPanel
      Left = 200
      Top = 115
      Width = 185
      Height = 41
      Caption = 'Panel7'
      TabOrder = 5
    end
    object Panel8: TPanel
      Left = 8
      Top = 165
      Width = 185
      Height = 41
      Caption = 'Panel8'
      TabOrder = 6
    end
    object Panel9: TPanel
      Left = 200
      Top = 165
      Width = 185
      Height = 41
      Caption = 'Panel9'
      TabOrder = 7
    end
    object Panel10: TPanel
      Left = 8
      Top = 215
      Width = 185
      Height = 41
      Caption = 'Panel10'
      TabOrder = 8
    end
    object Panel11: TPanel
      Left = 200
      Top = 215
      Width = 185
      Height = 41
      Caption = 'Panel11'
      TabOrder = 9
    end
    object Panel12: TPanel
      Left = 8
      Top = 265
      Width = 185
      Height = 41
      Caption = 'Panel12'
      TabOrder = 10
    end
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 413
    Width = 688
    Height = 19
    Panels = <>
  end
end

l'unit:

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
{-----------------------------------------------------------------------------
 Unit Name: Unit1
 Author:    Propriétaire
 Date:      08-mars-2005
 Purpose:   Dessiner un rectangle de focalisation au dessus des contrôles
            contenus par un contrôle conteneur (ici un TPanel)
 History:
-----------------------------------------------------------------------------}
 
 
unit Unit1;
 
{!$Define Debugging}
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    Panel11: TPanel;
    Panel12: TPanel;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Canvas temporaire servant à dessiner le rectangle de focalisation }
    Canvas0: TCanvas;
    {Flag indiquant qu'une capture est en cours}
    Capturing: boolean;
    {Flag indiquant s'il y a déjà eu une capture}
    Captured: boolean;
    {Coordonnées du point de l'angle supérieur gauche de la capture}
    StartPlace: TPoint;
    {Coordonnées du point de l'angle inférieur droit de la capture}
    EndPlace: TPoint;
    { La fonction MakeRect renvoie les coordonnées d'un rectangle délimité
    soit soit le couple de points (Pt1, Pt2) ou (Pt2, Pt1).
    Inverse, si nécessaire les angles supérieur gauche (Pt1) et inférieur
    droit (Pt2). Un contrôle est aussi effectué pour que le rectangle de
    focalisation ne sorte pas des limites de Control.}
    function MakeRect(Pt1, Pt2: TPoint; Control: TControl): TRect;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Pour qu'un simple clic ne dessine pas un point sur Panel1
  StartPlace := Point(-1, -1);
end;
 
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Canvas0 := TCanvas.Create;
  Canvas0.Handle := GetDc(0);
  if Captured then
    //Effacement de l'ancien rectangle de sélection
    DrawFocusRect(Canvas0.Handle, MakeRect(StartPlace, EndPlace, Panel1));
  //Détermination du point de départ du dessin
  StartPlace := Panel1.ClientToScreen(Point(X, Y));
  EndPlace := StartPlace;
  //Dessin du nouveau rectangle de sélection
  DrawFocusRect(Canvas0.Handle, MakeRect(StartPlace, EndPlace, Panel1));
  Capturing := true;
  Captured := true;
end;
 
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  {Ne sert que pour l'utilisation de la fonction IntersectRect}
  OutRect: TRect;
  {Contient les coordonnées du composant à examiner}
  Rect1: TRect;
  {Contient les coordonnées du rectangle de focalisation}
  Rect2: TRect;
  i: integer;
  APanel: TPanel;
begin
  if Capturing then
  begin
    //Effacement de l'ancien rectangle de sélection
    DrawFocusRect(Canvas0.Handle, MakeRect(StartPlace, EndPlace, Panel1));
    {Actualiser les coordonnées du rectangle de focalisation}
    EndPlace := Panel1.ClientToScreen(Point(X, Y));
    {On examine chaque contrôle enfant de Panel1}
    for i := 0 to Panel1.ControlCount - 1 do
      if Panel1.Controls[i] is TPanel then
      begin
        APanel := Panel1.Controls[i] as TPanel;
        //Rect1 contient les coordonnées du bouton examiné
        Rect1 := APanel.BoundsRect;
        Rect1.TopLeft := APanel.ClientToScreen(Point(0,0));
        Rect1.BottomRight := APanel.ClientToScreen(Point(APanel.Width, APanel.Height));
{$IfDef Debugging}
        APanel.Caption := Format('T=%d, L=%d, B=%D, R=%d', [Rect1.Top,
          Rect1.Left, Rect1.Bottom, Rect1.Right]);
{$EndIf}
        //Rect2 contient les coordonnées du cadre de sélection
        Rect2 := MakeRect(StartPlace, EndPlace, Panel1);
 
        if IntersectRect(OutRect, Rect1, Rect2) then
          APanel.Color := clYellow
        else
          APanel.Color := clBtnFace;
        {forcer un redessinement des composants avant le dessin
        du rectangle de focalisation}
        Update;
{$IfDef Debugging}
        StatusBar1.SimpleText :=
          Format('Top : %d - Left : %d - Bottom : %d - Right : %d', [Rect2.Top,
            Rect2.Left, Rect2.Bottom, Rect2.Right]);
{$EndIf}
      end;
    //Dessin du nouveau rectangle de sélection
    DrawFocusRect(Canvas0.Handle, MakeRect(StartPlace, EndPlace, Panel1));
  end;
 
end;
 
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseDC(0, Canvas0.Handle);
  Canvas0.Free;
  Capturing := false;
end;
 
function TForm1.MakeRect(Pt1, Pt2: TPoint; Control: TControl): TRect;
var
  Bounds: TRect;
begin
  {On vérifie s'il faut inverser les coordonnées des angles
  supérieur gauche et inférieur droit}
  if pt1.x < pt2.x then
  begin
    Result.Left := pt1.x;
    Result.Right := pt2.x;
  end
  else
  begin
    Result.Left := pt2.x;
    Result.Right := pt1.x;
  end;
  if pt1.y < pt2.y then
  begin
    Result.Top := pt1.y;
    Result.Bottom := pt2.y;
  end
  else
  begin
    Result.Top := pt2.y;
    Result.Bottom := pt1.y;
  end;
 
  {pour limiter le dessin du rectangle de focalisation
   au contrôle Control.Cette partie peut être rendue facultative}
  {Traduction des limites en coordonnées écran}
  Bounds.TopLeft := Control.ClientToScreen(Point(0, 0));
  Bounds.BottomRight := Control.ClientToScreen(Point(Control.Width, Control.Height));
  {Vérification des limites}
  if Result.Left < Bounds.Left then
    Result.Left := Bounds.Left;
  if Result.Top < Bounds.Top then
    Result.Top := Bounds.Top;
  if Result.Right > Bounds.Right then
    Result.Right := Bounds.Right;
  if Result.Bottom > Bounds.Bottom then
    Result.Bottom := Bounds.Bottom;
end;
 
end.

bon test a plus.