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

当我点击并拖动鼠标时,我需要实现一个平移,然后朝着/远离使用鼠标滚轮的鼠标光标进行缩放/缩放. (在Delphi 2010中,图像锚定在表单的左侧,右侧,顶部,底部.)

我刚安装了Graphics32,看看它的内置滚动条和.Scale如何允许其中一些.到目前为止,这是非常容易的.

问题：

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:\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,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:\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) 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;

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

解决方法

猜你在找的Delphi相关文章