Einzelnen Beitrag anzeigen

Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#3

AW: Trägheitsberechnung bei Gestures

  Alt 8. Nov 2013, 18:56
Ich habe das Fehlen der Verarbeitung der Trägheitswerte gemeldet.

So sieht meine OnGesture momentan aus (gezeichnet wird asynchron abhängig von NeedsPaint damit man performant zoomen kann):
Delphi-Quellcode:
public
    StartDistance : integer;
    StartLocation : TPointF;
    StartPos : TPointF;
    LastZoomed : TDateTime;
    LastPanned : TDateTime;
    NeedsPaint : Boolean;
    CursorCircle : TCircle;
end;

procedure TForm1.Layout1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  Factor : double;
  NewScale : double;
  Speed : TPointF;
  Distance : TPointF;
begin
  if EventInfo.GestureID = igiZoom then
  begin
    if TInteractiveGestureFlag.gfBegin in EventInfo.Flags then
       StartDistance := EventInfo.Distance
    else
    begin
      Factor := EventInfo.Distance / StartDistance;
      if (Factor > 0.04) or (Factor < -0.04) then
      begin
        NewScale := Painter.Scale * Factor;
        if NewScale > MaxScale then
          NewScale := MaxScale;
        if (NewScale <= MaxScale) and (NewScale > 0.5) then
        begin
          Painter.Scale := NewScale;
          Imagecontrol1.Scale.X := NewScale/Painter.PaintedScale*Factor;
          Imagecontrol1.Scale.Y := NewScale/Painter.PaintedScale*Factor;
          CursorCircle.Scale.X := Painter.Scale;
          CursorCircle.Scale.Y := Painter.Scale;
          LastZoomed := Now;
          NeedsPaint := True;
        end;
      end;
      StartDistance := EventInfo.Distance;
    end;
  end
  else
  if Eventinfo.GestureID = igiDoubleTap then
  begin
    ShowMessage(Format('IW: %f BW: %d', [Imagecontrol1.Width, Painter.Bitmap.Width]));
  end
  else
  if EventInfo.GestureID = igiPan then
  begin
    // Um zu verhindern dass beim Beenden einer Zoomoperation die Bewegung des
    // zuletzt angehobenen Fingers als Bewegungswunsch angesehen wird.
    if MilliSecondsBetween(Now, LastZoomed) > 100 then
    begin
      if TInteractiveGestureFlag.gfBegin in EventInfo.Flags then
      begin
         StartLocation := EventInfo.Location;
         StartPos := EventInfo.Location;
         LastPanned := Now;
      end
      else
      if TInteractiveGestureFlag.gfEnd in EventInfo.Flags then
      begin
        Factor := MSecsPerDay*(Now-LastPanned);
        Distance.X := EventInfo.Location.X-StartPos.X;
        Distance.Y := EventInfo.Location.Y-StartPos.Y;
        Speed.X := Distance.X / Factor;
        Speed.Y := Distance.Y / Factor;
        AdjustPosition(Speed);
      end
      else
      begin
        ImageControl1.Position.X := ImageControl1.Position.X + (EventInfo.Location.X - StartLocation.X);
        ImageControl1.Position.Y := ImageControl1.Position.Y + (EventInfo.Location.Y - StartLocation.Y);
        Speed.X := 0;
        Speed.Y := 0;
        AdjustPosition(Speed);
        StartLocation := EventInfo.Location;
      end;
    end;
  end;
end;

procedure TForm1.AdjustPosition(ASpeed : TPointF);
begin
  // Trägheit simulieren
  if abs(ASpeed.X) > 1 then
     ImageControl1.AnimateFloat('Position.X', Imagecontrol1.Position.X+50*ASpeed.X, 0.5, TAnimationType.atOut, TInterpolationType.itQuadratic);
  if abs(ASpeed.Y) > 1 then
     ImageControl1.AnimateFloat('Position.Y', Imagecontrol1.Position.Y+50*ASpeed.Y, 0.5, TAnimationType.atOut, TInterpolationType.itQuadratic);

  // Ggf. Bounceback wenn zu nah an den Rand bewegt
  if ImageControl1.Position.X+(Imagecontrol1.Width/2) < 50 then
     ImageControl1.AnimateFloat('Position.X', 100-(Imagecontrol1.Width/2), 0.3)
  else
  if ImageControl1.Position.X > Layout1.Width -50 then
    Imagecontrol1.AnimateFloat('Position.X', Layout1.Width-100, 0.3);

  if ImageControl1.Position.Y+(Imagecontrol1.Height/2) < 50 then
     ImageControl1.AnimateFloat('Position.Y', 100-(Imagecontrol1.Height/2), 0.3)
  else
  if ImageControl1.Position.Y > Layout1.Height -50 then
    Imagecontrol1.AnimateFloat('Position.Y', Layout1.Height-100, 0.3);
end;
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat