Решение, которое я сделал, - это сквозная обработка. Я создал поток, который будет проверять состояние клавиши 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;
Перетаскивание не такое плавное, но теперь пользователь может перетаскивать содержимое дерева без использования горизонтальной и вертикальной полос прокрутки.