Discussion :

[NicolasR]

Voila je souhaite dans mon application pouvoir déplacer un shape en maintenant la souris enfoncée. J'arrive a le faire déplacer seulement je n'ai pas d'autre moyen que d'utilise la propriete repaint ou refresh du shape pour mettre a jour sa position du coup de temps en temps le shape se met a grésiller. De plus si je déplace la souris trop rapidement le shape lui ne suis pas et je ne sais pas comment faire en sorte que le curseur de la souris soit toujours au meme emplacement sur le shape lorsque je déplace le curseur ce qui je penses devrai pouvoir résoudre le probleme de vitesse.
Si quelqu'un pouvait m'aider à resoudre ce probleme. Voici mon code :

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
 
procedure TFormJeux.shcasseMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var position: TPoint;
var i: integer;
begin
GetCursorPos(Position);
i:=position.X;
// tant que le bouton de la souris est enfoncé
while GetAsyncKeyState(VK_LBUTTON) And $8000<>0 do
  begin
    GetCursorPos(Position);
    begin
        shcasse.Left:=shcasse.Left-1;
        shcasse.Repaint;
     end;
 
    if position.X>i then
      begin
        shcasse.Left:=shcasse.Left+1;
        shcasse.Repaint;
      end;
 
       i:=position.X;
 
  end;
end;

Merci d'avance 8)

[Nono40]

La boucle While en plein milieu d'un OnMouseMov n'est pas une habitude à prendre.

Il faut gérer le OnMouseDown et OnMouseMove du composant :

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
Var X0,Y0:Integer;
procedure TForm1.shCasseMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Var Position:TPoint;
begin
  GetCursorPos(Position);
  Position:=ShCasse.Parent.ScreenToClient(Position);
  If ssLeft In Shift Then
  Begin
    shCasse.Left := Position.X-X0;
    shCasse.Top  := Position.Y-Y0;
  End;
end;
 
procedure TForm1.shCasseMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If Button=mbLeft Then
  Begin
    X0:=X;
    Y0:=Y;
  End;
end;

[NicolasR]

Merci beaucoup ca marche