圖形32：用鼠標拖動，用鼠標滾輪縮放到鼠標光標

Question

我需要實現一個平移，因爲我點擊並拖動鼠標，並且朝向/遠離使用鼠標滾輪的鼠標光標縮放/取消縮放。 （在Delphi 2010中，將圖像固定到左側，右側，頂部，底部的形式）。

我剛剛安裝了Graphics32並查看了它的內置滾動條和.Scale如何允許其中的一部分。至少可以很容易地達到這個目標。

問題：

Graphics32是這種事情的好工具嗎？有沒有其他的（也許更簡單？）工具，我可以看看？

有沒有人有任何指針或示例代碼如何實現上述？

謝謝。

Answer 1

Graphics32提供了一個名爲TImgView32的組件，可以通過設置Scale屬性進行縮放。這樣做的適當方法是使用OnMouseWheelUp和-Down事件。將TabStop設置爲True以觸發這些事件並將居中設置爲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:\Pictures\Mona_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, 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:\Pictures\Mona_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;