在Delphi中给定宽高比绘制焦点矩形

Question

我希望能够在图像上绘制一个FocusRect，保持图像的宽高比。我的问题是，FocusRect仅取决于鼠标的y坐标。我不知道如何让矩形依赖于鼠标的x和y坐标...以下是我的代码：

procedure TForm1.AuswahlRechteck; //Due to this procedure it doesn't matter in which corner the rectangle begins
begin                                                                           
  Image1.Canvas.DrawFocusRect(Rect(X0,Y0,MX,MY));
  Image1.Canvas.DrawFocusRect(Rect(X0,MY,MX,Y0));
  Image1.Canvas.DrawFocusRect(Rect(MX,MY,X0,Y0));
  Image1.Canvas.DrawFocusRect(Rect(MX,Y0,X0,MY));
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  X0:=X;
  MX:=X;
  Y0:=Y;
  MY:=Y;
  AuswahlRechteck;
  InMove:=true;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if InMove then
  begin
    AuswahlRechteck;
    MY:=Y;
    MX:=X;
    if (((MX < X0) AND (MY > Y0)) OR ((MX > X0) AND (MY < Y0))) then MX:=Round(X0-((MY-Y0)*Image1.Width/Image1.Height))
    else MX:=Round(X0+((MY-Y0)*Image1.Width/Image1.Height));    
    AuswahlRechteck;
  end;
end;

有人能帮我吗？

亨利

- Henry

---

我无法理解这个问题。如果你想让它依赖于x和y，那么如何保持纵横比呢？ - David Heffernan

此外，MulDiv 要比使用浮点数更好。 - David Heffernan

Answer 1

  private
    FSelecting: Boolean;
    FSelRect: TRect;
    FSelX: Integer;
    FSelY: Integer;
  end;

uses
  Math;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FSelX := X;
  FSelY := Y;
  FSelecting := True;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Scale: Single;
  W: Integer;
  H: Integer;
begin
  if FSelecting then
  begin
    Image1.Canvas.DrawFocusRect(FSelRect);
    Scale := Image1.Width / Image1.Height;
    W := X - FSelX;
    H := Y - FSelY;
    if (W <> 0) and (H <> 0) then
      if Abs(W) / Abs(H) > Scale then
        H := Round(Abs(W) / Scale) * Sign(H)
      else
        W := Round(Abs(H) * Scale) * Sign(W);
    FSelRect := Bounds(
      Min(FSelX, FSelX + W), Min(FSelY, FSelY + H), Abs(W), Abs(H));
    Image1.Canvas.DrawFocusRect(FSelRect);
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FSelecting := False;
end;

- NGLN

---

谢谢您的快速回复，但是在我看来，您代码的结果实际上与我的相同...我已经在YouTube上上传了一个视频，可能会更清楚地说明问题：http://www.youtube.com/watch?v=XrVKFFVJ9YA 当MX等于X0时，我希望FocusRect变得越来越小，直到消失。对于所有鼠标移动，我希望它像视频的前几秒钟所示，而不是最后五秒钟所示。 - Henry

我们的解决方案不同。我的计算确保鼠标光标始终在FocusRect上，而你的则不是。至于你的问题：尝试用< Scale替换> Scale，但这样鼠标光标就永远不会触摸到FocusRect了。你的“问题”只是你的要求的一个症状，它是无法修复的。 - NGLN

@henry，你想让焦点矩形依赖于x而不是y吗？ - David Heffernan

@David Heffernan 不，我希望它依赖于x和y。 - Henry

@NGLN：将“> Scale”更改为“< Scale”正是我想要的结果！我刚刚更改了FSelRect的赋值，以“if ((FSelX <> X) AND (FSelY <> Y)) then FSelRect := Bounds(Min(FSelX, FSelX + W), Min(FSelY, FSelY + H), Abs(W), Abs(H));”来修复一个小问题。现在它运行得非常好。非常感谢你们两个！ - Henry