PaintBox の MouseMove (ID:35777)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 バネ □／＼／＼／＼／＼／＼□ 物体１（固定） 物体２（可動） 物体２をマウスで動かしてバネを伸縮させるシミュレーションを考えています。 以下のようにコーディングしましたが、実際にはマウスポインタの移動より大きく伸縮してしまいます。物体の移動量を表すUSftXの扱いがおかしいのだと思いますが、いろいろ試行錯誤しても理想的な動きになりません。マウスの移動量に応じた動きにするにはどうしたらいいのでしょう？ private FOffBmp: TBitmap; FPrePoint: TPoint; procedure FDrawSpring; implementation var USftX: Integer; procedure TBaneFrm.FDrawSpring; var i, dy, oB: Integer; Points: array[0..11] of TPoint; begin //画面クリア FOffBmp.Canvas.Brush.Color := clBtnFace; FOffBmp.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height)); //バネ Points[0].x := 100; Points[0].y := 80; Points[1].x := Points[0].x+(USftX div 2); Points[1].y := 90; for i := 2 to 10 do begin dy := 70+(i mod 2)*20; Points[i].x := Points[i-1].x+USftX; Points[i].y := dy; end; Points[11].x := Points[10].x+(USftX div 2); Points[11].y := 80; FOffBmp.Canvas.Polyline(Points); //物体 FOffBmp.Canvas.Brush.Color := clWhite; FOffBmp.Canvas.Rectangle( 50, 60, 100, 100); //物体１-固定 oB := Points[11].x; FOffBmp.Canvas.Rectangle(oB, 60, oB+50, 100); //物体２-可動 //ライン FOffBmp.Canvas.MoveTo(0, 100); FOffBmp.Canvas.LineTo(Width, Round(100)); PaintBox1.Canvas.Draw(0, 0, FOffBmp); //画面に転送 end; procedure TBaneFrm.PaintBox1Paint(Sender: TObject); begin FDrawSpring; end; procedure TBaneFrm.FormCreate(Sender: TObject); var i: Integer; begin FOffBmp := TBitmap.Create; //裏画面 FOffBmp.Width := PaintBox1.Width; FOffBmp.Height := PaintBox1.Height; USftX := 10; //移動量初期値 end; procedure TBaneFrm.FormDestroy(Sender: TObject); begin FOffBmp.Free; end; procedure TBaneFrm.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if ssLeft in Shift then begin if (Y <100) and (Y > 50) then begin USftX := USftX+(X - FPrePoint.x); FDrawSpring; FPrePoint := Point(X, Y); end; end; end; procedure TBaneFrm.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then FPrePoint := Point(X, Y); end;