由于某些原因,用户在TTreeView中使用垂直和水平滚动条时遇到问题。他们想通过拖动来滚动(在触摸屏上模拟手指)。我不确定从哪里开始。
我知道如何在TTreeView中实现拖放,也知道如何在按下键时模拟滚动。
编辑
我有一个ttreeview有200行,垂直和水平条都是可见的。我想在单击树视图内的空白并将其向上拖动以查看其应自动滚动的其他行时实现。
我不确定从哪里开始编码。可悲的是,TTreeView.OnStartDrag仅在您选择一个节点并将其拖动时才会触发。我尝试检查OnMouseMove,但 Mouse.IsDragging 始终为false。
答案 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;
拖动体验并不那么顺畅,但是现在用户可以在不使用水平和垂直滚动条的情况下拖动树内容。