mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 07:59:44 +02:00
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:
parent
0032f227a7
commit
2743011353
@ -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:
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user