Roulette sur TimageRésolu

Question

J'ai posé un Timage sur un panel. Je déplace l"image sans problèmes ( voir code ci-après ); mais je souhaiterai également y faire un zoom ( plus et moins ) avec la roulette mais il n'existe pas de ImagexxxMouseWheel. Une solution pour l'utilisation de la roulette ? Merci var Form1: TForm1; StartX,StartY : Integer; ................ ................ implementation procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin StartX := X; StartY := Y; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (ssLeft in Shift) then // verifie que le bouton gauche est enfonce. begin Image1.Left := Image1.Left-(StartX-X); //Translation horizontale. Image1.Top := Image1.Top -(StartY-Y); //Translation verticale. //Si on veut faire correspondre le bord du Bitmap au bord du Panel //if Image1.Left < 0 then Image1.Left := 0; //if Image1.Top < 0 then Image1.Top := 0; if Image1.Left > Panel4.Width -4 then Image1.Left := Panel4.Width - 4; if Image1.Top > Panel4.Height -4 then Image1.Top := Panel4.Height - 4 ; // Pour ne pas perdre la totalité de l'image end; end;

cs_rt15 · Accepted Answer

Salut,


Ta form doit avoir ce qu'il faut (MouseWheelUp, ...)


N'oublie pas de mettre Handled à True !


Il faudrat peut être que tu fasses un test sur le focus, mais ça, c'est à toi de voire.

rivaud_renee · Answer

Bonsoir,

En fait je n'avais pas compris c'est que les évènements (MousewheelUp, ... ) étaient liés à la Form sans tenir compte des composants posés sur celle-ci.

J'ai donc codé le programme suivant (  ne pas faire attention à la qualité du code, c'est le résultat immédiat pour l'exemple qui compte ) et j'ai bien le résultat attendu. 

Faire attention si d'autres composants ont besoin de la roulette !!!
Merci pour le coups de main

{
 attention propriété image:
 Align=alNone
 AutoSize=false
 Center=false
 proportional=true
 Stretch=false
  }

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
     if WheelDelta<0 then
        begin
        image1.Width:=image1.Width-10;
        image1.Height:=image1.Height-10;
        end;
     if WheelDelta>0 then
        begin
        image1.Width:=image1.Width+10;
         image1.Height:=image1.Height+10;
         end;

end;

Roulette sur Timage

2 réponses

Votre réponse

Discussions similaires