Discussion :

[Invité]

Bonjour

Je cherche a presenter des vignettes 100x100 sur un TScrollBox
mais je voudrait pouvoir les selectionner a la souris par paquet
avec un rectangle de selection.

Quelqu'un a-t-il une methode pour realiser un rectangle de selection
dans un TScrollBox ou un TPanel ?

Merci

[MD Software]

IL ME SEMBLE et je dis bien IL ME SEMBLE avoir vu un composant de ce type dans la JVCL. Il permet de tracer un rectable de sélection.
A vérifier.

[Invité]

J'ai pas trouvé comment realiser un "rectangle de selection" avec JVCL

Quelqu'un sait comment faire ? avec ou sans JVCL

[Invité]

merci MD Software

j'ai trouvé un source delphi pour faire un rectangle de selection

[LadyWasky]

et avec le composant standard TBevel, ça ne marche pas ???

[copeau31]

ben moi je fais avec des TShape, c pas bien violent;
j avais fait aussi en dessinant un rectangle en XOR sur une image, mais je le deconseille.

avec les shape c facile

onmousedown
shape.create
left := x
top := y
width et height :=0

onmousemove
et boutton de la souris enfonce
width := x-left
height := y-top

onmouseup
shape.boudsrect te donne ton beau rectangle de selection

tchAo

[LadyWasky]

J'avais éventuellement un truc tout fait, je m'étais inspiré d'un code sur un site de "The Delphi Magazine" sur les "marching ants"

voici l'unité qui défini une classe :

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
 
unit UnitMA;
interface
uses Windows,Classes,ExtCtrls,types,Graphics,Controls;
type
  TSelection=class
  private
    Anchor: TPoint;
    FDotPattern: Byte;
    FDashMask: Byte;
    FHotRect: TRect;
    FStartMask: Byte;
    FColor1: TColor;
    FWhere:TWinControl;
    ATimer:TTimer;
    FColor2: TColor;
    procedure TimerEvent(Sender:TObject);
    procedure SetDotPattern(const Value: Byte);
    procedure SetTimerInterval(const Value: Cardinal);
    function GetTimerInterval: Cardinal;
    function GetAnimate: Boolean;
    procedure SetAnimate(const Value: Boolean);
    procedure SetStartMask(const Value: Byte);
    procedure SetNewHotRect(const Value: TRect);
    procedure SetColor1(const Value: TColor);
    procedure SetColor(const Value: TColor);
    procedure SetColor2(const Value: TColor);
  private
    procedure PaintHotRect;
  public
    constructor Create;
    destructor Destroy; override;
    procedure DrawHotRect;
    procedure SetHotRect (Where:TWinControl;X1, Y1, X2, Y2: Integer); overload;
    procedure SetHotRect (Where:TWinControl;ARect:TRect); overload;
    procedure StopHotRect;
    property DotPattern: Byte read FDotPattern write SetDotPattern;
    property StartMask: Byte read FStartMask write SetStartMask;
    property HotRect: TRect read FHotRect write SetNewHotRect;
    property TimerInterval:Cardinal read GetTimerInterval write SetTimerInterval;
    property Animate:Boolean read GetAnimate write SetAnimate;
    property Color1:TColor read FColor1 write SetColor;
    property Color2:TColor read FColor2 write SetColor2;
  end;
 
implementation
{ TSelection }
 
constructor TSelection.Create;
begin
  inherited;
  ATimer:=TTimer.Create(nil);
  ATimer.Enabled:=False;
  ATimer.OnTimer:=TimerEvent;
  ATimer.Interval:=100;
  FStartMask:= $80;
  FDotPattern:=$a0;
end;
 
destructor TSelection.Destroy;
begin
  ATimer.Free;
  inherited;
end;
 
procedure TSelection.DrawHotRect;
begin
  ATimer.Enabled:=True;
end;
 
procedure LineDDAProc(X, Y: Integer;dummy:TSelection); stdcall;
var C: Integer;
    FCanvas:TControlCanvas;
begin
  with dummy do
  begin
    FCanvas:=TControlCanvas.Create;
    FCanvas.Control:=FWhere;
    FCanvas.Lock;
    FDashMask := FDashMask shl 1;
    if FDashMask = 0 then FDashMask := 1;
    if (FDashMask and FDotPattern) <> 0 then C := FColor1 else C := FColor2;
    SetPixel(FCanvas.Handle, X, Y, ColorToRGB(C));
    FCanvas.Unlock;
    FCanvas.Free;
  end;
