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

lcl: add TSplitter.OnCanOffset event (issue #0016629)

Browse Source 
git-svn-id: trunk@30165 -
This commit is contained in:
paul 2011-04-04 05:34:32 +00:00
parent 969d46d571
commit f42a381547
2 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/extctrls.pp
View File

@ -498,6 +498,8 @@ type
rsUpdate // draw nothing, update splitter position during moving
);
TCanOffsetEvent = procedure(Sender: TObject; var NewOffset: Integer;
var Accept: Boolean) of object;
TCanResizeEvent = procedure(Sender: TObject; var NewSize: Integer;
var Accept: Boolean) of object;
{ TCustomSplitter is a control to interactively resize another control.
@ -515,6 +517,7 @@ type
FBeveled: boolean;
FMinSize: integer;
FMouseInControl: Boolean;
FOnCanOffset: TCanOffsetEvent;
FOnCanResize: TCanResizeEvent;
FOnMoved: TNotifyEvent;
FResizeAnchor: TAnchorKind;
@ -529,7 +532,9 @@ type
protected
class procedure WSRegisterClass; override;
procedure CheckAlignment;
function CheckNewSize(var NewSize: integer): boolean; virtual;
function CheckNewSize(var NewSize: Integer): Boolean; virtual;
function CheckOffset(var NewOffset: Integer): Boolean; virtual;
function FindAlignControl: TControl;
function FindAlignOtherControl: TControl;
@ -560,6 +565,7 @@ type
property Beveled: boolean read FBeveled write SetBeveled default false;
property Cursor default crHSplit;
property MinSize: integer read FMinSize write SetMinSize default 30;
property OnCanOffset: TCanOffsetEvent read FOnCanOffset write FOnCanOffset;
property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
property ResizeAnchor: TAnchorKind read FResizeAnchor write SetResizeAnchor default akLeft;
@ -580,6 +586,7 @@ type
property Cursor;
property Height;
property MinSize;
property OnCanOffset;
property OnCanResize;
property OnChangeBounds;
property OnMoved;

44
lcl/include/customsplitter.inc
View File

@ -401,7 +401,7 @@ begin
NewSize := CalcNewSize(StartSize, EndSize, Offset);
// OnCanResize event
if CheckNewSize(NewSize) then
if CheckOffset(Offset) and CheckNewSize(NewSize) then
if not FSplitDragging or (ResizeStyle = rsUpdate) then
SetAlignControlSize(NewSize)
else
@ -463,25 +463,28 @@ begin
//DebugLn(['TCustomSplitter.MoveSplitter Offset=',Offset,' OffsetMaxLower=',OffsetMaxLower,' OffsetMaxUpper=',OffsetMaxUpper]);
// move splitter
if not FSplitDragging or (ResizeStyle = rsUpdate) then
if CheckOffset(Offset) then
begin
if ResizeAnchor in [akLeft, akRight] then
Left := Left + Offset
if not FSplitDragging or (ResizeStyle = rsUpdate) then
begin
if ResizeAnchor in [akLeft, akRight] then
Left := Left + Offset
else
Top := Top + Offset;
end
else
Top := Top + Offset;
end
else
begin
// get the splitter position
NewRect := BoundsRect;
NewRect.TopLeft := Parent.ClientToScreen(NewRect.TopLeft);
NewRect.BottomRight := Parent.ClientToScreen(NewRect.BottomRight);
begin
// get the splitter position
NewRect := BoundsRect;
NewRect.TopLeft := Parent.ClientToScreen(NewRect.TopLeft);
NewRect.BottomRight := Parent.ClientToScreen(NewRect.BottomRight);
if ResizeAnchor in [akLeft, akRight] then
OffsetRect(NewRect, Offset, 0)
else
OffsetRect(NewRect, 0, Offset);
SetRubberBandRect(FSplitterWindow, NewRect);
if ResizeAnchor in [akLeft, akRight] then
OffsetRect(NewRect, Offset, 0)
else
OffsetRect(NewRect, 0, Offset);
SetRubberBandRect(FSplitterWindow, NewRect);
end;
end;
end;
end;
@ -821,6 +824,13 @@ begin
OnCanResize(Self, NewSize, Result);
end;
function TCustomSplitter.CheckOffset(var NewOffset: Integer): Boolean;
begin
Result := True;
if Assigned(OnCanOffset) then
OnCanOffset(Self, NewOffset, Result);
end;
procedure TCustomSplitter.Paint;
procedure DrawThemedPattern(ARect: TRect);
const