使窗口从组件中可拖动

Question

我有一个自定义表单(自定义形状和透明度)，没有边框(BorderStyle: bsNone)。它有一个背景图像，一个普通的图像组件。它希望表单可以从图像中拖拽。这可能吗?我使用Lazarus 1.2.6 (FPC版本)。: 2.6.4)。

这是我的自定义表单在空桌面上的样子:Image.

Answer 1

这是一个跨平台的解决方案:

type
TForm1 = class(TForm)
    Image1: TImage; 
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
var PX, PY: Integer; 
    MouseIsDown: Boolean;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    MouseIsDown := True;
    PX := X;
    PY := Y;
  end;
end; 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if MouseIsDown then begin
    SetBounds(Form1.Left + (X - PX), Form1.Top + (Y - PY), Form1.Width, Form1.Height);
  end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MouseIsDown:=False;
end; 

拖动图片会导致窗体被拖动

Answer 2

假设您正在使用windows，这是您所要求的一般方法:

  uses
    Windows;
  type
    TForm1 = class(TForm)
    private
      procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  end; 
  procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
  begin
    Msg.Result := HTCAPTION
  end;