end;
 
 
procedure TSelection.SetHotRect(Where:TWinControl;X1, Y1, X2, Y2: Integer);
var Temp: Integer;
begin
  // Erase previous rectangle, if any
  StopHotRect;
 
  FWhere:=Where;
  Anchor.x := X1;  Anchor.y := Y1;
  if X1 > X2 then begin Temp := X1; X1 := X2; X2 := Temp; end;
  if Y1 > Y2 then begin Temp := Y1; Y1 := Y2; Y2 := Temp; end;
  FHotRect := Rect (X1, Y1, X2, Y2);
end;
 
procedure TSelection.TimerEvent(Sender: TObject);
begin
  PaintHotRect;
end;
 
procedure TSelection.PaintHotRect;
begin
  if (not Assigned(FWhere)) then Exit;
  FStartMask := StartMask shr 1;
    if FStartMask = 0 then StartMask := $80;
    FDashMask := StartMask;
 
    with HotRect do begin
      LineDDA (Left, Top, Right, Top, @LineDDAProc, Integer (Self));
      LineDDA (Right, Top, Right, Bottom, @LineDDAProc, Integer (Self));
      LineDDA (Right, Bottom, Left, Bottom, @LineDDAProc, Integer (Self));
      LineDDA (Left, Bottom, Left, Top, @LineDDAProc, Integer (Self));
    end;
end;
 
procedure TSelection.SetDotPattern(const Value: Byte);
begin
  FDotPattern := Value;
end;
 
procedure TSelection.SetTimerInterval(const Value: Cardinal);
begin
  if ATimer<>nil then ATimer.Interval:=Value;
end;
 
function TSelection.GetTimerInterval: Cardinal;
begin
  Result:=0;
  if ATimer<>nil then Result:=ATimer.Interval;
end;
 
function TSelection.GetAnimate: Boolean;
begin
  Result:=False;
  if ATimer<>nil then Result:=ATimer.Enabled;
end;
 
procedure TSelection.SetAnimate(const Value: Boolean);
begin
  if ATimer<>nil then ATimer.Enabled:=Value;
end;
 
procedure TSelection.SetStartMask(const Value: Byte);
begin
  FStartMask := Value;
end;
 
procedure TSelection.SetNewHotRect(const Value: TRect);
begin
  FHotRect := Value;
end;
 
procedure TSelection.SetColor(const Value: TColor);
begin
  FColor1 := Value;
end;
 
procedure TSelection.SetHotRect(Where: TWinControl; ARect: TRect);
begin
  SetHotRect(Where,ARect.Left,ARect.Top,ARect.Right,ARect.Bottom);
end;
 
procedure TSelection.StopHotRect;
begin
  ATimer.Enabled:=False;
  if not IsRectEmpty (FHotRect) then
  begin
      InflateRect (FHotRect, 1, 1);
      InvalidateRect (Fwhere.Handle, @FHotRect, True);
      InflateRect (FHotRect, -2, -2);
      ValidateRect (Fwhere.Handle, @FHotRect);
      UpdateWindow (Fwhere.Handle);
  end;
end;
 
procedure TSelection.SetColor1(const Value: TColor);
begin
  FColor1 := Value;
end;
 
procedure TSelection.SetColor2(const Value: TColor);
begin
  FColor2 := Value;
end;
 
end.

Et grosso modo, ça s'utilise comme ça :

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,UnitMA;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    ASEL:TSelection;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  //creer le cadre de selection
  ASEL:=TSelection.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ASEL.Free;
end;
 
//Afficher un cadre de selection, sur la fiche, autour du bouton 1
procedure TForm1.Button1Click(Sender: TObject);
var ARect:TRect;
begin
  //définition du rectangle
  AREct:=Button2.BoundsRect;
  InflateRect(ARect,2,2);
 
  //couleur des pointilés
  ASEL.Color1:=clBlue;
  ASEL.Color2:=clred;
 
  //initialisation du rectangle
  ASEL.SetHotRect(Form1,ARect);
 
  //activation
  ASEL.DrawHotRect;
end;
 
//désactive la selection
procedure TForm1.Button2Click(Sender: TObject);
begin
  ASel.StopHotRect;
