lcl: fix ListBox onChange call on win32 (mantis #0020324)

- notify TWS class about drag start
  - set csLButtonDown before BeginAutoDrag (there is no dependency in LCL for csLButtonDown in BeginAutoDrag so I see no reason to postpone it)
win32:
  - send TWM_LButtonUp to windows for ListBox if drag operation is started by mouse down

git-svn-id: trunk@42627 -
This commit is contained in:
paul 2013-09-06 04:58:06 +00:00
parent 0032f227a7
commit 2743011353
4 changed files with 41 additions and 18 deletions

View File

@ -2059,24 +2059,21 @@ begin
LM_LBUTTONDOWN,
LM_LBUTTONDBLCLK:
begin
if FDragMode = dmAutomatic
then begin
BeginAutoDrag;
{ The VCL holds up the mouse down for dmAutomatic
and sends it, when it decides, if it is a drag operation or
not.
This decision requires full control of focus and mouse, which
do not all LCL interfaces provide. Therefore the mouse down event
is sent immediately.
Include(FControlState, csLButtonDown);
{ The VCL holds up the mouse down for dmAutomatic
and sends it, when it decides, if it is a drag operation or
not.
This decision requires full control of focus and mouse, which
do not all LCL interfaces provide. Therefore the mouse down event
is sent immediately.
Further Note:
Under winapi a LM_LBUTTONDOWN ends the drag immediate.
For example: If we exit here, then mouse down on TTreeView does
not work any longer under gtk.
}
// VCL: exit;
end;
Include(FControlState,csLButtonDown);
Further Note:
Under winapi a LM_LBUTTONDOWN ends the drag immediate.
For example: If we exit here, then mouse down on TTreeView does
not work any longer under gtk.
}
if FDragMode = dmAutomatic then
BeginAutoDrag;
end;
LM_LBUTTONUP:

View File

@ -652,6 +652,8 @@ begin
FWaitForTreshold := not AImmediate;
GetCursorPos(FStartPosition);
TWSControlClass(AControl.WidgetSetClass).DragStart(AControl, AImmediate);
case AControl.DragKind of
dkDrag: FPerformer := TDragPerformer.Create(Self, AControl);
dkDock: FPerformer := TDockPerformer.Create(Self, AControl);

View File

@ -114,6 +114,9 @@ type
var Left, Top, Width, Height: integer; var SuppressMove: boolean); override;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure DragStart(const AControl: TControl;
const Immediate: Boolean); override;
class function GetIndexAtXY(const ACustomListBox: TCustomListBox; X, Y: integer): integer; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
class function GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): boolean; override;
@ -635,6 +638,20 @@ begin
Result := Params.Window;
end;
class procedure TWin32WSCustomListBox.DragStart(const AControl: TControl; const Immediate: Boolean);
var
P: TPoint;
begin
if csLButtonDown in AControl.ControlState then
begin
// if drag is called by mouse down then we need to complete it with mouse up
// since in other case we will not get the change event called
GetCursorPos(P);
P := AControl.ScreenToClient(P);
CallDefaultWindowProc(TWinControl(AControl).Handle, WM_LBUTTONUP, 0, MAKELPARAM(P.X, P.Y));
end;
end;
class function TWin32WSCustomListBox.GetIndexAtXY(
const ACustomListBox: TCustomListBox; X, Y: integer): integer;
begin
@ -655,7 +672,9 @@ begin
Result := SendMessage(ACustomListBox.Handle, LB_GETCURSEL, 0, 0);
end;
class function TWin32WSCustomListBox.GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): Boolean;
class function TWin32WSCustomListBox.GetItemRect(
const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect
): boolean;
var
Handle: HWND;
begin

View File

@ -84,6 +84,7 @@ type
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; virtual;
class procedure ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); virtual;
class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual;
class procedure DragStart(const AControl: TControl; const Immediate: Boolean); virtual;
end;
TWSControlClass = class of TWSControl;
@ -229,6 +230,10 @@ begin
end;
class procedure TWSControl.DragStart(const AControl: TControl; const Immediate: Boolean);
begin
end;
{ TWSWinControl }
class procedure TWSWinControl.AdaptBounds(const AWinControl: TWinControl;