paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 21:38:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: move TWSControl.DragStart to TWSCustomListBox.DragStart because of limitation of TWS classes

Browse Source 
git-svn-id: trunk@42631 -
This commit is contained in:
paul 2013-09-06 07:29:10 +00:00
parent 9d8486877a
commit 2b9bef5afa
8 changed files with 26 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -1295,6 +1295,7 @@ type
function GetDragImages: TDragImageList; virtual;
function GetFloating: Boolean; virtual;
function GetFloatingDockSiteClass: TWinControlClass; virtual;
procedure BeforeDragStart; virtual;
procedure BeginAutoDrag; virtual;
procedure DoFloatMsg(ADockSource: TDragDockObject);virtual;//CM_FLOAT
procedure DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); virtual;

4
lcl/include/control.inc
View File

@ -869,6 +869,10 @@ begin
Result := FFloatingDockSiteClass;
end;
procedure TControl.BeforeDragStart;
begin
end;
{------------------------------------------------------------------------------
function TControl.GetLRDockWidth: Integer;
------------------------------------------------------------------------------}

10
lcl/include/customlistbox.inc
View File

@ -34,6 +34,12 @@ begin
end;
end;
procedure TCustomListBox.BeforeDragStart;
begin
if HandleAllocated then
TWSCustomListBoxClass(WidgetSetClass).DragStart(Self);
end;
procedure TCustomListBox.BeginAutoDrag;
begin
BeginDrag(False);
@ -348,7 +354,7 @@ end;
{------------------------------------------------------------------------------}
{ procedure TCustomListBox.SetMultiSelect }
{------------------------------------------------------------------------------}
procedure TCustomListBox.SetMultiSelect(Val: Boolean);
procedure TCustomListBox.SetMultiSelect(Val: boolean);
begin
if Val <> FMultiSelect then
begin
@ -360,7 +366,7 @@ end;
{------------------------------------------------------------------------------}
{ procedure TCustomListBox.SetSelected }
{------------------------------------------------------------------------------}
procedure TCustomListBox.SetSelected(Index: Integer; Val: Boolean);
procedure TCustomListBox.SetSelected(Index: integer; Val: boolean);
begin
CheckIndex(Index);

3
lcl/include/dragmanager.inc
View File

@ -642,7 +642,6 @@ end;
procedure TDragManagerDefault.DragStart(AControl: TControl; AImmediate: Boolean; AThreshold: Integer);
//Start a drag operation
begin
//debugln(['TDragManagerDefault.DragStart ',DbgSName(AControl)]);
if FPerformer = nil then
begin
if AThreshold >= 0 then
@ -652,7 +651,7 @@ begin
FWaitForTreshold := not AImmediate;
GetCursorPos(FStartPosition);
TWSControlClass(AControl.WidgetSetClass).DragStart(AControl, AImmediate);
AControl.BeforeDragStart;
case AControl.DragKind of
dkDrag: FPerformer := TDragPerformer.Create(Self, AControl);

11
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -114,8 +114,7 @@ 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 procedure DragStart(const ACustomListBox: TCustomListBox); override;
class function GetIndexAtXY(const ACustomListBox: TCustomListBox; X, Y: integer): integer; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
@ -638,17 +637,17 @@ begin
Result := Params.Window;
end;
class procedure TWin32WSCustomListBox.DragStart(const AControl: TControl; const Immediate: Boolean);
class procedure TWin32WSCustomListBox.DragStart(const ACustomListBox: TCustomListBox);
var
P: TPoint;
begin
if csLButtonDown in AControl.ControlState then
if csLButtonDown in ACustomListBox.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));
P := ACustomListBox.ScreenToClient(P);
CallDefaultWindowProc(ACustomListBox.Handle, WM_LBUTTONUP, 0, MAKELPARAM(P.X, P.Y));
end;
end;

1
lcl/stdctrls.pp
View File

@ -515,6 +515,7 @@ type
class procedure WSRegisterClass; override;
procedure AssignItemDataToCache(const AIndex: Integer; const AData: Pointer); virtual; // called to store item data while the handle isn't created
procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); virtual; // called to restore the itemdata after a handle is created
procedure BeforeDragStart; override;
procedure BeginAutoDrag; override;
function CalculateStandardItemHeight: Integer;
procedure CreateParams(var Params: TCreateParams); override;

5
lcl/widgetset/wscontrols.pp
View File

@ -84,7 +84,6 @@ 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;
@ -230,10 +229,6 @@ begin
end;
class procedure TWSControl.DragStart(const AControl: TControl; const Immediate: Boolean);
begin
end;
{ TWSWinControl }
class procedure TWSWinControl.AdaptBounds(const AWinControl: TWinControl;

6
lcl/widgetset/wsstdctrls.pp
View File

@ -105,6 +105,8 @@ type
TWSCustomListBox = class(TWSWinControl)
published
class procedure DragStart(const ACustomListBox: TCustomListBox); virtual;
class function GetIndexAtXY(const ACustomListBox: TCustomListBox; X, Y: integer): integer; virtual;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; virtual;
class function GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): boolean; virtual;
@ -282,6 +284,10 @@ end;
{ TWSCustomListBox }
class procedure TWSCustomListBox.DragStart(const ACustomListBox: TCustomListBox);
begin
end;
class function TWSCustomListBox.GetIndexAtXY(
const ACustomListBox: TCustomListBox; X, Y: integer): integer;
begin