Deplaçer et Redimensioner un TShape

Version imprimable

26/06/2007, 16h45
Bourak

Deplaçer et Redimensioner un TShape

Salut les developpeurs.

J'ai utiliser 2 timage image1 et image2 et un tshape shape1 .
Je voudrais plaçer le shape1 sur l'image1 et en deplaçant le shape ou redimensionner ceci je voudrais avoir un copier de l'image selectionner dans l'image2.
J'ai utiliser les evenements du mouse du shape1 pour le redimensonnement mais je n'arrive pas à bien fixer les paramètres. Est ce que quelq'un peut m'aider à resoudre ce problème.

Merci d'avance

mon appli est une loupe, et apparemment ce que tu cherches à faire ressemble à ce prog:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
procedure Loupe(x, y, Size: Integer);
var
  Cadre1, Cadre2: TRect;
begin
  // définition d'un carré centré sur la position de la souris
  Cadre1.Top := y - Size - Form1.Top - GetSystemMetrics(SM_CYCAPTION);  // hauteur en pixel d'un caption
  Cadre1.Left := x - Size - Form1.Left;
  Cadre1.Right := x + Size - Form1.Left;
  Cadre1.Bottom := y + Size -Form1.Top - GetSystemMetrics(SM_CYCAPTION);
 
  // On récupère la taille de l'image pour afficher dedans l'image aggrandie.
  Cadre2.Top := 0;
  Cadre2.Left := 0;
  Cadre2.Right := Form1.Img.Width;
  Cadre2.Bottom := Form1.Img.Height;
 
  Form1.Img.Canvas.CopyRect(Cadre2, Form1.Canvas, Cadre1);

voila en espérant éclaircir un peu ton problème

ludo

26/06/2007, 17h10
Bourak

Merci pour ton aide

Mais comment puis j'integre ce programme . Est ce que dans l'evenement de l'image ou qoui.
26/06/2007, 17h13
Bourak

Merci

Mais mon programme selectionne une partie de l'image.
26/06/2007, 17h27
Ludo_360

Le principe reste le même : tu dois définir le cadre, dans mon cas je le défini autour de la souris... Toi tu défini ton cadre dans ton image.

ludo
26/06/2007, 17h34
petitcoucou31

salut ,

Je te conseille le composant "MRControl.pas", tu le pose sur ta fiche et tu peux deplacer ou redimentionner tous les composants intallés sur ta fiche en mode execution sans ajouter une ligne de code .

Par contre je ne sais pas ou j'avais trouver ce composant ( sur le net.. ) au besoin je pourrai toujour te le passer ..
26/06/2007, 17h37
Ludo_360

tu trouveras le code du MRControl.pas ici:

Citation:

http://herea.soft.free.fr/Unites/ALG/MRControl.HTM

et pour le telecharger:

Citation:

http://herea.soft.free.fr/Unites.htm

à "[FONT=Times New Roman, Times, serif]
TMRControl
V 1.0.0
D4/D5"[/FONT]

ludo

Merci à tous
mais ce n'est pass ça que je cherche.

Je voudrais tester sur le longeur et le largeur du composant shape.
Voici un exemple du code que j'ai realiser mais il permet le deplaçement horizontal seulement:

Code:

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
 
private 
var move :boolean;
x0,y0 :integer;
 
procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
move := true;
x0:=x;
y0:=y;
shape1.Pen.Style:=psSolid;
shape1.Pen.Color:=clnavy;
shape1.Pen.Width:=2;
end;
 
procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
 
begin
 
if move = true then
 begin
     if (shape1.Top = image1.top)  then
     begin
 
       if shape1.left <> image1.left then
        Shape1.left:=Shape1.Left+x-x0
       else
        shape1.left :=  image1.left +1;
     end;
 end;
 
end;
 
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
move := false;
resize := false;
shape1.Pen.Style:=psdash;
shape1.Pen.Color:=clred;
shape1.Pen.Width:=1;
end;

Merci en tous cas

Déplacement à la souris d'un TObject dans toutes les directions

A Bourak :

Citation:

...code que j'ai realisé mais il permet le deplaçement horizontal seulement

... à toutes fins utiles, voiçi une procedure qui permet le déplacement d'un TObject dans toutes les directions :
Code:

1 2 3 4 5 6 7 8 // Déplacement d'un TObject avec bouton gauche de la souris procedure DeplacerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); const SC_DragMove = $F014; begin if (ssLeft in Shift) then begin ReleaseCapture; TControl(Sender).Perform(WM_SysCommand, SC_DragMove, 0); end; end;
... et comment l'utiliser :
Code:

1 2 3 4 procedure TForm1.monTrucOuJeDetecteMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin DeplacerMouseMove(MachinADeplacer,Shift,X,Y); end;
... MachinADeplacer peut être par exemple :
- Form1 avec BorderStyle:=bsNone (= Form sans barre de titre) où cette barre de titre est remplacée par un labelTitrePersonnalisé qui joue le rôle de monTrucOuJeDetecteMouseMove,
- un TPanel invisible au départ pour servir par exemple de DialogBoxPersonnalisée et qui joue en même temps le rôle de monTrucOuJeDetecteMouseMove,
- ou bien tout autre machin du type TObject.

... donc :
Code:

1 2 3 4 5 Pour déplacer ton Shape dans tous les sens : procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin DeplacerMouseMove(Shape1,Shift,X,Y); end;
Remarque : Si MachinADeplacer est une Form son déplacement est libre sur toute l'étendue de l'écran, par contre si MachinADeplacer est prisonnier d'un conteneur ses déplacements sont limités aux bords du conteneur en question.
A+