我希望能够在图像上绘制一个FocusRect,它可以保持图像的纵横比.我的问题是,FocusRect仅取决于鼠标的y坐标.我只是不知道如何让矩形取决于两个鼠标坐标… 这是我的代码: procedure TForm1.
这是我的代码:
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;
有人可以帮帮我吗?
亨利
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;