本来想用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.