...move a TImage in a scrollbox with the mouse?

Author: Ronald Rethfeldt
Homepage: http://www.rogasoft.de

Category: VCL

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 Platzieren Sie auf einer TForm eine TScrollBox. Fügen Sie dann in
 die TScrollBox ein TImage ein und setzen Sie bei "Left" und "Top"
 jeweils den Wert 0 sowie "Autosize" auf True.
 Weisen Sie dem TImage ein Bild, dessen Maße die der ScrollBox
 überschreiten, zu.

 Hinweis: Beim sehr schnellen Bewegen des Bildes treten allerdings
 noch Fehler auf!

 Tipp: Setzen Sie bei der TScrollBox unter "HorzScrollBar" und
 "VertScrollBar" jeweils das "Tracking" auf True.
 Um ein Bildflackern während des Verschiebens zu vermeiden,
 sollte während dieser Aktion bei der TScrollBox "DoubleBuffered"
 eingeschaltet sein.
 
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 (( The extent of the Bitmap in the TImage should be larger than
    the extent of the ScrollBox ))
 
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

var
    
StartX,
    StartY,
    MoveX,
    MoveY: Integer;
  IsMoved: Boolean;

implementation

procedure 
TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if 
Button = mbLeft then
  begin
    
IsMoved := True;
    StartX  := X;
    StartY  := Y;
    MoveX   := X;
    MoveY   := Y;
    Scrollbox1.DoubleBuffered := True;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if 
isMoved then
  begin
    if 
(X < MoveX) and
      
((Image1.Left + Image1.Width + 25) > Scrollbox1.Width) then
      
Image1.Left := Image1.Left + (X - StartX);

    if (X > MoveX) and (Image1.Left < 0) then
      
Image1.Left := Image1.Left + (X - StartX);

    if (Y < MoveY) and
      
((Image1.Top + Image1.Height + 25) > Scrollbox1.Height) then
      
Image1.Top := Image1.Top + (Y - StartY);

    if (Y > MoveY) and (Image1.Top < 0) then
      
Image1.Top := Image1.Top + (Y - StartY);

    MoveX := X;
    MoveY := Y;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var 
  
tr1, tr2: TRect;
begin
  if 
Button = mbLeft then
  begin
    
IsMoved := False;
    Scrollbox1.DoubleBuffered := False;
  end;
end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base