通过鼠标拖动滚动

时间:2020-06-17 14:54:28

标签: delphi-xe

由于某些原因,用户在TTreeView中使用垂直和水平滚动条时遇到问题。他们想通过拖动来滚动(在触摸屏上模拟手指)。我不确定从哪里开始。

我知道如何在TTreeView中实现拖放,也知道如何在按下键时模拟滚动。

编辑

我有一个ttreeview有200行,垂直和水平条都是可见的。我想在单击树视图内的空白并将其向上拖动以查看其应自动滚动的其他行时实现。

我不确定从哪里开始编码。可悲的是,TTreeView.OnStartDrag仅在您选择一个节点并将其拖动时才会触发。我尝试检查OnMouseMove,但 Mouse.IsDragging 始终为false。

1 个答案:

答案 0 :(得分:0)

我提出的解决方案是通过线程。我创建了一个线程,每50毫秒检查一次VK_LBUTTON键状态和鼠标位置。这是线程:

TDragThread = class(TThread)
  private
    fLogMessage : string;
    fX,
    fY : Integer;

    procedure DoWork;
    procedure LogMessage;
    procedure DoScroll;

  protected
    procedure Execute; override;

  public
    IsDragging : Boolean;
    constructor Create; reintroduce;
  end;

{ TDragThread }

constructor TDragThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  IsDragging := False;
end;

procedure TDragThread.DoScroll;
var
  i : Integer;
begin

  // horizontal scroll
  if fX > 0 then
  begin
    SendMessage(Form1.tv1.Handle, WM_HSCROLL, SB_LINELEFT, 0);
  end
  else if fX < 0 then
  begin
    SendMessage(Form1.tv1.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
  end;

  // vertical
  if fY > 0 then
  begin
    SendMessage(Form1.tv1.Handle, WM_VSCROLL, SB_LINEUP, 0);
  end
  else if fY < 0 then
  begin
    SendMessage(Form1.tv1.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
  end;
end;

procedure TDragThread.DoWork;
var
  nTemp : SmallInt;
  point : TPoint;
  oldPoint : TPoint;
  downCount : Integer;
begin
  downCount := 0;
  while not Terminated do
  begin

    if IsDragging then
    begin

      nTemp := GetKeyState(VK_LBUTTON);
      point := Mouse.CursorPos;
      if nTemp < 0 then
      begin
        downCount := downCount + 1;
        fLogMessage := 'MOUSE DOWN- X:' + IntToStr(point.X) + ' Y:' + IntToStr(point.Y);
        Synchronize(LogMessage);

        if downCount > 1 then
        begin
          fX := (point.X - oldPoint.X) div 20;
          fY := (point.Y - oldPoint.Y) div 10;

          if (fX <> 0) or (fY <> 0) then
          begin
            Synchronize(DoScroll);
          end;

          fLogMessage := 'fX:' + IntToStr(fX) + ' fY:' + IntToStr(fY);
          Synchronize(LogMessage);
        end;
        oldPoint := point;

      end
      else
      begin
        if downCount > 2 then
        begin
          fLogMessage := 'DO SCROLL';
          Synchronize(LogMessage);
        end;

        fLogMessage := 'MOUSE UP';
        Synchronize(LogMessage);
        downCount := 0;
        IsDragging := False;
      end;
    end;

    Sleep(50);
  end;
end;

procedure TDragThread.Execute;
begin
  inherited;
  CoInitialize(nil);
  try

    DoWork;

  finally
    CoUninitialize;
  end;

end;

procedure TDragThread.LogMessage;
begin
  Form1.mmo1.Lines.Add(fLogMessage);
end;

创建表单时,线程实例将启动:

procedure TForm1.FormCreate(Sender: TObject);
begin    
  fDragThread := TDragThread.Create;
  fDragThread.Start;
end;

然后,当在TTreeView中检测到鼠标按下时,需要将公共变量IsDragging设置为true:

procedure TForm1.tv1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if fDragThread = nil then
  begin
    Exit;
  end;

  fDragThread.IsDragging := True;
end;

拖动体验并不那么顺畅,但是现在用户可以在不使用水平和垂直滚动条的情况下拖动树内容。