Delphi 拖动控件过程中显示Hint

在这里插入图片描述
本来想用Drag来写,没有写成功。还望大神能指点

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls, Vcl.ExtCtrls, unit2, scGPControls, scControls;

type
  TForm1 = class(TForm)
    scPanel1: TscPanel;
    scGPLabel1: TscGPLabel;
    procedure FormCreate(Sender: TObject);
    procedure scGPLabel1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure scGPLabel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure scGPLabel1MouseDown(Sender: TObject; Button:
      TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FMyPosPoint: TPoint;
  public
    { Public declarations }
    procedure MyShowHint(var HintStr: string; var CanShow: Boolean;
      var HintInfo: THintInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  Application.OnShowHint := MyShowHint;
  Application.HintPause := 0; //立即显示
  Application.HintHidePause := -1; //if not leave then 显示100秒
  Screen.HintFont.Color := clred;
  Screen.HintFont.Size := 9;
end;

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean;
  var HintInfo: THintInfo);
begin
  if screen.Cursor = crDrag then
    Dec(HintInfo.HintPos.y, HintInfo.HintControl.Height + 34)
  else
    Dec(HintInfo.HintPos.y, HintInfo.HintControl.Height + 27);
end;

procedure TForm1.scGPLabel1MouseDown(Sender: TObject; Button:
  TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FMyPosPoint.X := X;
    FMyPosPoint.Y := Y;
  end;
end;

procedure TForm1.scGPLabel1MouseMove(Sender: TObject; Shift:
  TShiftState; X, Y: Integer);

  procedure DoMove(Sender: TObject; const x, y: integer);
  var
    nLeft, nTop, nHeight, nRow, nCol: Integer;
    vControl, vControlParent: TControl;
    sndLastControl: TControl;
  begin
    vControl := Sender as TControl;
    nTop := vControl.top;
    nLeft := vControl.left;
    nHeight := vControl.Height;
    vControlParent := vControl.Parent;  //Panel
  //控制左极限 控制上极限
    nRow := 1;
    nCol := 1;
    if nTop - 22 >= 1 then
      nRow := (nTop - 22) div 20 + 1;
    if nLeft - 40 >= 1 then
      nCol := (nLeft - 40) div 6 + 1;

    if nTop <= 22 then
      nTop := 22;
    if nLeft <= 40 then
      nLeft := 40;

  //检查下移开始
    if y >= (nHeight + 3) then    //下移
    begin
      nTop := vControl.top + nHeight + 4;
    end;
   //检查下移结束
   //上移
    if y <= -3 then
    begin
      if nTop > 22 then
      begin
        nTop := vControl.top - nHeight - 4;
      end;

    end;
   //检查上移结束
   //左右移动开始
    if x + 3 < FMyPosPoint.X then   //表示左移
    begin
      if nLeft <> 40 then
        nLeft := nLeft - 3;
    end;
    if x - 3 > FMyPosPoint.x then   //表示右移
    begin
      nLeft := nLeft + 3;
    end;
  //左右移动结束
   //检查完毕,修改相应的属性
    if vControl.Top <> nTop then
      vControl.Top := nTop;
    if vControl.Left <> nLeft then
      vControl.Left := nLeft;
    vControl.Hint := format('行:%d 列:%d', [nRow, nCol]);
  end;

var
  APoint: TPoint;
begin
  APoint.X := mouse.CursorPos.X - X;
  APoint.Y := mouse.CursorPos.y - Y;
  if Shift = [ssLeft] then
  begin
    DoMove(Sender, X, Y);
    screen.Cursor := crDrag;
  end;
  Application.ActivateHint(APoint);
end;

procedure TForm1.scGPLabel1MouseUp(Sender: TObject; Button:
  TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  screen.Cursor := crDefault;
end;

end.

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值