Componentes.Terceros.DevExp.../internal/x.46/1/ExpressLayout Control 2/Sources/dxLayoutSelection.pas
2009-10-27 17:09:30 +00:00

904 lines
28 KiB
ObjectPascal

{********************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressLayoutControl common routines }
{ }
{ Copyright (c) 2001-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSLAYOUTCONTROL AND ALL }
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM }
{ ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{********************************************************************}
unit dxLayoutSelection;
{$I cxVer.inc}
interface
uses
Windows, Messages, Graphics, Classes, Controls, cxClasses, cxGraphics;
const
DXM_CHECKCHILDREN = WM_DX + 30;
type
TdxSelectionAction = (saAdded, saChanged, saExtracted);
{ IdxSelectionChanged }
IdxSelectionChanged = interface
['{ECB1A3AE-1C91-4E5F-8ADC-34120676B1CA}']
procedure SelectionChanged(ASelection: TList; AAction: TdxSelectionAction);
end;
{ IdxLayoutSelectableItem }
IdxLayoutSelectableItem = interface
['{2887168D-78EB-44A0-A440-E284B01BE407}']
function CanDelete: Boolean;
function IsChild(AOwner: TComponent): Boolean;
procedure SelectComponent(AShift: TShiftState = []);
procedure SelectParent;
procedure SelectionChanged;
function IsDragged: Boolean;
function IsVisible: Boolean;
end;
{ IdxLayoutDesignerHelper }
IdxLayoutDesignerHelper = interface
['{B364658F-B4CE-46C3-83D5-D537F34B9482}']
procedure AddSelectionChangedListener(AListener: TPersistent);
function IsActive: Boolean;
function CanDeleteComponent(AComponent: TComponent): Boolean;
procedure ClearSelection;
procedure DeleteSelection;
procedure GetSelection(AList: TList);
function IsComponentSelected(AComponent: TPersistent): Boolean;
procedure RemoveSelectionChangedListener(AListener: TPersistent);
procedure SelectComponent(AComponent: TPersistent; AShift: TShiftState = []);
procedure SetSelection(AList: TList);
function UniqueName(const BaseName: string): string;
end;
{ TdxLayoutRunTimeSelectionHelper }
TdxLayoutRunTimeSelectionHelper = class(TcxOwnedPersistent, IdxLayoutDesignerHelper)
private
FListeners: TList;
FRefCount: Integer;
FSelectionList: TcxComponentList;
function GetComponent: TComponent;
procedure SelectionListNotifyHandler(Sender: TObject; AComponent: TComponent; AAction: TListNotification);
procedure SelectionListChangedHandler(Sender: TObject; AComponent: TComponent; AAction: TcxComponentCollectionNotification);
protected
function GetComponentClass(AComponent: TComponent): TComponentClass;
procedure NotifyListeners(AList: TList; AAction: TdxSelectionAction);
procedure SelectionListNotify(AComponent: TComponent; AAction: TListNotification);
procedure DoDeleteComponents(AList: TcxComponentList); virtual;
//IUnknown
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
property Component: TComponent read GetComponent;
property Listeners: TList read FListeners;
public
constructor Create(AOwner: TPersistent); override;
destructor Destroy; override;
// IdxLayoutControlSelectionController
procedure AddSelectionChangedListener(AListener: TPersistent); virtual;
procedure RemoveSelectionChangedListener(AListener: TPersistent); virtual;
//IcxLayoutControlDesignerHelper
function IsActive: Boolean; virtual;
function CanDeleteComponent(AComponent: TComponent): Boolean; virtual;
procedure ClearSelection; virtual;
procedure DeleteSelection; virtual;
procedure GetSelection(AList: TList); virtual;
function IsComponentSelected(AComponent: TPersistent): Boolean; virtual;
procedure SelectComponent(AComponent: TPersistent; AShift: TShiftState = []); virtual;
procedure SetSelection(AList: TList); virtual;
function UniqueName(const BaseName: string): string; virtual;
end;
TdxLayoutRunTimeSelectionHelperClass = class of TdxLayoutRunTimeSelectionHelper;
{ TdxSelectionLayer }
TdxSelectionLayer = class(TCustomControl)
private
FSelectionImage: TcxAlphaBitmap;
FWindowCanvas: TcxCanvas;
FParentControl: TWinControl;
FOnHide: TNotifyEvent;
FOnShow: TNotifyEvent;
function GetWindowCanvas: TcxCanvas;
procedure SetParentControl(AValue: TWinControl);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure DoHide; virtual;
procedure DoShow; virtual;
procedure InternalPaint; virtual;
property WindowCanvas: TcxCanvas read GetWindowCanvas;
public
constructor Create(AParentControl: TWinControl; AParentWindow: HWND); reintroduce; virtual;
destructor Destroy; override;
procedure Paint; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure InvalidateRect(const R: TRect);
procedure MoveTo(const P: TPoint);
procedure Hide;
procedure Show;
property SelectionImage: TcxAlphaBitmap read FSelectionImage;
property ParentControl: TWinControl read FParentControl write SetParentControl;
property OnHide: TNotifyEvent read FOnHide write FOnHide;
property OnShow: TNotifyEvent read FOnShow write FOnShow;
end;
{ IdxCustomizeControlsHelper }
IdxCustomizeControlsHelper = interface
['{AD2130FB-EDA5-4034-A551-9C26A8DAAE41}']
function CanProcessChildren: Boolean;
end;
{ TdxControlsDesignSelectorHelper }
TdxControlsDesignSelectorHelperClass = class of TdxControlsDesignSelectorHelper;
TdxControlsDesignSelectorHelper = class(TComponent)
private
FControl: TControl;
FControlWnd: THandle;
FControlWndProcInstance: Pointer;
FDefaultControlWndProcInstance: Pointer;
FDefaultControlWndProc: TWndMethod;
FChildren: TcxComponentList;
FParent: TdxControlsDesignSelectorHelper;
FSelectorBounds: TRect;
function GetControlWnd: THandle;
function GetParentControl: TWinControl;
procedure SetSelectorBounds(const AValue: TRect);
protected
procedure CallDefaultWndProc(var Message: TMessage);
procedure ControlWndProc(var Message: TMessage);
function DoControlWndProc(var Message: TMessage): Boolean; virtual;
procedure CheckChildren; virtual;
function GetChildClass: TdxControlsDesignSelectorHelperClass; virtual;
procedure ParentCheckChildren; virtual;
procedure PrepareChild(AItem: TdxControlsDesignSelectorHelper); virtual;
function GetSelectorBoundsForChild(AChild: TdxControlsDesignSelectorHelper): TRect;
function ClientToScreen(const P: TPoint): TPoint;
function ScreenToClient(const P: TPoint): TPoint;
function IsActiveDesignSelector: Boolean; virtual;
function IsSelected: Boolean; virtual;
function IsValid: Boolean; virtual;
function IsWinControl: Boolean;
function ControlAsWinControl: TWinControl;
// Draw
function CanDrawDesignSelector: Boolean; virtual;
procedure DoDrawDesignSelector(DC: HDC); virtual;
procedure DrawDesignSelector(DC: HDC);
property Children: TcxComponentList read FChildren;
property ControlWnd: THandle read GetControlWnd;
property Parent: TdxControlsDesignSelectorHelper read FParent write FParent;
property ParentControl: TWinControl read GetParentControl;
public
constructor Create(AOwner: TComponent); override;
constructor CreateEx(AControlWnd: THandle); virtual;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property Control: TControl read FControl;
property SelectorBounds: TRect read FSelectorBounds write SetSelectorBounds;
end;
implementation
uses
SysUtils, Types, cxGeometry;
{ TdxLayoutControlRunTimeSelectionHelper }
constructor TdxLayoutRunTimeSelectionHelper.Create(AOwner: TPersistent);
begin
inherited;
FSelectionList := TcxComponentList.Create;
FListeners := TList.Create;
FSelectionList.OnNotify := SelectionListNotifyHandler;
FSelectionList.OnComponentListChanged := SelectionListChangedHandler;
end;
destructor TdxLayoutRunTimeSelectionHelper.Destroy;
begin
FreeAndNil(FSelectionList);
FreeAndNil(FListeners);
inherited;
end;
procedure TdxLayoutRunTimeSelectionHelper.AddSelectionChangedListener(AListener: TPersistent);
begin
if (AListener <> nil) and Supports(AListener, IdxSelectionChanged) and
(FListeners.IndexOf(AListener) < 0) then
FListeners.Add(AListener);
end;
procedure TdxLayoutRunTimeSelectionHelper.RemoveSelectionChangedListener(AListener: TPersistent);
begin
FListeners.Remove(AListener);
end;
function TdxLayoutRunTimeSelectionHelper.IsActive: Boolean;
begin
Result := True;
end;
function TdxLayoutRunTimeSelectionHelper.CanDeleteComponent(
AComponent: TComponent): Boolean;
var
ASelectableItem: IdxLayoutSelectableItem;
begin
Result := not (csDestroying in AComponent.ComponentState) and
Supports(AComponent, IdxLayoutSelectableItem, ASelectableItem) and
ASelectableItem.CanDelete;
end;
procedure TdxLayoutRunTimeSelectionHelper.ClearSelection;
begin
FSelectionList.Clear;
end;
procedure TdxLayoutRunTimeSelectionHelper.DeleteSelection;
procedure CheckDeleteItems(AList: TcxComponentList);
var
I: Integer;
AIntf: IdxLayoutSelectableItem;
begin
for I := AList.Count - 1 downto 0 do
if not Supports(AList[0], IdxLayoutSelectableItem, AIntf) or not AIntf.CanDelete then
AList.Extract(AList[I]);
end;
var
AList: TcxComponentList;
begin
AList := TcxComponentList.Create(True);
try
GetSelection(AList);
CheckDeleteItems(AList);
DoDeleteComponents(AList);
finally
AList.Free;
end;
end;
procedure TdxLayoutRunTimeSelectionHelper.GetSelection(AList: TList);
var
I: Integer;
begin
for I := 0 to FSelectionList.Count - 1 do
AList.Add(FSelectionList[I]);
end;
function TdxLayoutRunTimeSelectionHelper.IsComponentSelected(AComponent: TPersistent): Boolean;
begin
Result := FSelectionList.IndexOf(TComponent(AComponent)) <> -1;
end;
procedure TdxLayoutRunTimeSelectionHelper.SelectComponent(
AComponent: TPersistent; AShift: TShiftState);
begin
FSelectionList.BeginUpdate;
try
if (ssCtrl in AShift) and IsComponentSelected(AComponent) then
FSelectionList.Delete(FSelectionList.IndexOf(TComponent(AComponent)))
else
begin
if [ssCtrl, ssShift] * AShift = [] then
ClearSelection;
if not IsComponentSelected(AComponent) then
FSelectionList.Add(TComponent(AComponent));
end;
finally
FSelectionList.EndUpdate;
end;
end;
procedure TdxLayoutRunTimeSelectionHelper.SetSelection(AList: TList);
var
I: Integer;
begin
FSelectionList.BeginUpdate;
try
ClearSelection;
for I := 0 to AList.Count - 1 do
if FSelectionList.IndexOf(AList[I]) = -1 then
FSelectionList.Add(AList[I]);
finally
FSelectionList.EndUpdate;
end;
end;
function TdxLayoutRunTimeSelectionHelper.UniqueName(const BaseName: string): string;
begin
Result := '';
end;
function TdxLayoutRunTimeSelectionHelper.GetComponentClass(AComponent: TComponent): TComponentClass;
begin
Result := TComponentClass(AComponent.ClassType);
end;
procedure TdxLayoutRunTimeSelectionHelper.NotifyListeners(AList: TList; AAction: TdxSelectionAction);
var
I: Integer;
AIntf: IdxSelectionChanged;
begin
for I := 0 to FListeners.Count - 1 do
if Supports(TObject(FListeners[I]), IdxSelectionChanged, AIntf) then
begin
AIntf.SelectionChanged(AList, AAction);
AIntf := nil;
end;
end;
procedure TdxLayoutRunTimeSelectionHelper.SelectionListNotify(AComponent: TComponent;
AAction: TListNotification);
var
ASelectableItem: IdxLayoutSelectableItem;
begin
if not (csDestroying in AComponent.ComponentState) and
Supports(AComponent, IdxLayoutSelectableItem, ASelectableItem) then
ASelectableItem.SelectionChanged;
end;
procedure TdxLayoutRunTimeSelectionHelper.DoDeleteComponents(AList: TcxComponentList);
var
ASavedOwnsObjects: Boolean;
begin
ASavedOwnsObjects := AList.OwnsObjects;
AList.OwnsObjects := True;
AList.Clear;
AList.OwnsObjects := ASavedOwnsObjects;
end;
function TdxLayoutRunTimeSelectionHelper.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TdxLayoutRunTimeSelectionHelper._AddRef: Integer;
begin
Result := InterlockedIncrement(FRefCount);
end;
function TdxLayoutRunTimeSelectionHelper._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
function TdxLayoutRunTimeSelectionHelper.GetComponent: TComponent;
begin
Result := TComponent(Owner);
end;
procedure TdxLayoutRunTimeSelectionHelper.SelectionListNotifyHandler(Sender: TObject;
AComponent: TComponent; AAction: TListNotification);
begin
SelectionListNotify(AComponent, AAction);
end;
procedure TdxLayoutRunTimeSelectionHelper.SelectionListChangedHandler(Sender: TObject;
AComponent: TComponent; AAction: TcxComponentCollectionNotification);
const
Action: array[TcxComponentCollectionNotification] of TdxSelectionAction = (saAdded, saChanged, saExtracted, saExtracted, saExtracted);
var
AList: TList;
begin
if AAction in [ccnAdded, ccnChanged, ccnExtracted] then
begin
AList := TList.Create;
try
GetSelection(AList);
NotifyListeners(AList, Action[AAction]);
finally
AList.Free;
end;
end;
end;
{ TdxSelectionLayer }
constructor TdxSelectionLayer.Create(AParentControl: TWinControl; AParentWindow: HWND);
begin
CreateParented(AParentWindow);
FSelectionImage := TcxAlphaBitmap.Create;
FWindowCanvas := TcxCanvas.Create(inherited Canvas);
Visible := False;
ParentControl := AParentControl;
end;
destructor TdxSelectionLayer.Destroy;
begin
FreeAndNil(FWindowCanvas);
FreeAndNil(FSelectionImage);
inherited Destroy;
end;
procedure TdxSelectionLayer.Paint;
begin
inherited;
InternalPaint;
end;
procedure TdxSelectionLayer.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SelectionImage.SetSize(Width, Height);
end;
procedure TdxSelectionLayer.InvalidateRect(const R: TRect);
begin
if HandleAllocated then
cxInvalidateRect(Handle, R, False);
end;
procedure TdxSelectionLayer.MoveTo(const P: TPoint);
begin
SetBounds(P.X, P.Y, Width, Height);
end;
procedure TdxSelectionLayer.Hide;
begin
if HandleAllocated then
begin
ShowWindow(Handle, SW_HIDE);
DoHide;
end;
end;
procedure TdxSelectionLayer.Show;
begin
ShowWindow(Handle, SW_SHOWNOACTIVATE);
Update;
Invalidate;
BringWindowToTop(Handle);
DoShow;
end;
procedure TdxSelectionLayer.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_POPUP;
ExStyle := ExStyle or WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
end;
if ParentControl <> nil then
Params.WndParent := ParentControl.Handle;
end;
procedure TdxSelectionLayer.DoHide;
begin
CallNotify(FOnHide, Self);
end;
procedure TdxSelectionLayer.DoShow;
begin
CallNotify(FOnShow, Self);
end;
procedure TdxSelectionLayer.InternalPaint;
var
// R: TRect;
ABitmap: TcxBitmap32;
begin
ABitmap := TcxBitmap32.CreateSize(ClientRect);
try
// R := cxRectOffset(ClientRect, Left, Top);
//#DG cxPaintControlTo(ParentControl, ABitmap.cxCanvas, cxPointInvert(R.TopLeft), cxPointInvert(R.TopLeft), R, False);
cxPaintTo(ParentControl, ABitmap.cxCanvas, cxNullPoint, ClientRect);
cxAlphaBlend(ABitmap.cxCanvas.Handle, SelectionImage.cxCanvas.Handle, ClientRect, ClientRect);
cxBitBlt(WindowCanvas.Handle, ABitmap.cxCanvas.Handle, ClientRect, cxNullPoint, SRCCOPY);
finally
ABitmap.Free;
end;
end;
function TdxSelectionLayer.GetWindowCanvas: TcxCanvas;
begin
Result := FWindowCanvas;
end;
procedure TdxSelectionLayer.SetParentControl(AValue: TWinControl);
begin
if FParentControl <> AValue then
begin
FParentControl := AValue;
RecreateWnd;
end;
end;
procedure TdxSelectionLayer.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TdxSelectionLayer.WMNCHitTest(var Message: TWMNCHitTest);
begin
Message.Result := HTTRANSPARENT;
end;
{ TdxControlsDesignSelectorHelper }
constructor TdxControlsDesignSelectorHelper.Create(AOwner: TComponent);
begin
inherited Create(nil);
FControl := AOwner as TControl;
FSelectorBounds := cxInvalidRect;
FChildren := TcxComponentList.Create(True);
if Control <> nil then
begin
FDefaultControlWndProc := Control.WindowProc;
Control.WindowProc := ControlWndProc;
end;
end;
constructor TdxControlsDesignSelectorHelper.CreateEx(AControlWnd: THandle);
begin
Create(nil);
FControlWnd := AControlWnd;
FControlWndProcInstance := Classes.MakeObjectInstance(ControlWndProc);
FDefaultControlWndProcInstance := Pointer(GetWindowLong(ControlWnd, GWL_WNDPROC));
SetWindowLong(ControlWnd, GWL_WNDPROC, Integer(FControlWndProcInstance));
end;
destructor TdxControlsDesignSelectorHelper.Destroy;
begin
if Assigned(FDefaultControlWndProc) then
begin
Control.WindowProc := FDefaultControlWndProc;
FDefaultControlWndProc := nil;
end
else
if FDefaultControlWndProcInstance <> nil then
begin
SetWindowLong(ControlWnd, GWL_WNDPROC, Integer(FDefaultControlWndProcInstance));
Classes.FreeObjectInstance(FControlWndProcInstance);
end;
FreeAndNil(FChildren);
inherited Destroy;
end;
procedure TdxControlsDesignSelectorHelper.Assign(Source: TPersistent);
var
AItem: TdxControlsDesignSelectorHelper;
begin
if Source is TdxControlsDesignSelectorHelper then
begin
AItem := Source as TdxControlsDesignSelectorHelper;
FSelectorBounds := AItem.GetSelectorBoundsForChild(Self);
CheckChildren;
end
else
inherited Assign(Source);
end;
procedure TdxControlsDesignSelectorHelper.ControlWndProc(var Message: TMessage);
procedure InternalPaint(DC: HDC);
var
ADC: HDC;
begin
if not IsActiveDesignSelector then
Exit;
if DC <> 0 then
DrawDesignSelector(DC)
else
if IsWinControl then
begin
ADC := GetWindowDC(ControlWnd);
DrawDesignSelector(ADC);
ReleaseDC(ControlWnd, ADC);
end;
end;
begin
if DoControlWndProc(Message) then
CallDefaultWndProc(Message);
case Message.Msg of
CM_CONTROLCHANGE, DXM_CHECKCHILDREN:
CheckChildren;
WM_WINDOWPOSCHANGED:
ParentCheckChildren;
WM_PAINT:
InternalPaint(TWMPaint(Message).DC);
WM_NCPAINT:
InternalPaint(0);
end;
end;
function TdxControlsDesignSelectorHelper.DoControlWndProc(var Message: TMessage): Boolean;
function PtInSelectorBounds(const P: TPoint): Boolean;
begin
Result := PtInRect(SelectorBounds, P);
end;
begin
Result := True;
if IsValid and IsActiveDesignSelector then
case Message.Msg of
WM_NCHITTEST:
if PtInSelectorBounds(ScreenToClient(Point(Message.LParamLo, Message.LParamHi))) then
begin
Message.Result := HTTRANSPARENT;
Result := False;
end;
CM_HITTEST:
if PtInSelectorBounds(Point(Message.LParamLo, Message.LParamHi)) then
begin
Message.Result := HTNOWHERE;
Result := False;
end;
end;
end;
procedure TdxControlsDesignSelectorHelper.CallDefaultWndProc(var Message: TMessage);
begin
if FDefaultControlWndProcInstance <> nil then
with Message do
Result := CallWindowProc(FDefaultControlWndProcInstance, ControlWnd, Msg, WParam, LParam)
else
FDefaultControlWndProc(Message);
end;
procedure TdxControlsDesignSelectorHelper.CheckChildren;
procedure TryAddChild(AControl: TControl); overload;
var
AIntf: IdxCustomizeControlsHelper;
begin
if (csDestroying in AControl.ComponentState) or (Supports(AControl, IdxCustomizeControlsHelper, AIntf) and AIntf.CanProcessChildren) then
Exit;
PrepareChild(GetChildClass.Create(AControl));
end;
procedure TryAddChild(AControlWnd: THandle); overload;
begin
PrepareChild(GetChildClass.CreateEx(AControlWnd));
end;
var
I: Integer;
AControl: TControl;
AWnd: THandle;
AIntf: IdxCustomizeControlsHelper;
begin
FChildren.Clear;
if IsWinControl and ((Control <> nil) and (not Supports(Control, IdxCustomizeControlsHelper, AIntf) or not AIntf.CanProcessChildren)) then
begin
if Control <> nil then
for I := 0 to ControlAsWinControl.ControlCount - 1 do
TryAddChild(ControlAsWinControl.Controls[I]);
AWnd := GetWindow(ControlWnd, GW_CHILD);
if AWnd <> 0 then
AWnd := GetWindow(AWnd, GW_HWNDFIRST);
while AWnd <> 0 do
begin
AControl := FindControl(AWnd);
if (AControl <> nil) then
begin
if not ControlAsWinControl.ContainsControl(AControl) then
TryAddChild(AControl);
end
else
TryAddChild(AWnd);
AWnd := GetWindow(AWnd, GW_HWNDNEXT);
end;
end;
end;
function TdxControlsDesignSelectorHelper.GetChildClass: TdxControlsDesignSelectorHelperClass;
begin
Result := TdxControlsDesignSelectorHelper;
end;
procedure TdxControlsDesignSelectorHelper.ParentCheckChildren;
var
AParentHandle: THandle;
begin
if (Parent <> nil) and Parent.IsWinControl then
begin
AParentHandle := Parent.ControlWnd;
if AParentHandle <> 0 then
PostMessage(AParentHandle, DXM_CHECKCHILDREN, 0, 0);
end;
end;
procedure TdxControlsDesignSelectorHelper.PrepareChild(AItem: TdxControlsDesignSelectorHelper);
begin
if FChildren.IndexOf(AItem) = -1 then
FChildren.Add(AItem);
AItem.Parent := Self;
AItem.Assign(Self);
end;
function TdxControlsDesignSelectorHelper.GetSelectorBoundsForChild(AChild: TdxControlsDesignSelectorHelper): TRect;
var
P: TPoint;
begin
Result := SelectorBounds;
if AChild.IsWinControl and ((AChild.Control = nil) or AChild.ControlAsWinControl.HandleAllocated) then
P := ScreenToClient(AChild.ClientToScreen(cxNullPoint))
else
P := AChild.Control.BoundsRect.TopLeft;
Result := cxRectOffset(Result, P, False);
end;
function TdxControlsDesignSelectorHelper.ClientToScreen(const P: TPoint): TPoint;
begin
if IsWinControl and ((Control = nil) or ControlAsWinControl.HandleAllocated) then
begin
Result := P;
Windows.ClientToScreen(ControlWnd, Result);
end
else
Result := Control.ClientToScreen(P);
end;
function TdxControlsDesignSelectorHelper.ScreenToClient(const P: TPoint): TPoint;
begin
if IsWinControl and ((Control = nil) or ControlAsWinControl.HandleAllocated) then
begin
Result := P;
Windows.ScreenToClient(ControlWnd, Result);
end
else
Result := Control.ScreenToClient(P);
end;
function TdxControlsDesignSelectorHelper.IsActiveDesignSelector: Boolean;
var
R: TRect;
begin
GetWindowRect(ControlWnd, R);
Result := IsValid and (cxRectWidth(R) >= cxRectWidth(SelectorBounds)) and (cxRectHeight(R) >= cxRectHeight(SelectorBounds));
end;
function TdxControlsDesignSelectorHelper.IsSelected: Boolean;
begin
Result := False;
end;
function TdxControlsDesignSelectorHelper.IsValid: Boolean;
begin
Result := not (csDestroying in ComponentState) and ((Control <> nil) or (ControlWnd <> 0));
end;
function TdxControlsDesignSelectorHelper.IsWinControl: Boolean;
begin
Result := ((Control = nil) and (FControlWnd <> 0)) or (Control is TWinControl);
end;
function TdxControlsDesignSelectorHelper.ControlAsWinControl: TWinControl;
begin
Result := Control as TWinControl;
end;
function TdxControlsDesignSelectorHelper.CanDrawDesignSelector: Boolean;
begin
Result := IsActiveDesignSelector and ((Parent = nil) or (IsWinControl and IsWindowVisible(ControlWnd)));
end;
procedure TdxControlsDesignSelectorHelper.DoDrawDesignSelector(DC: HDC);
var
R: TRect;
P: TPoint;
begin
cxPaintCanvas.BeginPaint(DC);
try
SelectClipRgn(cxPaintCanvas.Handle, 0);
R := SelectorBounds;
if (Control <> nil) and not (csPaintCopy in Control.ControlState) and (Control.Parent <> nil) then
begin
P := Control.Parent.ScreenToClient(Control.ClientToScreen(cxNullPoint));
P := cxPointOffset(P, Control.BoundsRect.TopLeft, False);
R := cxRectOffset(R, P);
end;
cxDrawDesignRect(cxPaintCanvas, R, IsSelected);
finally
cxPaintCanvas.EndPaint;
end;
end;
procedure TdxControlsDesignSelectorHelper.DrawDesignSelector(DC: HDC);
begin
if CanDrawDesignSelector then
DoDrawDesignSelector(DC);
end;
function TdxControlsDesignSelectorHelper.GetControlWnd: THandle;
begin
if IsWinControl then
begin
if (Control <> nil) and ControlAsWincontrol.HandleAllocated then
Result := ControlAsWincontrol.Handle
else
Result := FControlWnd;
end
else
Result := 0;
end;
function TdxControlsDesignSelectorHelper.GetParentControl: TWinControl;
begin
Result := Control.Parent;
end;
procedure TdxControlsDesignSelectorHelper.SetSelectorBounds(const AValue: TRect);
begin
if not EqualRect(AValue, FSelectorBounds) then
begin
FSelectorBounds := AValue;
CheckChildren;
if Control.Visible then
Control.Invalidate;
end;
end;
end.