end;
 
end.

...ici, ça dessine autour du bouton et comme ceci, dedans :

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
procedure TForm1.Button1Click(Sender: TObject);
var ARect:TRect;
begin
  //couleur des pointilés
  ASEL.Color1:=clyellow;
  ASEL.Color2:=clred;
 
  //initialisation du rectangle
  AREct:=Button1.ClientRect;
  InflateRect(ARect,-3,-3);
 
  ASEL.SetHotRect(Button1,ARect);
  //activation
  ASEL.DrawHotRect;
end;

voilà...

[copeau31]

waouuuu
c joli

ben parfois, il vaut quand meme mieux un gros copier-coller

++

[Invité]

voici le code pour un rectangle de selection avec scroll dans un scrollbox

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
 
procedure TForm1.ScrollBox1MouseDown(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, MakeRectVisible(sel_point1, sel_point2, ScrollBox1));
 
    //Détermination du point de départ du dessin
    sel_point1 := ScrollBox1.ClientToScreen(Point(X, Y));
    sel_point1.y := sel_point1.y + ScrollBox1.VertScrollBar.ScrollPos;
    sel_point2 := sel_point1;
 
    {}
    last_ScrollPos := 0;
 
    //Dessin du nouveau rectangle de sélection
    DrawFocusRect(Canvas0.Handle, MakeRectVisible(sel_point1, sel_point2, ScrollBox1));
    Capturing := true;
    Captured := true;
end;
 
procedure TForm1.ScrollBox1MouseMove(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: TShape;
begin
 
    if Capturing then
    begin
        //Effacement de l'ancien rectangle de sélection
        DrawFocusRect(Canvas0.Handle, MakeRectVisible(sel_point1, sel_point2, ScrollBox1));
 
        if ((ScrollBox1.Height-Y) < 10) then
            ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position + 6
 
        else if (Y < 10) then
            ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - 6;
 
        {}
        sel_point1.y := sel_point1.y - ScrollBox1.VertScrollBar.ScrollPos + last_ScrollPos;
 
        {Actualiser les coordonnées du rectangle de focalisation}
        sel_point2 := ScrollBox1.ClientToScreen(Point(X, Y));
 
        {}
        last_ScrollPos := ScrollBox1.VertScrollBar.ScrollPos;
 
        {On examine chaque contrôle enfant de Panel1}
        nb_thumbs_selected := 0;
        for i := 0 to ScrollBox1.ControlCount - 1 do
        if ScrollBox1.Controls[i] is TShape then
        begin
            APanel := ScrollBox1.Controls[i] as TShape;
            //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));
 
            //Rect2 contient les coordonnées du cadre de sélection
            Rect2 := MakeRect(sel_point1, sel_point2, ScrollBox1);
 
            if IntersectRect(OutRect, Rect1, Rect2) then
            begin
                nb_thumbs_selected := nb_thumbs_selected + 1;
                APanel.Pen.Color := clYellow
            end
            else
                APanel.Pen.Color := clGray;
 
            {forcer un redessinement des composants avant le dessin
            du rectangle de focalisation}
            Update;
        end;
 
        Memo2.Lines.Add(AnsiString('nb_thumbs_selected=')+IntToStr(nb_thumbs_selected));
 
        //Dessin du nouveau rectangle de sélection
        DrawFocusRect(Canvas0.Handle, MakeRectVisible(sel_point1, sel_point2, ScrollBox1));
    end;
 
end;
 
procedure TForm1.ScrollBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    //Effacement de l'ancien rectangle de sélection
    DrawFocusRect(Canvas0.Handle, MakeRectVisible(sel_point1, sel_point2, ScrollBox1));
 
    ReleaseDC(0, Canvas0.Handle);
    Canvas0.Free;
    Capturing := false;
    Captured := 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;
end;
 
function TForm1.MakeRectVisible(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;

[anapurna]

salut

voir fonction api windows

Code :

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

1
2
3
4
BOOL DrawFocusRect(
    HDC hDC,	// handle to device context
    CONST RECT *lprc	// pointer to structure for rectangle  
   );

il ne fait qu'un bete xor donc pour l'anuler il suffit de refaire un DrawFocusRect sur le meme rectangle

@+ Phil

PS met le tag resolue si le thread est fini meerci par avance