在Delphi中具有给定纵横比的DrawFocusRect

Question

我希望能够在图像上绘制一个 FocusRect，它可以保持图像的纵横比。我的问题是， FocusRect 仅取决于鼠标的 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;

有人可以帮帮我吗？

亨利

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;