Componentes.Terceros.DevExp.../internal/x.44/1/ExpressLayout Control 2/Sources/dxLayoutControlReg.pas

988 lines
31 KiB
ObjectPascal
Raw Normal View History

{********************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressLayoutControl registering unit }
{ }
{ 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 dxLayoutControlReg;
{$I cxVer.inc}
interface
procedure Register;
implementation
uses
Windows, SysUtils, Classes, Graphics, Controls, Contnrs, Forms, StdCtrls, ExtCtrls,
Messages,
DesignIntf, DesignEditors, DesignMenus, VCLEditors, DesignWindows,
ComponentDesigner, TypInfo,
dxCore, cxClasses, cxControls, cxContainer,
dxCoreReg, cxLibraryReg, cxDesignWindows, dxRegEd,
dxLayoutCommon, dxLayoutControl, dxLayoutLookAndFeels,
dxLayoutEditForm, dxLayoutLookAndFeelListDesignForm;
const
dxLayoutControlMajorVersion = '2';
dxLayoutControlProductName = 'ExpressLayoutControl';
type
TControlAccess = class(TControl);
TLabelAccess = class(TCustomLabel);
TdxLayoutGroupAcsess = class(TdxLayoutGroup);
TdxLayoutControlAccess = class(TdxLayoutControl);
TdxCustomLayoutItemAccess = class(TdxCustomLayoutItem);
TdxLayoutItemAccess = class(TdxLayoutItem);
TStaticTextAccess = class(TCustomStaticText);
{ TdxLayoutCustomControlEditor }
TdxLayoutCustomControlEditor = class(TdxComponentEditor)
protected
function GetProductMajorVersion: string; override;
function GetProductMinorVersion: string; override;
function GetProductName: string; override;
end;
{ TdxLayoutControlEditor }
TdxLayoutControlEditor = class(TdxLayoutCustomControlEditor)
protected
function InternalGetVerb(AIndex: Integer): string; override;
function InternalGetVerbCount: Integer; override;
procedure InternalExecuteVerb(AIndex: Integer); override;
function GetControl: TdxLayoutControl; virtual;
procedure DoImport;
property Control: TdxLayoutControl read GetControl;
public
procedure PrepareItem(Index: Integer; const AItem: IMenuItem); override;
end;
{ TdxLayoutControlItemsEditor }
TdxLayoutControlItemsEditor = class(TdxLayoutControlEditor)
private
function GetItem: TdxCustomLayoutItem;
protected
function GetControl: TdxLayoutControl; override;
property Item: TdxCustomLayoutItem read GetItem;
end;
{ TdxDesignCustomizationHelper }
TdxDesignCustomizationHelper = class
private
FLayoutControls: TList;
public
constructor Create;
destructor Destroy; override;
class procedure AddLayout(ALayout: TdxCustomLayoutControl);
class function FindActiveDesigner(out ADesigner: IDesigner): Boolean;
class function IsLayoutDesignerActive: Boolean;
class procedure RemoveLayout(ALayout: TdxCustomLayoutControl);
end;
{ TdxLayoutDesignTimeSelectionHelper }
TdxLayoutDesignTimeSelectionHelper = class(TdxLayoutRunTimeSelectionHelper, IcxDesignSelectionChanged)
private
FDesignHelper: TcxDesignHelper;
protected
//IcxDesignSelectionChanged
procedure DesignSelectionChanged(ASelection: TList);
public
constructor Create(AOwner: TPersistent); override;
destructor Destroy; override;
procedure AddSelectionChangedListener(AListener: TPersistent); override;
procedure RemoveSelectionChangedListener(AListener: TPersistent); override;
function CanDeleteComponent(AComponent: TComponent): Boolean; override;
procedure ClearSelection; override;
procedure GetSelection(AList: TList); override;
function IsComponentSelected(AComponent: TPersistent): Boolean; override;
procedure SelectComponent(AComponent: TPersistent; AShift: TShiftState = []); override;
procedure SetSelection(AList: TList); override;
function UniqueName(const BaseName: string): string; override;
end;
TdxLayoutColorProperty = class(TColorProperty)
public
function GetValue: string; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
end;
TdxLayoutRegistryPathProperty = class(TStringProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
TdxLayoutLookAndFeelListEditor = class(TdxLayoutCustomControlEditor)
private
function GetLookAndFeelList: TdxLayoutLookAndFeelList;
protected
function InternalGetVerb(AIndex: Integer): string; override;
function InternalGetVerbCount: Integer; override;
procedure InternalExecuteVerb(AIndex: Integer); override;
property LookAndFeelList: TdxLayoutLookAndFeelList read GetLookAndFeelList;
end;
{ TdxLayoutLookAndFeelProperty }
TdxLayoutLookAndFeelProperty = class(TComponentProperty)
private
FLookAndFeelLists: TComponentList;
function GetLookAndFeelLists: TComponentList;
procedure GetLookAndFeelListNameProc(const S: string);
public
function AutoFill: Boolean; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
end;
TdxLayoutItemSelectionEditor = class(TSelectionEditor)
public
procedure RequiresUnits(Proc: TGetStrProc); override;
end;
const
sCreateNewLookAndFeelInListBegin = '<Create a new LookAndFeel in ';
sCreateNewLookAndFeelInListEnd = '>';
sCreateNewLookAndFeelInNewList = '<Create a new LookAndFeel in the new list>';
{ TdxLayoutCustomControlEditor }
function TdxLayoutCustomControlEditor.GetProductMajorVersion: string;
begin
Result := dxLayoutControlMajorVersion;
end;
function TdxLayoutCustomControlEditor.GetProductMinorVersion: string;
begin
Result := inherited GetProductMinorVersion + 'b1';
end;
function TdxLayoutCustomControlEditor.GetProductName: string;
begin
Result := dxLayoutControlProductName;
end;
{ TdxLayoutControlEditor }
function TdxLayoutControlEditor.GetControl: TdxLayoutControl;
begin
Result := TdxLayoutControl(Component);
end;
function TdxLayoutControlEditor.InternalGetVerb(AIndex: Integer): string;
begin
case AIndex of
0: Result := 'Designer...';
1: Result := 'Import...';
end;
end;
function TdxLayoutControlEditor.InternalGetVerbCount: Integer;
begin
Result := 2;
end;
procedure TdxLayoutControlEditor.InternalExecuteVerb(AIndex: Integer);
begin
case AIndex of
0:
begin
if Control.Customization then
Control.CustomizeForm.BringToFront
else
Control.Customization := True;
end;
1:
DoImport;
end;
end;
procedure TdxLayoutControlEditor.DoImport;
var
AControlName: string;
AControlCaptions: TStringList;
ACaptionLayouts: TList;
R: TRect;
function GetRoot: TWinControl;
begin
Result := Control.Owner as TWinControl;
end;
function CanExport(AControl: TControl): Boolean;
begin
Result := (AControl <> Control) and
not (csNoDesignVisible in AControl.ControlStyle) and not (csSubComponent in AControl.ComponentStyle);
end;
function GetControlsCombo: TComboBox;
function AddItems(AControl: TWinControl; AStrings: TStrings;
AInsertionIndex: Integer): Boolean;
var
I: Integer;
begin
with AControl do
begin
Result := CanExport(AControl) and (csAcceptsControls in ControlStyle);
if Result then
begin
AStrings.Insert(AInsertionIndex, Name);
AInsertionIndex := AStrings.Count;
for I := 0 to ControlCount - 1 do
if Controls[I] is TWinControl then
if AddItems(TWinControl(Controls[I]), AStrings, AInsertionIndex) then
Inc(AInsertionIndex);
end;
end;
end;
begin
Result := TComboBox.Create(nil);
with Result do
begin
Visible := False;
Parent := GetParentForm(Control);
DropDownCount := 15;
Style := csDropDownList;
AddItems(GetRoot, Items, 0);
if Items.Count <> 0 then
ItemIndex := 0;
end;
end;
function GetControl: TWinControl;
begin
if GetRoot.Name = AControlName then
Result := GetRoot
else
Result := GetRoot.FindComponent(AControlName) as TWinControl;
end;
function ExportControl(AControl: TControl; AGroup: TdxLayoutGroup;
out AControlBounds: TRect): Boolean;
var
AControlCaption: string;
AItem: TdxCustomLayoutItem;
function IsControlGroup: Boolean;
begin
Result := (AControl = GetRoot) or
(AControl is TCustomGroupBox) or (AControl is TCustomPanel);
end;
procedure ExportGroupControl;
procedure ExportChildren;
var
AFirstBounds, ABounds: TRect;
AIsLayoutDirectionAssigned: Boolean;
I: Integer;
function GetLayoutDirection(const R1, R2: TRect): TdxLayoutDirection;
begin
if (R1.Right <= R2.Left) or (R2.Right <= R1.Left) then
Result := ldHorizontal
else
Result := ldVertical;
end;
begin
SetRectEmpty(AFirstBounds);
AIsLayoutDirectionAssigned := False;
I := 0;
while I < TWinControl(AControl).ControlCount do
begin
if not ExportControl(TWinControl(AControl).Controls[I], TdxLayoutGroup(AItem), ABounds) then
Inc(I);
if not IsRectEmpty(ABounds) then
if IsRectEmpty(AFirstBounds) then
AFirstBounds := ABounds
else
if not AIsLayoutDirectionAssigned then
begin
TdxLayoutGroup(AItem).LayoutDirection := GetLayoutDirection(AFirstBounds, ABounds);
AIsLayoutDirectionAssigned := True;
end;
end;
end;
begin
if AControl = GetRoot then
AItem := AGroup
else
begin
AItem := AGroup.CreateGroup;
TdxLayoutGroup(AItem).Hidden := AControl is TCustomPanel;
AItem.Caption := AControlCaption;
end;
ExportChildren;
end;
procedure ExportNonGroupControl;
var
AFocusControl: TWinControl;
ACaptionIndex: Integer;
AControlItem: TdxLayoutItem;
ACaptionLayout: TdxCaptionLayout;
function GetFocusControl: TWinControl;
begin
if AControl is TCustomLabel then
Result := TLabelAccess(AControl).FocusControl
else
if AControl is TCustomStaticText then
Result := TStaticTextAccess(AControl).FocusControl
else
Result := nil;
end;
function IsLabel: Boolean;
begin
Result := (AControl is TCustomLabel) or (AControl is TCustomStaticText);
end;
function GetCaptionLayout: TdxCaptionLayout;
begin
if AControl.BoundsRect.Right <= AFocusControl.BoundsRect.Left then
Result := clLeft
else
if AControl.BoundsRect.Left >= AFocusControl.BoundsRect.Right then
Result := clRight
else
if AControl.BoundsRect.Bottom <= AFocusControl.BoundsRect.Top then
Result := clTop
else
Result := clBottom;
end;
procedure AssignItemCaptionData(AItem: TdxLayoutItem;
const ACaption: string; ACaptionLayout: TdxCaptionLayout);
begin
AItem.Caption := ACaption;
AItem.CaptionOptions.Layout := ACaptionLayout;
end;
begin
if IsLabel then
SetRectEmpty(AControlBounds);
AFocusControl := GetFocusControl;
if AFocusControl = nil then
begin
if (AControl is TCustomLabeledEdit) or IsLabel then Exit;
Result := True;
AItem := AGroup.CreateItemForControl(AControl);
ACaptionIndex := AControlCaptions.IndexOfObject(AControl);
if ACaptionIndex <> -1 then
AssignItemCaptionData(TdxLayoutItem(AItem), AControlCaptions[ACaptionIndex],
TdxCaptionLayout(ACaptionLayouts[ACaptionIndex]));
end
else
begin
AControlItem := Control.FindItem(AFocusControl);
ACaptionLayout := GetCaptionLayout;
if AControlItem <> nil then
AssignItemCaptionData(AControlItem, AControlCaption, ACaptionLayout)
else
begin
AControlCaptions.AddObject(AControlCaption, AFocusControl);
ACaptionLayouts.Add(Pointer(ACaptionLayout));
end;
end;
end;
procedure ProcessAnchors;
const
AlignHorzs: array[Boolean, Boolean] of TdxLayoutAlignHorz =
((ahLeft, ahRight), (ahLeft, ahClient));
AlignVerts: array[Boolean, Boolean] of TdxLayoutAlignVert =
((avTop, avBottom), (avTop, avClient));
begin
if (AItem = nil) or AItem.IsRoot then Exit;
with AControl do
begin
AItem.AlignHorz := AlignHorzs[akLeft in Anchors, akRight in Anchors];
AItem.AlignVert := AlignVerts[akTop in Anchors, akBottom in Anchors];
end;
end;
begin
Result := False;
SetRectEmpty(AControlBounds);
if not CanExport(AControl) then Exit;
AControlCaption := TControlAccess(AControl).Caption;
AControlBounds := AControl.BoundsRect;
AItem := nil;
if IsControlGroup then
ExportGroupControl
else
ExportNonGroupControl;
ProcessAnchors;
end;
begin
AControlName := '';
if not TLayoutEditForm.Run('Import', 'Choose a control to import data from:',
AControlName, GetControlsCombo) then Exit;
AControlCaptions := TStringList.Create;
ACaptionLayouts := TList.Create;
try
Control.BeginUpdate;
try
ExportControl(GetControl, Control.Items, R);
Control.Items.Pack;
finally
Control.EndUpdate;
end;
finally
ACaptionLayouts.Free;
AControlCaptions.Free;
end;
end;
procedure TdxLayoutControlEditor.PrepareItem(Index: Integer; const AItem: IMenuItem);
begin
inherited;
if Index in [1, 2] then
AItem.Enabled := not IsInInlined;
end;
{ TdxLayoutControlItemsEditor }
function TdxLayoutControlItemsEditor.GetControl: TdxLayoutControl;
begin
Result := TdxLayoutControl(Item.Container);
end;
function TdxLayoutControlItemsEditor.GetItem: TdxCustomLayoutItem;
begin
Result := TdxCustomLayoutItem(Component);
end;
{ TdxDesignCustomizationHelper }
var
FDesignCustomizationHelper: TdxDesignCustomizationHelper;
FKeyboardHookHandle: HHOOK;
function ProcessKeyboardMessage(AKey: WPARAM; AFlags: LPARAM): Boolean;
function IsDragging(AList: TcxComponentList): Boolean;
var
I: Integer;
begin
Result := False;
for I := 0 to AList.Count - 1 do
begin
Result := (AList[I] is TdxCustomLayoutItem) and
TdxCustomLayoutItemAccess(AList[I]).IsDragged;
if Result then
Break;
end;
end;
function DeleteItems(AList: TcxComponentList): Boolean;
procedure CheckDeleteItems;
var
I: Integer;
begin
for I := AList.Count - 1 downto 0 do
if not (TObject(AList[I]) is TdxCustomLayoutItem) then
AList.Extract(AList[I]);
end;
begin
Result := False;
CheckDeleteItems;
AList.OwnsObjects := True;
AList.Clear;
end;
function SelectItemParent(AComponent: TComponent): Boolean;
var
AIntf: IdxLayoutSelectableItem;
begin
Result := Supports(AComponent, IdxLayoutSelectableItem, AIntf);
if Result then
AIntf.SelectParent;
end;
function KeyPressed: Boolean;
begin
Result := (AFlags shr 31) and 1 = 0;
end;
var
AList: TcxComponentList;
ADesigner: IDesigner;
begin
Result := KeyPressed;
if Result then
begin
AList := TcxComponentList.Create;
try
if TdxDesignCustomizationHelper.FindActiveDesigner(ADesigner) then
GetSelections(ADesigner, AList);
Result := (AList.Count > 0) and not IsDragging(AList) and not TdxDesignCustomizationHelper.IsLayoutDesignerActive;
if Result then
case AKey of
VK_DELETE:
Result := DeleteItems(AList);
VK_ESCAPE:
Result := SelectItemParent(AList[0]);
else
Result := False;
end;
finally
AList.Free;
end;
end;
end;
function KeyboardHookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if (Code = HC_ACTION) and ProcessKeyboardMessage(wParam, lParam) then
Result := 1
else
Result := CallNextHookEx(FKeyboardHookHandle, Code, wParam, lParam);
end;
constructor TdxDesignCustomizationHelper.Create;
begin
inherited;
FLayoutControls := TList.Create;
SetHook(FKeyboardHookHandle, WH_KEYBOARD, KeyboardHookProc);
end;
destructor TdxDesignCustomizationHelper.Destroy;
begin
ReleaseHook(FKeyboardHookHandle);
FreeAndNil(FLayoutControls);
inherited Destroy;
end;
class procedure TdxDesignCustomizationHelper.AddLayout(ALayout: TdxCustomLayoutControl);
begin
if FDesignCustomizationHelper = nil then
FDesignCustomizationHelper := Self.Create;
FDesignCustomizationHelper.FLayoutControls.Add(ALayout);
end;
class function TdxDesignCustomizationHelper.FindActiveDesigner(out ADesigner: IDesigner): Boolean;
var
I: Integer;
AForm: TCustomForm;
begin
Result := (ActiveRoot <> nil) and (FDesignCustomizationHelper <> nil);
if Result then
begin
Result := False;
ADesigner := ActiveRoot.GetDesigner;
for I := 0 to FDesignCustomizationHelper.FLayoutControls.Count - 1 do
begin
AForm := GetParentForm(TControl(FDesignCustomizationHelper.FLayoutControls[I]));
Result := (AForm <> nil) and (ActiveRoot = ActiveDesigner.FindRoot(AForm)) and IsFormActive(AForm);
if Result then
Exit;
end;
end;
end;
class function TdxDesignCustomizationHelper.IsLayoutDesignerActive: Boolean;
var
I: Integer;
ALayoutControl: TdxCustomLayoutControl;
begin
Result := FDesignCustomizationHelper <> nil;
if Result then
begin
Result := False;
for I := 0 to FDesignCustomizationHelper.FLayoutControls.Count - 1 do
begin
ALayoutControl := TdxCustomLayoutControl(FDesignCustomizationHelper.FLayoutControls[I]);
Result := (ALayoutControl.CustomizeForm <> nil) and ALayoutControl.CustomizeForm.Active;
if Result then
Break;
end;
end;
end;
class procedure TdxDesignCustomizationHelper.RemoveLayout(ALayout: TdxCustomLayoutControl);
begin
FDesignCustomizationHelper.FLayoutControls.Remove(ALayout);
if FDesignCustomizationHelper.FLayoutControls.Count = 0 then
FreeAndNil(FDesignCustomizationHelper);
end;
{ TdxLayoutDesignTimeSelectionHelper }
constructor TdxLayoutDesignTimeSelectionHelper.Create(AOwner: TPersistent);
begin
inherited Create(AOwner);
FDesignHelper := TcxDesignHelper.Create(Component);
TdxDesignCustomizationHelper.AddLayout(Component as TdxCustomLayoutControl);
end;
destructor TdxLayoutDesignTimeSelectionHelper.Destroy;
begin
TdxDesignCustomizationHelper.RemoveLayout(Component as TdxCustomLayoutControl);
FDesignHelper := nil;
inherited Destroy;
end;
procedure TdxLayoutDesignTimeSelectionHelper.AddSelectionChangedListener(AListener: TPersistent);
begin
inherited AddSelectionChangedListener(AListener);
if Listeners.Count > 0 then
FDesignHelper.AddSelectionChangedListener(Self);
end;
procedure TdxLayoutDesignTimeSelectionHelper.RemoveSelectionChangedListener(AListener: TPersistent);
begin
inherited RemoveSelectionChangedListener(AListener);
if Listeners.Count = 0 then
FDesignHelper.RemoveSelectionChangedListener(Self);
end;
function TdxLayoutDesignTimeSelectionHelper.CanDeleteComponent(AComponent: TComponent): Boolean;
begin
Result := FDesignHelper.CanDeleteComponent(Component, AComponent);
end;
procedure TdxLayoutDesignTimeSelectionHelper.ClearSelection;
begin
FDesignHelper.SelectObject(Component, Component);
end;
procedure TdxLayoutDesignTimeSelectionHelper.GetSelection(AList: TList);
begin
FDesignHelper.GetSelection(AList);
end;
function TdxLayoutDesignTimeSelectionHelper.IsComponentSelected(AComponent: TPersistent): Boolean;
begin
Result := FDesignHelper.IsObjectSelected(AComponent);
end;
procedure TdxLayoutDesignTimeSelectionHelper.SelectComponent(AComponent: TPersistent; AShift: TShiftState = []);
begin
if (ssShift in AShift) and IsComponentSelected(AComponent) then
FDesignHelper.UnselectObject(AComponent)
else
FDesignHelper.SelectObject(AComponent, not (ssShift in AShift));
end;
procedure TdxLayoutDesignTimeSelectionHelper.SetSelection(AList: TList);
begin
FDesignHelper.SetSelection(AList);
end;
function TdxLayoutDesignTimeSelectionHelper.UniqueName(const BaseName: string): string;
begin
Result := FDesignHelper.UniqueName(BaseName)
end;
//IcxDesignSelectionChanged
procedure TdxLayoutDesignTimeSelectionHelper.DesignSelectionChanged(ASelection: TList);
begin
NotifyListeners(ASelection, lsaChanged);
end;
{ TdxLayoutLookAndFeelListEditor }
function TdxLayoutLookAndFeelListEditor.GetLookAndFeelList: TdxLayoutLookAndFeelList;
begin
Result := TdxLayoutLookAndFeelList(Component);
end;
function TdxLayoutLookAndFeelListEditor.InternalGetVerb(AIndex: Integer): string;
begin
Result := 'Designer...'
end;
function TdxLayoutLookAndFeelListEditor.InternalGetVerbCount: Integer;
begin
Result := 1;
end;
procedure TdxLayoutLookAndFeelListEditor.InternalExecuteVerb(AIndex: Integer);
var
AForm: TdxLayoutLookAndFeelListDesignForm;
begin
if dxLayoutLookAndFeelsDesigner = nil then
begin
AForm := TdxLayoutLookAndFeelListDesignForm.Create(nil);
AForm.Designer := Designer;
AForm.Show;
end;
dxLayoutLookAndFeelsDesigner.SetList(LookAndFeelList);
end;
{ TdxLayoutColorProperty }
const
DefaultColorText = 'clDefault';
function TdxLayoutColorProperty.GetValue: string;
begin
if GetOrdValue = clDefault then
Result := DefaultColorText
else
Result := inherited GetValue;
end;
procedure TdxLayoutColorProperty.GetValues(Proc: TGetStrProc);
begin
Proc(DefaultColorText);
inherited;
end;
procedure TdxLayoutColorProperty.SetValue(const Value: string);
begin
if SameText(Value, DefaultColorText) then
SetOrdValue(clDefault)
else
inherited;
end;
procedure TdxLayoutColorProperty.ListDrawValue(const Value: string;
ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
begin
if Value = DefaultColorText then
with ARect do
ACanvas.TextRect(ARect, Left + (Bottom - Top) + 1, Top + 1, Value)
else
inherited;
end;
procedure TdxLayoutColorProperty.PropDrawValue(ACanvas: TCanvas;
const ARect: TRect; ASelected: Boolean);
begin
if GetVisualValue = DefaultColorText then
with ARect do
ACanvas.TextRect(ARect, Left + 1, Top + 1, GetVisualValue)
else
inherited;
end;
{ TdxLayoutRegistryPathProperty }
procedure TdxLayoutRegistryPathProperty.Edit;
var
AControl: TdxLayoutControl;
S: string;
begin
AControl := TdxLayoutControl(GetComponent(0));
S := AControl.RegistryPath;
if dxGetRegistryPath(S) then
begin
AControl.RegistryPath := S;
Designer.Modified;
end;
end;
function TdxLayoutRegistryPathProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paDialog];
end;
{ TdxLayoutLookAndFeelProperty }
function TdxLayoutLookAndFeelProperty.AutoFill: Boolean;
begin
Result := False;
end;
function TdxLayoutLookAndFeelProperty.GetLookAndFeelLists: TComponentList;
begin
Result := TComponentList.Create(False);
FLookAndFeelLists := Result;
Designer.GetComponentNames(GetTypeData(TdxLayoutLookAndFeelList.ClassInfo),
GetLookAndFeelListNameProc);
end;
procedure TdxLayoutLookAndFeelProperty.GetLookAndFeelListNameProc(const S: string);
begin
FLookAndFeelLists.Add(Designer.GetComponent(S));
end;
procedure TdxLayoutLookAndFeelProperty.GetValues(Proc: TGetStrProc);
var
ALookAndFeelLists: TList;
I: Integer;
begin
ALookAndFeelLists := GetLookAndFeelLists;
try
for I := 0 to ALookAndFeelLists.Count - 1 do
begin
Proc(sCreateNewLookAndFeelInListBegin +
Designer.GetComponentName(ALookAndFeelLists.Items[I]) +
sCreateNewLookAndFeelInListEnd);
end;
finally
ALookAndFeelLists.Free;
end;
Proc(sCreateNewLookAndFeelInNewList);
inherited GetValues(Proc);
end;
procedure TdxLayoutLookAndFeelProperty.SetValue(const Value: string);
procedure CreateAndAssignNewLookAndFeel(ALookAndFeelList: TdxLayoutLookAndFeelList);
var
ALookAndFeel: TdxCustomLayoutLookAndFeel;
ALookAndFeelClass: TdxCustomLayoutLookAndFeelClass;
begin
if dxLayoutControlSelectLookAndFeel(Designer.Root as TWinControl, ALookAndFeelClass) then
begin
ALookAndFeel := ALookAndFeelList.CreateItem(ALookAndFeelClass);
ALookAndFeel.Name := CreateUniqueName(ALookAndFeel.Owner, nil, ALookAndFeel, '', '');
FindRootDesigner(ALookAndFeel).Modified;
SetOrdValue(Integer(ALookAndFeel));
end;
end;
var
ALookAndFeelList: TdxLayoutLookAndFeelList;
AName: string;
begin
if Value = sCreateNewLookAndFeelInNewList then
begin
ALookAndFeelList := TdxLayoutLookAndFeelList.Create(Designer.Root);
ALookAndFeelList.Name := Designer.UniqueName(
Copy(ALookAndFeelList.ClassName, 2, Length(ALookAndFeelList.ClassName)));
CreateAndAssignNewLookAndFeel(ALookAndFeelList);
end
else
if Copy(Value, 1, Length(sCreateNewLookAndFeelInListBegin)) = sCreateNewLookAndFeelInListBegin then
begin
AName := Copy(Value, Length(sCreateNewLookAndFeelInListBegin) + 1,
Length(Value) - Length(sCreateNewLookAndFeelInListBegin) -
Length(sCreateNewLookAndFeelInListEnd));
CreateAndAssignNewLookAndFeel(Designer.GetComponent(AName) as TdxLayoutLookAndFeelList);
end
else
inherited SetValue(Value);
end;
{ TdxLayoutItemSelectionEditor }
procedure TdxLayoutItemSelectionEditor.RequiresUnits(Proc: TGetStrProc);
var
I: Integer;
AComponent: TComponent;
AItem: TdxLayoutItemAccess;
begin
for I := 0 to Designer.Root.ComponentCount - 1 do
begin
AComponent := Designer.Root.Components[I];
if AComponent is TdxLayoutItem then
begin
AItem := TdxLayoutItemAccess(AComponent);
if AItem.ControlAdapter <> nil then
Proc(dxShortStringToString(GetTypeData(PTypeInfo(AItem.ControlAdapter.ClassType.ClassInfo)).UnitName));
end;
end;
end;
procedure Register;
begin
RegisterComponentEditor(TdxLayoutControl, TdxLayoutControlEditor);
RegisterComponentEditor(TdxCustomLayoutItem, TdxLayoutControlItemsEditor);
RegisterComponentEditor(TdxLayoutLookAndFeelList, TdxLayoutLookAndFeelListEditor);
RegisterPropertyEditor(TypeInfo(TColor), TdxCustomLayoutLookAndFeelOptions, '',
TdxLayoutColorProperty);
RegisterPropertyEditor(TypeInfo(TColor), TdxLayoutLookAndFeelCaptionOptions, '',
TdxLayoutColorProperty);
RegisterPropertyEditor(TypeInfo(TdxCustomLayoutLookAndFeel), nil, '',
TdxLayoutLookAndFeelProperty);
RegisterPropertyEditor(TypeInfo(string), TdxLayoutControl, 'RegistryPath',
TdxLayoutRegistryPathProperty);
RegisterSelectionEditor(TdxLayoutItem, TdxLayoutItemSelectionEditor);
HideClassProperties(TdxLayoutControl, ['AutoContentSizes', 'LookAndFeel',
'CustomizeFormTabbedView', 'HighlightRoot', 'ShowDesignSelectors',
'IniFileName', 'RegistryPath', 'StoreInIniFile', 'StoreInRegistry']);
HideClassProperties(TdxCustomLayoutItem, ['AutoAligns', 'LookAndFeel']);
HideClassProperties(TdxLayoutGroup, ['LookAndFeelException']);
RegisterNoIcon([TdxLayoutItem, TdxLayoutGroup, TdxLayoutAlignmentConstraint,
TdxLayoutStandardLookAndFeel, TdxLayoutOfficeLookAndFeel, TdxLayoutWebLookAndFeel]);
RegisterComponents('ExpressLayoutControl', [TdxLayoutControl, TdxLayoutLookAndFeelList]);
end;
type
{ TdxLayoutDesignTimeHelper }
TdxLayoutDesignTimeHelper = class(TInterfacedObject, IdxLayoutDesignTimeHelper)
protected
//IdxLayoutDesignTimeHelper
function IsToolSelected: Boolean;
end;
{ TdxLayoutDesignTimeHelper }
function TdxLayoutDesignTimeHelper.IsToolSelected: Boolean;
begin
Result := {$IFDEF DELPHI9}(ActiveDesigner <> nil) and{$ENDIF}
ActiveDesigner.Environment.GetToolSelected;
end;
initialization
dxLayoutSelectionHelperClass := TdxLayoutDesignTimeSelectionHelper;
dxLayoutDesignTimeHelper := TdxLayoutDesignTimeHelper.Create;
finalization
dxLayoutDesignTimeHelper := nil;
FreeAndNil(FDesignCustomizationHelper);
end.