DrawFocusRect with given aspect ratio in Delphi

Question

I want to be able to draw a FocusRect on an image, which keeps the aspect ratio of the image. My problem is, that the FocusRect only depends on the y coordinates of the mouse. I just don't know how to let the rectangle depent on both mouse coordinates... This is my code:

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;

Could someone help me please?

Henry

I can't understand the question. If you want it to depend on x and y, how can you maintain aspect? — David Heffernan, Aug 20 '11 at 14:18

NGLN · Accepted Answer · 2011-08-20T15:15:40.477

2

  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;

edited Aug 20 '11 at 15:15

answered Aug 20 '11 at 14:55

NGLN

43,011
8
105
200

Thank you for the quick response, but the result of your code is actually the same as mine in my eyes... I habe uploaded a video on YouTube which might make the problem clearer: http://www.youtube.com/watch?v=XrVKFFVJ9YA I want the FocusRect getting smaller and smaller until it disappears when MX is equal to X0. I want it as shown in the first seconds of the video for all mouse movements and NOT as shown in the last five seconds. – Henry Aug 20 '11 at 16:21
1

Our solutions are not the same. My calculation assures the mouse cursor always on the FocusRect, yours not. As for your question: try replacing `> Scale` with `< Scale`, but then the mouse cursor is never touching the FocusRect. Your _problem_ is just a symptom of your requirement and it's not fixable. – NGLN Aug 20 '11 at 16:38
@henry you want focus rect dependent on x but not y? – David Heffernan Aug 20 '11 at 17:04
@David Heffernan No, I want it to depend on x AND y. – Henry Aug 20 '11 at 17:48
@NGLN: Changing "> Scale" to "< Scale" brought me exactly the result I wanted to have! I've just changed the assignment of FSelRect to "if ((FSelX <> X) AND (FSelY <> Y)) then FSelRect := Bounds(Min(FSelX, FSelX + W), Min(FSelY, FSelY + H), Abs(W), Abs(H));" to fix a little issue. Now it works very fine. Thank you two very much! – Henry Aug 20 '11 at 17:49

DrawFocusRect with given aspect ratio in Delphi

1 Answers1