将鼠标光标捕捉到Delphi自定义控件中的一行

Jer*_*dge 0 delphi mouse drawing custom-controls mouse-cursor

我想知道如何实现水平(或垂直)捕捉鼠标光标到一条线.例如,在Facebook时间轴功能上,当您将鼠标悬停在中心线上时,它会将光标捕捉到中心.将鼠标靠近该线也会使其卡住.

我想将它包装在一个自定义控件中,而不是表单的控件.将有一条垂直或水平线,当它到达任何地方时它必须将鼠标光标捕捉到它.我将添加返回被点击的行的位置的事件.此控件还将具有与此行平行的垂直或水平滚动条,并且两个滚动条将永远不会同时显示.无论是垂直还是水平显示此行,都有一个主属性.

鼠标实际上不应该移动位置,但只是光标的显示应该以某种方式调整以在该行的中心显示它,而实际的X(或Y)位置永远不会改变.我不想移动光标,我想将光标显示在该行的中心,如果它到达任何地方.当光标处于此捕捉位置时,它将显示另一个自定义光标而不是标准(或默认)箭头.

我需要知道的是如何在这个控件中处理鼠标指针进入该行附近的事件,并将光标的显示调整到该行的中心.

Ian*_*oyd 5

捕捉需要你捕捉一些东西.

  • 在AutoCAD中,"光标"实际上是与"光标"相交的水平和垂直线
  • Photoshop使用Windows鼠标,但将效果与指南相对应
  • Facebook 在时间线上点了一个+标志点

您需要跟踪鼠标的位置(即OnMouseMove),如果光标"足够接近",您可以决定做什么.

这是一个小样本程序,我有一条假想的垂直线,从左边150px.如果我足够接近那条线,会出现一个小小的Facebook +:

在此输入图像描述

const
    centerLine = 150; //"line" is at 150px from the left
    tolerance = 15; //15px on either size is about good.

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
    if IsMouseNearLine(x, y) then
    begin
        //We're on the centerline-ish. React by...
        //...changing the cursor to a <->
        Self.Cursor := crSizeWE;

        //and maybe let's put a "+" there, like Facebook
        if (FPlusLabel = nil) then
        begin
            FPlusLabel := TLabel.Create(Self);
            FPlusLabel.Parent := Self;
            FPlusLabel.Caption := '+';
            FPlusLabel.Alignment := taCenter;
            FPlusLabel.Font.Color := $00996600; //Windows UX "Main Instruction" color
            FPlusLabel.Font.Style := FPlusLabel.Font.Style + [fsBold];
        end;

        FPlusLabel.Left := centerLine-(FPlusLabel.Width div 2);
        FPlusLabel.Top := Y-(FPlusLabel.Height div 2);
        FPlusLabel.Visible := True;
    end
    else
    begin
        Self.Cursor := crDefault;
        if Assigned(FPlusLabel) then
            FPlusLabel.Visible := False;
    end;
end;

function TForm1.IsMouseNearLine(X, Y: Integer): Boolean;
begin
    if (x >= (centerLine-tolerance)) and (x <= (centerLine+tolerance)) then
    begin
        //we're close-ish to the line
        Result := true;
    end
    else
        Result := False;
end;
Run Code Online (Sandbox Code Playgroud)

当你有其他控件时,事情开始变得毛茸茸,每个控件都需要与MouseMove消息一起播放.但如果你将它们全部转发给一个处理程序,那也不算糟糕; 在执行之前执行客户端到屏幕到formClient.

注意:任何代码都将发布到公共域中.无需归属.