to Jar:
鼠标单击先后依次触发的事件是:MouseDown -> Click -> MouseUp
将控件的DragMode设为dmAutomatic时,鼠标按下即进入拖放操作状态;DragMode设为dmManual时,需
要自己调用BeginDrag()函数才开始执行拖放操作。
如果你仔细地看过Delphi源码中BeginDrag()函数的实现部分的话,你就会发现Delphi中的可视化控
件(可视化控件:可以有焦点输入的控件)的鼠标拖放机制是模拟出来的,请看BeginDrag的源代码:
procedure TControl.BeginDrag(Immediate: Boolean
Threshold: Integer);
var
P: TPoint;
begin
if (Self is TCustomForm) and (FDragKind <> dkDock) then
raise EInvalidOperation.CreateRes(@SCannotDragForm);
CalcDockSizes;
if (DragControl = nil) or (DragControl = Pointer($FFFFFFFF)) then
begin
DragControl := nil;
if csLButtonDown in ControlState then
begin
GetCursorPos(P);
P := ScreenToClient(P);
Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)))
//this
//请看这里,上面这个函数强制将鼠标按键抬起来,这就是为什么鼠标拖放操作
//总是和鼠标单击、双击冲突的根本原因
//就是说一旦执行了BeginDrag这个函数,此时,虽然实际你的鼠标按键还是按下去的状态,
//但是系统已经认为鼠标按键抬起来了
end;
{ Use default value when Threshold < 0 }
if Threshold < 0 then
Threshold := Mouse.DragThreshold;
// prevent calling EndDrag within BeginDrag
if DragControl <> Pointer($FFFFFFFF) then
DragInitControl(Self, Immediate, Threshold);
end;
end;
所以,要想使鼠标单击,双击,拖放都并存的话,就不能用系统提供的拖放机制,而只能模拟一个拖
放操作!
zxb200的方法虽然可以实现控件在运行期的拖动,但对于你这个题目来说有两个缺点:
(1) releasecapture这个函数和我上面说的//this处作用一样,所以他的这种方法使得鼠标点击功能
全部丧失。
(2) 这个方法只对可视化控件起作用,难怪他非要把Image图片放到Panel上
所以,zxb200提供的方法不行。
另外,定时器最好不要多用,因为它最大的缺点就是对于代码量大的时候,以及速度不一样的机器上
效果也会不一样。
我的方法:
原理:事先装好鼠标钩子,再设一个全局变量,当鼠标在图片上单击触发了MouseDown时,设为true,
在鼠标钩子检测鼠标移动的代码中判断这个变量,若为true,进行拖动操作,当鼠标的MouseUp
和Click事件被触发时将这个变量设为false,这样就什么都不耽误了,如果想逼真一点,可以
在拖动时改变鼠标的形状,我做的想ACDSEE一样,是一只握紧的小手将图象拖来拖去。
代码:
鼠标钩子的DLL代码:
---------------------------------------------------------------------------------------
library HookDLL;
uses WinTypes, WinProcs, Messages;
{ Global variables }
{$IFDEF WIN32}
{ For a system-wide hook, global variables must be Memory Mapped to be
accessible by all processes because the data segment of 32-bit DLL is private
to each process using it. }
type
PSharedData = ^TSharedData;
TSharedData = record
{ In this record, mirror the global variables of the 16-bit version }
HookCount: integer;
HookHandle: HHook;
MonitorWnd: HWND;
WM_MONITORMOUSEMOVE: UINT;
end;
var
{ global data for the DLL for a single process }
hMapObject: THandle;
SharedData: PSharedData;
{$ELSE}
{ 16 bit Windows }
type
UINT = Longint;
var
HookCount: integer;
HookHandle: HHook;
MonitorWnd: HWND;
WM_MONITORMOUSEMOVE: UINT;
{$ENDIF}
const
MESSAGE_MONITOR_MOUSE_MOVE = 'DFSHookDLLMonitorMouseMoveMessage';
function GetMonitorMouseMoveMsg: UINT
export;
begin
{$IFDEF WIN32}
if SharedData = NIL then
Result := 0
else
Result := SharedData^.WM_MONITORMOUSEMOVE;
{$ELSE}
Result := WM_MONITORMOUSEMOVE;
{$ENDIF}
end;
{ This is where you do your special processing. }
{$IFDEF WIN32}
function MouseHookCallBack(Code: integer
Msg: WPARAM
MouseHook: LPARAM): LRESULT
stdcall;
{$ELSE}
function MouseHookCallBack(Code: integer
Msg: word
MouseHook: longint): longint
export;
{$ENDIF}
var
{$IFDEF WIN32}
HookHandle: HHOOK;
MonitorWnd: HWND;
WM_MONITORMOUSEMOVE: UINT;
{$ENDIF}
MouseHookStruct: PMouseHookStruct absolute MouseHook;
begin
{$IFDEF WIN32}
{ Access the shared data. Do check if SharedData is assigned, because under
some circumstances the hook filter can be called after all processes have
detached }
if SharedData <> NIL then
begin
MonitorWnd := SharedData^.MonitorWnd;
HookHandle := SharedData^.HookHandle;
WM_MONITORMOUSEMOVE := SharedData^.WM_MONITORMOUSEMOVE;
end
else
begin
WM_MONITORMOUSEMOVE := 0;
MonitorWnd := 0;
HookHandle := 0
{ It seems that this handle is not used in the CallNextHookEx
function anyway. Several sources on the microsoft web site
indicate this. }
end;
{$ENDIF}
{ If the value of Code is less than 0, we are not allowed to do anything }
{ except pass it on to the next hook procedure immediately. }
if (Code >= 0) and (MonitorWnd <> 0) then
begin
{ This example sends the coordinates of all mouse move messages to the
monitoring app (the one that installed the hook). }
if (Msg = WM_MOUSEMOVE) and (MouseHookStruct <> NIL) then
PostMessage(MonitorWnd, WM_MONITORMOUSEMOVE, MouseHookStruct^.pt.x,
MouseHookStruct^.pt.y);
{ You could do any number of things here based on the different mouse
messages...
case Msg of:
WM_LBUTTONDOWN:
begin
end;
WM_LBUTTONUP:
begin
end;
WM_LBUTTONDBLCLK:
begin
end;
WM_RBUTTONDOWN:
begin
end;
WM_RBUTTONUP:
begin
end;
WM_RBUTTONDBLCLK:
begin
end;
WM_MBUTTONDOWN:
begin
end;
WM_MBUTTONUP:
begin
end;
WM_MBUTTONDBLCLK:
begin
end;
WM_MOUSEMOVE:
begin
end;
end;}
{ If you handled the situation, and don't want Windows to process the }
{ message, do *NOT* execute the next line. Be very sure this is what }
{ want, though. If you don't pass on stuff like WM_MOUSEMOVE, you }
{ will NOT like the results you get. }
Result := CallNextHookEx(HookHandle, Code, Msg, MouseHook);
end
else
Result := CallNextHookEx(HookHandle, Code, Msg, MouseHook);
end;
{ Call InstallHook to set the hook. }
function InstallHook(SystemHook: boolean
TaskHandle: THandle;
AMonitorWnd: HWND) : boolean
export;
{ This is really silly, but that's the way it goes. The only way to get the }
{ module handle, *not* instance, is from the filename. The Microsoft example }
{ just hard-codes the DLL filename. I think this is a little bit better. }
function GetModuleHandleFromInstance: THandle;
var
s: array[0..512] of char;
begin
{ Find the DLL filename from the instance value. }
GetModuleFileName(hInstance, s, sizeof(s)-1);
{ Find the handle from the filename. }
Result := GetModuleHandle(s);
end;
begin
{ Technically, this procedure could do nothing but call SetWindowsHookEx(), }
{ but it is probably better to be sure about things, and not set the hook }
{ more than once. You definitely don't want your callback being called more }
{ than once per message, do you? }
{$IFDEF WIN32}
Result := FALSE;
if SharedData = NIL then
exit
else
with SharedData^ do
begin
{$ENDIF}
Result := TRUE;
if HookCount = 0 then
begin
MonitorWnd := AMonitorWnd;
if SystemHook then
HookHandle := SetWindowsHookEx(WH_MOUSE, MouseHookCallBack, HInstance, 0)
else
{ See the Microsoft KnowledgeBase, PSS ID Number: Q92659, for a
discussion of the Windows bug that requires GetModuleHandle() to be
used. }
HookHandle := SetWindowsHookEx(WH_MOUSE, MouseHookCallBack,
GetModuleHandleFromInstance, TaskHandle);
if HookHandle <> 0 then
inc(HookCount)
else
Result := FALSE;
end
else
inc(HookCount);
{$IFDEF WIN32}
end;
{$ENDIF}
end;
{ Call RemoveHook to remove the system hook. }
function RemoveHook: boolean
export;
begin
{ See if our reference count is down to 0, and if so then unhook. }
Result := FALSE;
{$IFDEF WIN32}
if SharedData = NIL then
exit
else
with SharedData^ do
begin
{$ENDIF}
if HookCount < 1 then exit;
Result := TRUE;
dec(HookCount);
if HookCount = 0 then
Result := UnhookWindowsHookEx(HookHandle);
{$IFDEF WIN32}
end;
{$ENDIF}
end;
{ Have we hooked into the system? }
function IsHookSet: boolean
export;
begin
{$IFDEF WIN32}
if SharedData = NIL then
Result := FALSE
else
with SharedData^ do
{$ENDIF}
Result := (HookCount > 0) and (HookHandle <> 0);
end;
{$IFDEF WIN32}
{ Shared data management }
procedure AllocSharedData;
var
Init: boolean;
begin
if hMapObject = 0 then
begin
// Create a named file mapping object.
hMapObject := CreateFileMapping(
THandle($FFFFFFFF), // use paging file
NIL, // no security attributes
PAGE_READWRITE, // read/write access
0, // size: high 32-bits
SizeOf(TSharedData), // size: low 32-bits
'DFSHookDLLSharedDataBlock')
// name of map object, THIS MUST BE UNIQUE!
// The first process to attach initializes memory.
Init := GetLastError <> ERROR_ALREADY_EXISTS;
if hMapObject = 0 then exit;
// Get a pointer to the file-mapped shared memory.
SharedData := MapViewOfFile(
hMapObject, // object to map view of
FILE_MAP_WRITE, // read/write access
0, // high offset: map from
0, // low offset: beginning
0)
// default: map entire file
if SharedData = NIL then exit;
// Initialize memory if this is the first process.
if Init then
FillChar(SharedData^, SizeOf(TSharedData), 0);
SharedData^.WM_MONITORMOUSEMOVE := RegisterWindowMessage(
MESSAGE_MONITOR_MOUSE_MOVE);
end;
end;
procedure FreeSharedData;
begin
if hMapObject <> 0 then
try
try
UnMapViewOfFile(SharedData);
CloseHandle(hMapObject);
except
end;
finally
SharedData := NIL;
hMapObject := 0;
end;
end;
procedure EntryPointProc(Reason: Integer);
begin
case Reason of
DLL_PROCESS_DETACH: FreeSharedData;
DLL_PROCESS_ATTACH: AllocSharedData;
DLL_THREAD_ATTACH: {}
DLL_THREAD_DETACH: {}
end;
end;
{$ENDIF}
exports
GetMonitorMouseMoveMsg,
InstallHook,
RemoveHook,
IsHookSet,
MouseHookCallBack;
{ Initialize DLL data. }
begin
{$IFDEF WIN32}
SharedData := NIL;
hMapObject := 0;
DllProc := @EntryPointProc;
EntryPointProc(DLL_PROCESS_ATTACH)
// Must call manually in the Delphi world
{$ELSE}
HookCount := 0;
HookHandle := 0;
WM_MONITORMOUSEMOVE := RegisterWindowMessage(MESSAGE_MONITOR_MOUSE_MOVE);
{$ENDIF}
end.
--------------------------------------------------------------------------------
引用代码:
--------------------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image1MouseUp(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
procedure Image1Click(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
procedure WndProc(var Message: TMessage)
override;
procedure UpdateMousePosInfo(X, Y: integer);
end;
var
Form1: TForm1;
ImageX : Integer
//图片的Left和Top距离鼠标按下点的长度
ImageY : Integer;
bIsDrag : boolean
//为true,表示允许拖动
implementation
uses Hookunit;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
bIsDrag := false
//初始状态为不可拖动
InstallTaskHook(Handle)
//安装鼠标钩子
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RemoveHook
//卸载钩子
end;
procedure TForm1.WndProc(var Message: TMessage);
begin
if Message.Msg = GetMonitorMouseMoveMsg then
UpdateMousePosInfo(Message.WParam, Message.LParam)
else
inherited WndProc(Message);
end;
procedure TForm1.UpdateMousePosInfo(X, Y: integer);
var
Temp : TPoint;
begin
if bIsDrag then //拖动图片
begin
Temp := ScreenToClient(Point(X,Y));
Image1.Left := Temp.x - ImageX;
Image1.Top := Temp.y - ImageY;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
bIsDrag := false;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
bIsDrag := false;
Caption := 'Click';
end;
procedure TForm1.Image1DblClick(Sender: TObject);
begin
bIsDrag := false;
Caption := 'DoubleClick';
end;
procedure TForm1.Image1MouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
ImageX := X;
ImageY := Y;
bIsDrag := true;
end;
end.
--------------------------------------------------------------------------------