delphi – Graphics32：用鼠标拖动平移,用鼠标滚轮缩放到鼠标光

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

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：

uses
  Windows,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 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) 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,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;