Question

我有一个没有边框的自定义表单（自定义形状和透明度）（BorderStyle: bsNone）。它有一个背景图像，一个普通的TImage组件。它希望表单可以从TImage中拖拽。那可能吗？我正在使用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;

拖动TImage将导致拖动表单。

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;

Delphi：使窗口可以从组件中拖动

2 个答案: