具有Delphi中给定宽高比的DrawFocusRect

发布时间：2020-12-15 09:13:31 所属栏目：大数据来源：网络整理

导读：我希望能够在图像上绘制一个FocusRect,它可以保持图像的纵横比.我的问题是,FocusRect仅取决于鼠标的y坐标.我只是不知道如何让矩形取决于两个鼠标坐标… 这是我的代码： procedure TForm1.AuswahlRechteck; //Due to this procedure it doesn't matter in whi

我希望能够在图像上绘制一个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,Y0));
  Image1.Canvas.DrawFocusRect(Rect(MX,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;

有人可以帮帮我吗？

亨利

解决方法

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;

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!