{*******************************************************************} { } { ExpressWeb Framework by Developer Express } { Basic interface implementation by Developer Express } { } { Copyright (c) 2000-2007 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 EXPRESSWEB FRAMEWORK AND ALL } { ACCOMPANYING VCL CLASSES AS PART OF AN EXECUTABLE WEB } { APPLICATION 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 cxWebIntfImpl; interface {$I cxVer.inc} uses Classes, SysUtils, {$IFDEF VCL} Windows, {$ELSE} Types, {$ENDIF} cxWebIntf; type TcxCustomWebContainerControlHelper = class(TObject) private FOwner: TComponent; FTabOrders: TList; FControlContainers: IInterfaceList; FControls: IInterfaceList; FUpdateControlsPositionLock: Boolean; FControlLayout: TcxWebControlLayout; procedure InsertWebControl(AControl: IcxWebControl); procedure InsertContainerControl(AControl: IcxWebContainerControl); procedure RemoveWebControl(AControl: IcxWebControl); procedure RemoveContainerControl(AControl: IcxWebContainerControl); procedure ClearControls; protected {IcxWebContainerControl} function GetControl(Index: Integer): IcxWebControl; function GetControlContainer(Index: Integer): IcxWebContainerControl; function GetControlContainerCount: Integer; function GetControlCount: Integer; function GetParent: IcxWebContainerControl; function GetClientLeft: Integer; virtual; function GetClientTop: Integer; virtual; function CanAcceptsControls: Boolean; virtual; function ContainsControl(const AControl: IcxWebControl): Boolean; function IndexOf(const AControl: IcxWebControl): Integer; procedure InsertControl(const AControl: IInterface); procedure RemoveControl(const AControl: IInterface); function GetLineTabOrder(const AControl: IcxWebControl; var AFounded: Boolean): Integer; procedure GetTabOrderList(const AList: TList); procedure SetTabOrderList(const AList: TList); function TabOrderOf(const AControl: IcxWebControl): Integer; procedure UpdateTabOrder(ACurIndex, ANewIndex: TcxWebTabOrder); procedure UpdateControlsPosition; function GetControlLayout: TcxWebControlLayout; procedure SetControlLayout(Value: TcxWebControlLayout); function WebPageModule: IcxWebPageModule; property Owner: TComponent read FOwner; public constructor Create(AOwner: TComponent); virtual; destructor Destroy; override; procedure FixupTabList; property ControlContainerCount: Integer read GetControlContainerCount; property ControlContainers[Index: Integer]: IcxWebContainerControl read GetControlContainer; property ControlCount: Integer read GetControlCount; property Controls[Index: Integer]: IcxWebControl read GetControl; property Parent: IcxWebContainerControl read GetParent; end; { helpers } function IsWebTabOrderable(const AControl: TObject): Boolean; overload; function IsWebTabOrderable(const AControl: IInterface): Boolean; overload; implementation uses cxWebUtils, cxWebUpdateControlPosition, cxWebRender; { Helpers } function IsWebTabOrderable(const AControl: TObject): Boolean; begin Result := (AControl <> nil) and Supports(AControl, IcxWebTabOrderable) and Supports(AControl, IcxWebControl); end; function IsWebTabOrderable(const AControl: IInterface): Boolean; begin Result := (AControl <> nil) and Supports(AControl, IcxWebTabOrderable) and Supports(AControl, IcxWebControl); end; { TcxCustomWebContainerControlHelper } constructor TcxCustomWebContainerControlHelper.Create(AOwner: TComponent); begin FOwner := AOwner; FTabOrders := TList.Create; FControlContainers := TInterfaceList.Create; FControls := TInterfaceList.Create; FUpdateControlsPositionLock := False; FControlLayout := wclInheritable; end; destructor TcxCustomWebContainerControlHelper.Destroy; begin ClearControls; FTabOrders.Free; inherited Destroy; end; function TabOrderCompare(Item1, Item2: Pointer): Integer; var ATabOrder1, ATabOrder2: IcxWebControl; begin if Supports(TComponent(Item1), IcxWebControl, ATabOrder1) and Supports(TComponent(Item2), IcxWebControl, ATabOrder2) then Result := ATabOrder1.GetInternalTabOrder - ATabOrder2.GetInternalTabOrder else Result := 0; end; procedure TcxCustomWebContainerControlHelper.FixupTabList; begin FTabOrders.Sort(TabOrderCompare); end; procedure TcxCustomWebContainerControlHelper.InsertWebControl(AControl: IcxWebControl); var AOwnerContainer: IcxWebContainerControl; begin FControls.Add(AControl); if IsWebTabOrderable(AControl) then FTabOrders.Add(GetComponentByInterface(AControl)); if Supports(FOwner, IcxWebContainerControl, AOwnerContainer) then AControl.InternalSetParent(AOwnerContainer); end; procedure TcxCustomWebContainerControlHelper.InsertContainerControl(AControl: IcxWebContainerControl); begin FControlContainers.Add(AControl); end; procedure TcxCustomWebContainerControlHelper.RemoveWebControl(AControl: IcxWebControl); begin AControl.InternalSetParent(nil); FControls.Remove(AControl); if IsWebTabOrderable(AControl) then FTabOrders.Remove(GetComponentByInterface(AControl)); end; procedure TcxCustomWebContainerControlHelper.RemoveContainerControl(AControl: IcxWebContainerControl); begin FControlContainers.Remove(AControl); end; procedure TcxCustomWebContainerControlHelper.ClearControls; var AComponent: TComponent; AWebControl: IcxWebControl; begin while ControlCount > 0 do begin AWebControl := Controls[0]; AComponent := GetComponentByInterface(AWebControl); AWebControl := nil; AComponent.Free; end; end; function TcxCustomWebContainerControlHelper.GetControl(Index: Integer): IcxWebControl; begin Result :=IcxWebControl(FControls[Index]); end; function TcxCustomWebContainerControlHelper.GetControlContainer(Index: Integer): IcxWebContainerControl; begin Result := IcxWebContainerControl(FControls[Index]); end; function TcxCustomWebContainerControlHelper.GetControlContainerCount: Integer; begin Result := FControlContainers.Count; end; function TcxCustomWebContainerControlHelper.GetControlCount: Integer; begin if FControls <> nil then Result := FControls.Count else Result := 0; end; function TcxCustomWebContainerControlHelper.GetParent: IcxWebContainerControl; var AWebControl: IcxWebControl; begin if Supports(FOwner, IcxWebControl, AWebControl) then Result := AWebControl.Parent else Result := nil; end; function TcxCustomWebContainerControlHelper.GetClientLeft: Integer; begin Result := 0; end; function TcxCustomWebContainerControlHelper.GetClientTop: Integer; begin Result := 0; end; function TcxCustomWebContainerControlHelper.CanAcceptsControls: Boolean; begin Result := True; end; function TcxCustomWebContainerControlHelper.ContainsControl(const AControl: IcxWebControl): Boolean; var AContainer: IcxWebContainerControl; begin AContainer := AControl.Parent; while AContainer <> nil do begin if Supports(AContainer, IcxWebPageModule, Result) then break; AContainer := AContainer.Parent; end; AContainer := AControl.Parent; while (AContainer <> nil) and (AContainer.IndexOf(AControl) = -1) do AContainer := AContainer.Parent; Result := AContainer <> nil; end; function TcxCustomWebContainerControlHelper.IndexOf(const AControl: IcxWebControl): Integer; begin Result := FControls.IndexOf(AControl); end; procedure TcxCustomWebContainerControlHelper.InsertControl(const AControl: IInterface); var AWebControl: IcxWebControl; AContainerControl: IcxWebContainerControl; begin if Supports(AControl, IcxWebControl, AWebControl) and (IndexOf(AWebControl) = -1) then InsertWebControl(AWebControl); if Supports(AControl, IcxWebContainerControl, AContainerControl) and (FControlContainers.IndexOf(AContainerControl) = -1) then InsertContainerControl(AContainerControl); end; procedure TcxCustomWebContainerControlHelper.RemoveControl(const AControl: IInterface); var AWebControl: IcxWebControl; AContainerControl: IcxWebContainerControl; begin if Supports(AControl, IcxWebControl, AWebControl) and (IndexOf(AWebControl) > -1) then RemoveWebControl(AWebControl); if Supports(AControl, IcxWebContainerControl, AContainerControl) and (FControlContainers.IndexOf(AContainerControl) > -1) then RemoveContainerControl(AContainerControl); end; function TcxCustomWebContainerControlHelper.GetLineTabOrder(const AControl: IcxWebControl; var AFounded: Boolean): Integer; var I: Integer; AParent: IcxWebContainerControl; ATabItem: IcxWebControl; begin AFounded := False; Result := 0; for I := 0 to FTabOrders.Count - 1 do begin if not Supports(TComponent(FTabOrders.Items[I]), IcxWebControl, ATabItem) then continue; if Supports(ATabItem, IcxWebContainerControl, AParent) and (Pointer(AControl) <> Pointer(ATabItem)) then begin Result := Result + AParent.GetLineTabOrder(AControl, AFounded); if AFounded then begin Inc(Result); break; end; end else if Pointer(AControl) = Pointer(ATabItem) then begin AFounded := True; break; end; Inc(Result); end; end; procedure TcxCustomWebContainerControlHelper.GetTabOrderList(const AList: TList); begin AList.Count := FTabOrders.Count; Move(FTabOrders.List^, AList.List^, SizeOf(Pointer) * FTabOrders.Count); end; procedure TcxCustomWebContainerControlHelper.SetTabOrderList(const AList: TList); begin if AList = nil then Exit; FTabOrders.Count := AList.Count; Move(AList.List^, FTabOrders.List^, SizeOf(Pointer) * AList.Count); end; function TcxCustomWebContainerControlHelper.TabOrderOf(const AControl: IcxWebControl): Integer; begin Result := FTabOrders.IndexOf(GetComponentByInterface(AControl)); end; procedure TcxCustomWebContainerControlHelper.UpdateTabOrder(ACurIndex, ANewIndex: TcxWebTabOrder); begin if ANewIndex < 0 then ANewIndex := 0; if ANewIndex > ControlCount - 1 then ANewIndex := ControlCount - 1; if ACurIndex <> ANewIndex then FTabOrders.Move(ACurIndex, ANewIndex); end; type TcxWebUpdateControlPositionItem = class(TcxCustomWebUpdateControlPositionItem) private FWebControl: IcxWebControl; protected function GetBoundsRect: TRect; override; procedure SetBoundsRect(const Value: TRect); override; public constructor Create(AWebControl: IcxWebControl); property WebControl: IcxWebControl read FWebControl; end; { TcxWebUpdateControlPositionItem } constructor TcxWebUpdateControlPositionItem.Create(AWebControl: IcxWebControl); begin FWebControl := AWebControl; end; function TcxWebUpdateControlPositionItem.GetBoundsRect: TRect; begin Result := WebControl.BoundsRect; end; procedure TcxWebUpdateControlPositionItem.SetBoundsRect(const Value: TRect); begin WebControl.BoundsRect := Value; end; function TcxCustomWebContainerControlHelper.WebPageModule: IcxWebPageModule; var AParent: IcxWebContainerControl; begin Result := nil; if not Owner.GetInterface(IcxWebContainerControl, AParent) then exit; while (AParent <> nil) and not Supports(AParent, IcxWebPageModule, Result) do AParent := AParent.Parent; end; procedure TcxCustomWebContainerControlHelper.UpdateControlsPosition; var AList: TList; I: Integer; AWebPageModule: IcxWebPageModule; begin AWebPageModule := WebPageModule; if (AWebPageModule = nil) or (AWebPageModule.GetPositioningType <> cxptGrid) then exit; AList := TList.Create; for I := 0 to ControlCount - 1 do AList.Add(TcxWebUpdateControlPositionItem.Create(Controls[I])); UpdateWebControlsPosition(AList); for I := 0 to ControlCount - 1 do TcxWebUpdateControlPositionItem(AList[I]).Free; AList.Free; end; function TcxCustomWebContainerControlHelper.GetControlLayout: TcxWebControlLayout; var APageModule: IcxWebPageModule; AParent: IcxWebContainerControl; begin if Supports(Owner, IcxWebPageModule, APageModule) then Result := TcxWebControlLayout(APageModule.GetPositioningType) else begin Result := FControlLayout; if (Result = wclInheritable) and Supports(Owner, IcxWebContainerControl, AParent) then begin AParent := AParent.Parent; while (AParent <> nil) do begin Result := AParent.ControlLayout; if (Result <> wclInheritable) then break else AParent := AParent.Parent; end; end; end; end; procedure TcxCustomWebContainerControlHelper.SetControlLayout(Value: TcxWebControlLayout); begin FControlLayout := Value; end; end.