Прокрутка перетаскиванием мышью - PullRequest
Новая
       38

Прокрутка перетаскиванием мышью

0 голосов
/ 17 июня 2020

По какой-то причине у пользователя возникают проблемы с использованием вертикальной и горизонтальной полос прокрутки в TTreeView. Они хотят прокручивать перетаскиванием (имитируйте палец на сенсорном экране). Я не уверен, с чего начать.

Я знаю, как реализовать перетаскивание в TTreeView, а также знаю, как имитировать прокрутку при нажатии клавиши.

РЕДАКТИРОВАТЬ

У меня есть ttreeview, в котором 200 строк, видны вертикальные и горизонтальные полосы. Я хочу добиться этого, когда я нажимаю на пустое пространство внутри древовидной структуры и перетаскиваю его вверх, чтобы увидеть другие строки, которые должны автоматически прокручиваться.

Не знаю, с чего начать кодирование. К сожалению, TTreeView.OnStartDrag сработает, только если вы выбрали узел и перетащили его. Я пробовал проверить OnMouseMove, но Mouse.IsDragging всегда ложно.

1 Ответ

0 голосов
/ 19 июня 2020

Решение, которое я сделал, - это сквозная обработка. Я создал поток, который будет проверять состояние клавиши VK_LBUTTON и положение мыши каждые 50 миллисекунд. Вот поток: 

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;

Затем вам нужно установить для переменной publi c IsDragging значение true когда в TTreeView обнаруживается нажатие мыши: 

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

  fDragThread.IsDragging := True;
end;

Перетаскивание не такое плавное, но теперь пользователь может перетаскивать содержимое дерева без использования горизонтальной и вертикальной полос прокрутки.

...