Graphics32:用鼠标拖动平移，用鼠标滚轮缩放到鼠标光标 [英] Graphics32: Pan with mouse-drag, zoom to mouse cursor with mouse wheel

问题描述

我需要在单击并拖动鼠标时实现平移，然后使用鼠标滚轮向/远离鼠标光标进行缩放/取消缩放.(在 Delphi 2010 中，图像锚定在窗体的左侧、右侧、顶部、底部.)

I need to implement a pan as I click and drag the mouse, and zoom/unzoom towards/away from the mouse cursor that uses the mouse wheel. (In Delphi 2010, with the image anchored to left,right,top,bottom the form.)

我刚刚安装了 Graphics32，并看到了它的内置滚动条和 .Scale 是如何实现这一点的.至少做到这一点非常容易.

I've just installed Graphics32 and seen how its built-in scroll bars and .Scale allow some of this. It's tantalizingly easy to at least get that far.

问题:

Graphics32 是做这种事情的好工具吗?是否还有其他(也许更简单?)工具可供我研究?

Is Graphics32 a good tool for this kind of thing? Are there other (perhaps more simple?) tools that I might look into?

有没有人有任何关于如何实现上述内容的指针或示例代码?

Does anyone have any pointers or sample code on how to implement the above?

谢谢.

推荐答案

Graphics32 提供了一个名为 TImgView32 的组件，它可以通过设置 Scale 属性进行缩放.这样做的适当方法是使用 OnMouseWheelUp 和 -Down 事件.将 TabStop 设置为 True 以触发这些事件，并将 Centered 设置为 False.但是以这种方式缩放并不符合您将缩放操作集中在鼠标光标处的愿望.因此，围绕该点重新定位和调整大小是一个更好的解决方案.此外，据我所知，图像总是在组件的左上角对齐，因此平移也必须通过重新定位组件来完成.

Graphics32 provides a component named TImgView32 which can zoom by setting the Scale property. The appropriate way to do so is by using the OnMouseWheelUp and -Down events. Set TabStop to True for triggering these events and set Centered to False. But scaling in this manner does not comply with your wish to center the zooming operation at the mouse cursor. So repositioning and resizing around that point is a nicer solution. Further, as I understand, the image is always aligned in the top-left corner of the component, so panning must also be accomplished by repositioning the component.

uses
  Windows, Classes, Controls, Forms, GR32_Image, GR32_Layers, Jpeg;

type
  TForm1 = class(TForm)
    ImgView: TImgView32;
    procedure FormCreate(Sender: TObject);
    procedure ImgViewMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FDragging: Boolean;
    FFrom: TPoint;
  end;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImgView.Bitmap.LoadFromFile('D:PicturesMona_Lisa.jpg');
  ImgView.TabStop := True;
  ImgView.ScrollBars.Visibility := svHidden;
  ImgView.ScaleMode := smResize;
end;

procedure TForm1.ImgViewMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
  ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
  R: TRect;
begin
  MousePos := ImgView.ScreenToClient(MousePos);
  with ImgView, MousePos do
    if PtInRect(ClientRect, MousePos) then
    begin
      R := BoundsRect;
      R.Left := Left + X - Round(ZoomFactor[WheelDelta > 0] * X);
      R.Top := Top + Y - Round(ZoomFactor[WheelDelta > 0] * Y);
      R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * Width);
      R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * Height);
      BoundsRect := R;
      Handled := True;
    end;
end;

procedure TForm1.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  FDragging := True;
  ImgView.Enabled := False; { Temporarily, to get MouseMove to the parent }
  FFrom := Point(X, Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragging then
    ImgView.SetBounds(X - FFrom.X, Y - FFrom.Y, ImgView.Width, ImgView.Height);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  ImgView.Enabled := True;
  ImgView.SetFocus;
end;

替代 TImage 而不是 TImgView32:

Alternative with TImage instead of TImgView32:

uses
  Windows, Classes, Controls, Forms, Jpeg, ExtCtrls;

type
  TForm1 = class(TForm)
    Image: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageDblClick(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FDragging: Boolean;
    FFrom: TPoint;
    FOrgImgBounds: TRect;
  end;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  Image.Picture.LoadFromFile('D:PicturesMona_Lisa.jpg');
  Image.Stretch := True;
  Image.Height := Round(Image.Width * Image.Picture.Height / Image.Picture.Width);
  FOrgImgBounds := Image.BoundsRect;
end;

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
  ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
  R: TRect;
begin
  MousePos := Image.ScreenToClient(MousePos);
  with Image, MousePos do
    if PtInRect(ClientRect, MousePos) and ((WheelDelta > 0) and
      (Height < Self.ClientHeight) and (Width < Self.ClientWidth)) or
      ((WheelDelta < 0) and (Height > 20) and (Width > 20)) then
    begin
      R := BoundsRect;
      R.Left := Left + X - Round(ZoomFactor[WheelDelta > 0] * X);
      R.Top := Top + Y - Round(ZoomFactor[WheelDelta > 0] * Y);
      R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * Width);
      R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * Height);
      BoundsRect := R;
      Handled := True;
    end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragging then
    Image.SetBounds(X - FFrom.X, Y - FFrom.Y, Image.Width, Image.Height);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image.Enabled := True;
  FDragging := False;
end;

procedure TForm1.ImageDblClick(Sender: TObject);
begin
  Image.BoundsRect := FOrgImgBounds;
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not (ssDouble in Shift) then
  begin
    FDragging := True;
    Image.Enabled := False;
    FFrom := Point(X, Y);
    MouseCapture := True;
  end;
end;

这篇关于Graphics32:用鼠标拖动平移，用鼠标滚轮缩放到鼠标光标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！