当我点击并拖动鼠标时,我需要实现一个平移,然后朝着/远离使用鼠标滚轮的鼠标光标进行缩放/缩放. (在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;