如何在Delphi中为球体添加缩放、点击旋转等基础鼠标控制？

首先需要在窗体类的私有区域添加状态变量，用于记录缩放系数、旋转角度和鼠标位置：

type
  TForm1 = class(TForm)
    GlobeControl: TPaintBox; // 替换为你的球体承载控件
    procedure FormCreate(Sender: TObject);
    procedure GlobeMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
    procedure GlobeControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GlobeControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure GlobeControlPaint(Sender: TObject);
  private
    FScale: Single;          // 球体缩放系数
    FLastMousePos: TPoint;   // 鼠标按下时的位置
    FRotX, FRotY: Single;    // X、Y轴旋转角度
  public
  end;

初始化状态 #

在窗体创建时设置初始参数：

procedure TForm1.FormCreate(Sender: TObject);
begin
  FScale := 1.0;  // 初始缩放比例为1
  FRotX := 0;
  FRotY := 0;
end;

鼠标滚轮缩放实现 #

处理鼠标滚轮事件，根据滚轮方向调整缩放系数，并限制缩放范围：

procedure TForm1.GlobeMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; var Handled: Boolean);
begin
  // 滚轮向前（放大），系数乘1.1；向后（缩小），系数除以1.1
  if WheelDelta > 0 then
    FScale := FScale * 1.1
  else
    FScale := FScale / 1.1;

  // 限制缩放范围，避免过度缩放或缩小
  if FScale < 0.2 then FScale := 0.2;
  if FScale > 5.0 then FScale := 5.0;

  Handled := True;  // 标记事件已处理
  GlobeControl.Invalidate; // 触发控件重绘
end;

点击拖动旋转实现 #

通过鼠标按下、移动事件记录位移，计算旋转角度：

procedure TForm1.GlobeControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // 左键按下时记录当前鼠标位置
  if Button = mbLeft then
    FLastMousePos := Point(X, Y);
end;

procedure TForm1.GlobeControlMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  DeltaX, DeltaY: Integer;
begin
  // 左键按住时计算位移，更新旋转角度
  if ssLeft in Shift then
  begin
    DeltaX := X - FLastMousePos.X;
    DeltaY := Y - FLastMousePos.Y;

    // 调整旋转灵敏度，0.5可根据手感修改
    FRotY := FRotY + DeltaX * 0.5;
    FRotX := FRotX + DeltaY * 0.5;

    FLastMousePos := Point(X, Y);
    GlobeControl.Invalidate; // 触发重绘
  end;
end;

球体绘制（以TPaintBox为例） #

在控件的Paint事件中应用缩放和旋转参数，绘制球体：

procedure TForm1.GlobeControlPaint(Sender: TObject);
var
  Center: TPoint;
begin
  Center := Point(GlobeControl.ClientWidth div 2, GlobeControl.ClientHeight div 2);

  GlobeControl.Canvas.Save;
  // 平移画布到控件中心
  GlobeControl.Canvas.TranslateTransform(Center.X, Center.Y);
  // 应用缩放
  GlobeControl.Canvas.ScaleTransform(FScale, FScale);
  // 应用X、Y轴旋转
  GlobeControl.Canvas.RotateTransform(FRotX);
  GlobeControl.Canvas.RotateTransform(FRotY);

  // 绘制球体（此处用椭圆模拟，实际3D场景需用OpenGL等库实现）
  GlobeControl.Canvas.Ellipse(-50, -50, 50, 50);

  GlobeControl.Canvas.Restore;
end;

注意事项 #

• 将代码中的GlobeControl替换为你实际使用的球体承载控件（如自定义OpenGL控件、TPaintBox等）
• 若使用OpenGL等3D库，需通过修改模型视图矩阵实现缩放和旋转，例如：

  glScalef(FScale, FScale, FScale);
  glRotatef(FRotX, 1.0, 0.0, 0.0);
  glRotatef(FRotY, 0.0, 1.0, 0.0);
  

• 缩放范围、旋转灵敏度可根据需求调整参数

内容的提问来源于stack exchange，提问作者chris g