Archivado/Componentes.Terceros.DevExpressVCL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
f040ff20cd
Componentes.Terceros.DevExp.../official/x.30/ExpressWeb Framework/Sources/cxWebClasses.pas
david 08e42642b8 Importacion inicial. 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@21 05c56307-c608-d34a-929d-697000501d7a
2007-12-16 17:06:54 +00:00

3062 lines
84 KiB
ObjectPascal
Raw Blame History

{*******************************************************************}
{ }
{ ExpressWeb Framework by Developer Express }
{ Web Components Library }
{ }
{ 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 cxWebClasses;
interface
{$I cxVer.inc}
uses TypInfo, Classes, Contnrs, HTTPProd,
{$IFDEF VCL}
Windows,
{$ENDIF}
cxWebRender, cxWebTypes, cxWebColors, cxWebGraphics, cxWebIntf;
const
cxclDefaultStyleBorderColor = clWebWindowText;
cxclDefaultStyleBkColor = clWebWindow;
type
TcxWebStyles = class;
TcxWebStyleItem = class;
IcxWebStyleChanged = interface
['{F9E6795C-C928-4787-9B43-ED6B23AFA7AE}']
procedure StyleChanged(Style: TcxWebStyleItem);
end;
IcxWebGetStyles = interface
['{E4A787C5-60CA-4C60-AD99-C99FAA670DD9}']
function GetStyles: TcxWebStyles;
end;
TcxWebHelper = class(TObject)
private
FComponent: TComponent;
public
constructor Create(AComponent: TComponent); virtual;
property Component: TComponent read FComponent;
end;
TcxWebActionsHelper = class(TcxWebHelper)
private
FActions: TStrings;
protected
{ IcxWebActions }
procedure DoPerformAction(const ActionName: string; const ActionParameters: TcxActionParameters);
public
constructor Create(AComponent: TComponent); override;
destructor Destroy; override;
procedure ClearActions;
procedure RegisterAction(const ActionName: string; const Action: TcxWebComponentActionProc);
end;
TcxCustomEventItem = class(TCollectionItem)
private
FEventProcType: TcxWebComponentEventProcType;
FEventType: Integer;
FHandlerText: TStrings;
procedure SetHandlerText(Value: TStrings);
protected
function GetDisplayName: string; override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property EventProcType: TcxWebComponentEventProcType read FEventProcType write FEventProcType;
property EventType: Integer read FEventType write FEventType;
property HandlerText: TStrings read FHandlerText write SetHandlerText;
end;
TcxWebEventsHelper = class;
TcxCustomEvents = class(TCollection)
private
FEventsHelper: TcxWebEventsHelper;
function GetItem(Index: Integer): TcxCustomEventItem;
procedure SetItem(Index: Integer; Value: TcxCustomEventItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AEventsHelper: TcxWebEventsHelper);
function Add: TcxCustomEventItem;
property EventsHelper: TcxWebEventsHelper read FEventsHelper;
property Items[Index: Integer]: TcxCustomEventItem read GetItem write SetItem; default;
end;
TcxWebEventsHelper = class(TcxWebHelper)
private
FCustomEvents: TcxCustomEvents;
FEvents: TcxCustomEvents;
procedure FindEvents(const AEvent: Integer; AList: TList);
protected
procedure ClearEvents;
procedure WriteEvent(AHTMLTextBuilder: TcxHTMLTextBuilder; AList: TList); virtual;
procedure WriteEventScript(AHTMLTextBuilder: TcxHTMLTextBuilder; AList: TList); virtual;
procedure WriteEvents(AHTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteEventsScript(AHTMLTextBuilder: TcxHTMLTextBuilder); virtual;
function EventName(const AEvent: Integer): string; virtual;
function EventProc(const AEvent: Integer): string; virtual;
function EventProcName(const AEvent: Integer): string; virtual;
function EventProcParams(const AEvent: Integer): string; virtual;
public
constructor Create(AComponent: TComponent); override;
destructor Destroy; override;
function EventTypeInfo: PTypeInfo; virtual;
function MaxEventValue: Integer;
function MinEventValue: Integer;
procedure RegisterEvent(const AEvent: TcxHTMLEvent;
const AEventProc: TcxWebComponentEventProc;
const AEventProcType: TcxWebComponentEventProcType);
property CustomEvents: TcxCustomEvents read FCustomEvents write FCustomEvents;
end;
TcxWebEventsHelperClass = class of TcxWebEventsHelper;
TcxWebScriptEventsHelper = class(TcxWebEventsHelper)
protected
function ScriptObject: string; virtual;
procedure WriteEvent(AHTMLTextBuilder: TcxHTMLTextBuilder; AList: TList); override;
end;
TcxWebRenderHelper = class(TcxWebHelper)
private
FRenderers: TClassList;
FOnAfterRender: TNotifyEvent;
FOnBeforeRender: TNotifyEvent;
function GetRenderer(AHTMLTextBuilder: TcxHTMLTextBuilder): TcxWebRenderer;
procedure ClearEvents;
procedure RegisterEvents;
protected
procedure DoAfterRender; dynamic;
procedure DoBeforeRender; dynamic;
{ IcxCodeProvider }
function GetRendererClass(Browser: TcxWebBrowserClass): TcxWebRendererClass; virtual;
procedure GetScriptFiles(HTMLTextBuilder: TcxHTMLTextBuilder; AList: TStrings); virtual;
procedure WriteClassScripts(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteBeginHTML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteClassHTML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteHiddenFormElements(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteEndHTML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteClassOutOfFormHTML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteOutOfFormHTML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteScripts(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteStyles(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
procedure WriteXML(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
public
constructor Create(AComponent: TComponent); override;
destructor Destroy; override;
procedure RegisterRenderer(ARendererClass: TcxWebRendererClass);
procedure ClearRenderers; virtual;
property OnAfterRender: TNotifyEvent read FOnAfterRender write FOnAfterRender;
property OnBeforeRender: TNotifyEvent read FOnBeforeRender write FOnBeforeRender;
end;
TcxWebScriptsHelper = class(TcxWebHelper)
private
FScripts: TClassList;
public
constructor Create(AComponent: TComponent); override;
destructor Destroy; override;
procedure ScriptSubscription(const AClass: TClass);
end;
TcxWebValuesHelper = class(TcxWebHelper)
private
FValues: TStrings;
protected
{ IcxWebValues }
function GetValues: TStrings;
public
constructor Create(AComponent: TComponent); override;
destructor Destroy; override;
procedure RegisterValue(const AName: string; AValue: string);
property Values: TStrings read GetValues;
end;
{ TcxWebComponent }
TcxWebComponent = class(TComponent, IcxWebProvidersSupport,
IcxCodeProvider, IcxWebActions, IcxWebEvents,
IcxWebValues, IcxWebScripts, IcxWebStyleChanged, IcxWebGetStyles,
IcxWebComponentState, IWebVariableName)
private
FStyles: TcxWebStyles;
FWebActionsHelper: TcxWebActionsHelper;
FWebEventsHelper: TcxWebEventsHelper;
FWebRenderHelper: TcxWebRenderHelper;
FWebScriptsHelper: TcxWebScriptsHelper;
FWebValuesHelper: TcxWebValuesHelper;
FWebComponentState: TcxWebComponentStates;
FOnAfterRender: TNotifyEvent;
FOnBeforeRender: TNotifyEvent;
function GetWebRendererClass(ABrowser: TcxWebBrowserClass): TcxWebRendererClass;
function GetCustomEvents: TcxCustomEvents;
procedure SetCustomEvents(Value: TcxCustomEvents);
{ IcxWebGetStyles }
function GetStyles: TcxWebStyles;
procedure SetStyles(Value: TcxWebStyles);
function GetStyleItem_Default: TcxWebStyleItem;
function GetStyleItem_Hover: TcxWebStyleItem;
procedure SetStyleItem_Default(Value: TcxWebStyleItem);
procedure SetStyleItem_Hover(Value: TcxWebStyleItem);
procedure GetDefaultStyleProc(var AScript: string);
procedure GetHoverStyleProc(var AScript: string);
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
{ actions }
procedure DoAfterPerformActions; virtual;
procedure RegisterActions; virtual;
function GetWebActionsHelper: TcxWebActionsHelper; virtual;
property WebActionsHelper: TcxWebActionsHelper read GetWebActionsHelper implements IcxWebActions;
{ events }
procedure RegisterEvents; virtual;
function GetWebEventsHelper: TcxWebEventsHelper;
class function GetWebEventsHelperClass: TcxWebEventsHelperClass; virtual;
property WebEventsHelper: TcxWebEventsHelper read GetWebEventsHelper implements IcxWebEvents;
{ rendering }
procedure RegisterRenderers; virtual;
function GetWebRenderHelper: TcxWebRenderHelper; virtual;
property WebRenderHelper: TcxWebRenderHelper read GetWebRenderHelper implements IcxCodeProvider;
{ scripts }
procedure ScriptsSubscription; virtual;
function GetWebScriptsHelper: TcxWebScriptsHelper; virtual;
property WebScriptsHelper: TcxWebScriptsHelper read GetWebScriptsHelper;
{ IcxWebProvidersSupport}
procedure GetProviders(AList: TList);
procedure ImplGetProviders(AList: TList); virtual;
procedure AddStylesToProviderList(AList: TList; AStylesArray: Array of TcxWebStyles);
{IcxWebStyleChanged}
procedure StyleChanged(Style: TcxWebStyleItem); virtual;
{ values }
function CanSetValues: Boolean; virtual;
procedure DoAfterSetValues; virtual;
procedure DoSetValues; virtual;
procedure RegisterValues; virtual;
function GetWebValuesHelper: TcxWebValuesHelper; virtual;
property WebValuesHelper: TcxWebValuesHelper read GetWebValuesHelper implements IcxWebValues;
{ IWebVariableName }
function GetVariableName: string;
function ImplGetVariableName: string; virtual;
{ IcxWebComponentState }
function GetState: TcxWebComponentStates;
procedure SetState(Value: TcxWebComponentStates);
{Render helper events}
procedure DoBeforeRenderProc(Sender: TObject);
procedure DoAfterRenderProc(Sender: TObject);
procedure DoBeforeRender; dynamic;
procedure DoAfterRender; dynamic;
function IsDesigning: Boolean;
function IsDestroying: Boolean;
function IsLoading: Boolean;
property Styles: TcxWebStyles read GetStyles write SetStyles;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property WebRendererClasses[ABrowser: TcxWebBrowserClass]: TcxWebRendererClass read GetWebRendererClass;
property WebComponentState: TcxWebComponentStates read GetState write SetState;
published
property CustomEvents: TcxCustomEvents read GetCustomEvents write SetCustomEvents;
//Avoid Delphi bug with linked forms/modules
property StyleItem_Default: TcxWebStyleItem read GetStyleItem_Default write SetStyleItem_Default;
property StyleItem_Hover: TcxWebStyleItem read GetStyleItem_Hover write SetStyleItem_Hover;
property OnAfterRender: TNotifyEvent read FOnAfterRender write FOnAfterRender;
property OnBeforeRender: TNotifyEvent read FOnBeforeRender write FOnBeforeRender;
end;
TcxWebComponentClass = class of TcxWebComponent;
TcxInternalWebStyle = class
protected
class function GetName: string; virtual; abstract;
class procedure WriteStyle(HTMLTextBuilder: TcxHTMLTextBuilder); virtual; abstract;
end;
TcxWebComponentRenderer = class(TcxWebRenderer)
private
function GetWebComponent: TcxWebComponent;
protected
class function GetDefaultStyleProc(AStyle: TcxWebStyleItem): string; virtual;
class function GetHoverStyleProc(AStyle: TcxWebStyleItem): string; virtual;
procedure WriteDefaultStyle; virtual;
procedure WriteEvents; virtual;
procedure WriteEventsScript; virtual;
public
class procedure GetScriptFiles(AList: TStrings); override;
procedure WriteScripts; override;
property WebComponent: TcxWebComponent read GetWebComponent;
end;
TcxWebStandardTarget = (tBlank, tMedia, tParent, tSearch, tSelf, tTop);
TcxURL = class(TPersistent)
private
FHref: string;
FOwner: TComponent;
FTarget: string;
procedure SetHref(Value: string);
procedure SetTarget(Value: string);
protected
procedure UpdateOwner;
property Owner: TComponent read FOwner;
public
constructor Create(AOwner: TComponent);
procedure Assign(Source: TPersistent); override;
procedure Write(AHTMLTextBuilder: TcxHTMLTextBuilder); virtual;
published
property Href: string read FHref write SetHref;
property Target: string read FTarget write SetTarget;
end;
TBasecxWebStyle = class;
TcxWebStyleObject = class(TPersistent)
private
FWebStyle: TBasecxWebStyle;
protected
function CanAssignValue: Boolean;
procedure Changed; dynamic;
procedure DoRestoreDefaults; dynamic;
public
constructor Create(AWebStyle: TBasecxWebStyle); virtual;
procedure BeginUpdate;
procedure EndUpdate;
procedure RestoreDefaults;
property WebStyle: TBasecxWebStyle read FWebStyle;
end;
TcxWebBorderStyle =
(wbsNone, wbsSolid, wbsDotted, wbsDashed, wbsDouble, wbsGroove, wbsRidge, wbsInset, wbsOutset);
TcxWebBorderAssignedValue = (wbavColor, wbavStyle, wbavWidth);
TcxWebBorderAssignedValues = set of TcxWebBorderAssignedValue;
TcxWebBorderWidth = 0..32767;
{$NODEFINE TcxWebBorderWidth}
(*$HPPEMIT 'namespace cxWebClasses'}*)
(*$HPPEMIT '{'}*)
(*$HPPEMIT '#pragma option -b-'*)
(*$HPPEMIT ' enum TcxWebBorderWidth {bwMin=0, bwMax=32767};'}*)
(*$HPPEMIT '#pragma option -b.'*)
(*$HPPEMIT '}'*)
TcxWebBorders = class;
TcxWebBorder = class(TPersistent)
private
FAssignedValues: TcxWebBorderAssignedValues;
FBorders: TcxWebBorders;
FColor: TcxWebColor;
FStyle: TcxWebBorderStyle;
FWidth: TcxWebBorderWidth;
function IsColorStored: Boolean;
function IsStyleStored: Boolean;
function IsWidthStored: Boolean;
procedure SetAssignedValues(Value: TcxWebBorderAssignedValues);
procedure SetColor(Value: TcxWebColor);
procedure SetStyle(Value: TcxWebBorderStyle);
procedure SetWidth(Value: TcxWebBorderWidth);
protected
procedure Changed; dynamic;
public
constructor Create(ABorders: TcxWebBorders);
procedure Assign(Source: TPersistent); override;
procedure Merge(Source: TcxWebBorder); virtual;
procedure RestoreDefaults;
property Borders: TcxWebBorders read FBorders;
published
property Color: TcxWebColor read FColor write SetColor stored IsColorStored default cxclDefaultStyleBorderColor;
property Style: TcxWebBorderStyle read FStyle write SetStyle stored IsStyleStored default wbsNone;
property Width: TcxWebBorderWidth read FWidth write SetWidth stored IsWidthStored default 2;
// must be last
property AssignedValues: TcxWebBorderAssignedValues read FAssignedValues write SetAssignedValues default [];
end;
TcxWebBorders = class(TcxWebStyleObject)
private
FBottom: TcxWebBorder;
FLeft: TcxWebBorder;
FRight: TcxWebBorder;
FTop: TcxWebBorder;
function GetColor: TcxWebColor;
function GetStyle: TcxWebBorderStyle;
function GetWidth: TcxWebBorderWidth;
function IsColorStored: Boolean;
function IsStyleStored: Boolean;
function IsWidthStored: Boolean;
procedure SetBottom(Value: TcxWebBorder);
procedure SetColor(Value: TcxWebColor);
procedure SetLeft(Value: TcxWebBorder);
procedure SetRight(Value: TcxWebBorder);
procedure SetStyle(Value: TcxWebBorderStyle);
procedure SetTop(Value: TcxWebBorder);
procedure SetWidth(Value: TcxWebBorderWidth);
protected
procedure DoRestoreDefaults; override;
public
constructor Create(AWebStyle: TBasecxWebStyle); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Merge(Source: TcxWebBorders); virtual;
function SameColors: Boolean;
function SameStyles: Boolean;
function SameWidths: Boolean;
function HorzBordersSize: Integer;
function VertBordersSize: Integer;
procedure WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
published
property Bottom: TcxWebBorder read FBottom write SetBottom;
property Color: TcxWebColor read GetColor write SetColor stored IsColorStored;
property Left: TcxWebBorder read FLeft write SetLeft;
property Style: TcxWebBorderStyle read GetStyle write SetStyle stored IsStyleStored;
property Right: TcxWebBorder read FRight write SetRight;
property Top: TcxWebBorder read FTop write SetTop;
property Width: TcxWebBorderWidth read GetWidth write SetWidth stored IsWidthStored;
end;
TcxWebShadingAssignedValue = (wsavColor);
TcxWebShadingAssignedValues = set of TcxWebShadingAssignedValue;
TcxWebShading = class(TcxWebStyleObject)
private
FAssignedValues: TcxWebShadingAssignedValues;
FColor: TcxWebColor;
procedure SetAssignedValues(Value: TcxWebShadingAssignedValues);
procedure SetColor(Value: TcxWebColor);
protected
procedure DoRestoreDefaults; override;
public
procedure Assign(Source: TPersistent); override;
procedure Merge(Source: TcxWebShading); virtual;
procedure WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
published
property Color: TcxWebColor read FColor write SetColor default cxclDefaultStyleBkColor;
// must be last
property AssignedValues: TcxWebShadingAssignedValues read FAssignedValues write SetAssignedValues default [];
end;
TcxWebNumberingPosition = (wnpInside, wnpOutside);
TcxWebNumberingStyle = (wnsNone, wnsCircle, wnsDisc, wnsSquare, wnsDecimal,
wnsUpperRoman, wnsUpperAlpha, wnsLowerAlpha, wnsLowerRoman, wnsPicture);
TcxWebNumberingAssignedValue = (wnavPosition, wnavStyle);
TcxWebNumberingAssignedValues = set of TcxWebNumberingAssignedValue;
TcxWebNumbering = class(TcxWebStyleObject)
private
FAssignedValues: TcxWebNumberingAssignedValues;
FPicture: string;
FPosition: TcxWebNumberingPosition;
FStyle: TcxWebNumberingStyle;
procedure SetAssignedValues(Value: TcxWebNumberingAssignedValues);
procedure SetPicture(const Value: string);
procedure SetPosition(Value: TcxWebNumberingPosition);
procedure SetStyle(Value: TcxWebNumberingStyle);
protected
procedure DoRestoreDefaults; override;
public
procedure Assign(Source: TPersistent); override;
procedure Merge(Source: TcxWebNumbering); virtual;
procedure WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
published
property Picture: string read FPicture write SetPicture;
property Position: TcxWebNumberingPosition read FPosition write SetPosition default wnpOutside;
property Style: TcxWebNumberingStyle read FStyle write SetStyle default wnsNone;
// must be last
property AssignedValues: TcxWebNumberingAssignedValues read FAssignedValues write SetAssignedValues default [];
end;
TcxWebStyleClass = class of TBasecxWebStyle;
TBasecxWebStyle = class(TPersistent)
private
FBorders: TcxWebBorders;
FFont: TcxWebFont;
FNumbering: TcxWebNumbering;
FShading: TcxWebShading;
FUpdateCount: Integer;
procedure SetBorders(Value: TcxWebBorders);
procedure SetFont(Value: TcxWebFont);
procedure SetNumbering(Value: TcxWebNumbering);
procedure SetShading(Value: TcxWebShading);
procedure FontChanged(Sender: TObject);
protected
procedure Changed;
procedure DoChanged; dynamic;
procedure DoRestoreDefaults; dynamic;
property UpdateCount: Integer read FUpdateCount;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Merge(Source: TBasecxWebStyle); virtual;
procedure BeginUpdate;
procedure EndUpdate;
procedure RestoreDefaults;
procedure WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
published
property Borders: TcxWebBorders read FBorders write SetBorders;
property Font: TcxWebFont read FFont write SetFont;
property Numbering: TcxWebNumbering read FNumbering write SetNumbering;
property Shading: TcxWebShading read FShading write SetShading;
end;
TcxWebStyle = class(TBasecxWebStyle)
private
FStyleItem: TcxWebStyleItem;
protected
function GetOwner: TPersistent; override;
procedure DoChanged; override;
public
constructor Create(AStyleItem: TcxWebStyleItem);
property StyleItem: TcxWebStyleItem read FStyleItem;
end;
TcxWebStyleController = class;
TcxWebStyleItem = class(TComponent, IWebVariableName)
private
FClients: TList;
FController: TcxWebStyleController;
FCSSClassName: string;
FCustomHTML: TStrings;
FStyle: TcxWebStyle;
function GetClient(Index: Integer): IcxWebStyleChanged;
function GetClientCount: Integer;
function GetIndex: Integer;
procedure SetController(Value: TcxWebStyleController);
procedure SetCustomHTML(Value: TStrings);
procedure SetIndex(Value: Integer);
procedure SetStyle(Value: TcxWebStyle);
function IsClient(AComponent: IcxWebStyleChanged): Boolean;
procedure UpdateDesigner;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ReadState(Reader: TReader); override;
procedure SetName(const NewName: TComponentName); override;
procedure SetParentComponent(AParent: TComponent); override;
{ IWebVariableName }
function GetVariableName: string;
function ImplGetVariableName: string; virtual;
function GetFullName: string; virtual;
procedure DesignerUpdate(TheAll: Boolean);
procedure Changed;
property Clients[Index: Integer]: IcxWebStyleChanged read GetClient;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function GetParentComponent: TComponent; override;
function HasParent: Boolean; override;
procedure RegisterClient(AComponent: IcxWebStyleChanged);
procedure UnregisterClient(AComponent: IcxWebStyleChanged);
procedure WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
property ClientCount: Integer read GetClientCount;
property Controller: TcxWebStyleController read FController write SetController;
property FullName: string read GetFullName;
published
property CSSClassName: string read FCSSClassName write FCSSClassName;
property CustomHTML: TStrings read FCustomHTML write SetCustomHTML;
property Index: Integer read GetIndex write SetIndex stored False;
property Style: TcxWebStyle read FStyle write SetStyle;
end;
TAbstractcxWebStyleControllerDesigner = class;
TcxWebStyleController = class(TComponent, IcxStylesProvider,
IWebVariableName)
private
FDesigner: TAbstractcxWebStyleControllerDesigner;
FItems: TList;
FCSSFileName: string;
function GetCount: Integer;
function GetItem(Index: Integer): TcxWebStyleItem;
procedure SetItem(Index: Integer; Value: TcxWebStyleItem);
procedure InsertItem(Value: TcxWebStyleItem);
procedure MoveItem(ACurIndex, ANewIndex: Integer);
procedure RemoveItem(Value: TcxWebStyleItem);
protected
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
procedure SetName(const NewName: TComponentName); override;
{ IcxStylesProvider }
procedure GetCSSFiles(HTMLTextBuilder: TcxHTMLTextBuilder; AList: TStrings);
procedure WriteStyles(HTMLTextBuilder: TcxHTMLTextBuilder); virtual;
{ IWebVariableName }
function GetVariableName: string;
function ImplGetVariableName: string; virtual;
procedure DesignerModified;
procedure DesignerUpdate(AItem: TcxWebStyleItem);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Add: TcxWebStyleItem;
procedure AssignItems(ASource: TcxWebStyleController);
procedure Clear;
procedure Delete(AIndex: Integer);
procedure GetStyleList(const AList: TList);
function IndexOf(AItem: TcxWebStyleItem): Integer;
function ItemByName(const AName: string): TcxWebStyleItem;
property Count: Integer read GetCount;
property Designer: TAbstractcxWebStyleControllerDesigner read FDesigner;
property Items[Index: Integer]: TcxWebStyleItem read GetItem write SetItem; default;
published
property CSSFileName: string read FCSSFileName write FCSSFileName;
end;
//TODO: visited style
TcxWebStyles = class(TPersistent)
private
FOwner: TComponent;
FDefault: TcxWebStyleItem;
FHover: TcxWebStyleItem;
//FVisited: TcxWebStyleItem;
procedure UpdateDesigner;
procedure SetDefault(Value: TcxWebStyleItem);
procedure SetHover(Value: TcxWebStyleItem);
//procedure SetVisited(Value: TcxWebStyleItem);
protected
function GetItem(Index: Integer): TcxWebStyleItem; virtual;
function GetOwner: TPersistent; override;
function StyleChanged: IcxWebStyleChanged;
public
constructor Create(AOwner: TComponent);
procedure Assign(Source: TPersistent); override;
procedure Notification(AComponent: TComponent; AOperation: TOperation); virtual;
function ItemCount: Integer; virtual;
property Component: TComponent read FOwner;
property Items[Index: Integer]: TcxWebStyleItem read GetItem;
published
property Default: TcxWebStyleItem read FDefault write SetDefault;
property Hover: TcxWebStyleItem read FHover write SetHover;
//property Visited: TcxWebStyleItem read FVisited write SetVisited;
end;
TAbstractcxWebStyleControllerDesigner = class
private
FController: TcxWebStyleController;
protected
procedure Modified; virtual; abstract;
procedure Update(AItem: TcxWebStyleItem); virtual; abstract;
public
constructor Create(AController: TcxWebStyleController);
destructor Destroy; override;
procedure BeginUpdate; virtual; abstract;
procedure CancelUpdate; virtual; abstract;
procedure EndUpdate; virtual; abstract;
property Controller: TcxWebStyleController read FController;
end;
const
bwThin = TcxWebBorderWidth(2);
bwMedium = TcxWebBorderWidth(4);
bwThick = TcxWebBorderWidth(6);
function cxWebWidthToString(Width: TcxWebBorderWidth): string;
function cxWebWidthToCursor(const S: string): TcxWebBorderWidth;
procedure cxWebGetWidthValues(Proc: TGetStrProc);
function cxWebWidthToIdent(Width: Longint; var Ident: string): Boolean;
function cxWebIdentToWidth(const Ident: string; var Width: Longint): Boolean;
function IsAnyBorderColorAssigned(ASyleItem: TcxWebStyleItem): Boolean;
function IsAnyBorderWidthAssigned(ASyleItem: TcxWebStyleItem): Boolean;
function IsAnyBorderStyleAssigned(ASyleItem: TcxWebStyleItem): Boolean;
implementation
uses
SysUtils,
cxWebScriptFactory, cxWebModule, cxWebConsts, cxWebUtils;
const
scxLeft = 'left';
scxTop = 'top';
scxRight = 'right';
scxBottom = 'bottom';
scxBackgroundColor = 'background-color:';
scxWebBorderStyles: array[TcxWebBorderStyle] of string =
('none', 'solid', 'dotted', 'dashed', 'double', 'groove', 'ridge', 'inset', 'outset');
cxWebBorderWidths: array[0..2] of TIdentMapEntry = (
(Value: bwThin; Name: 'thin'),
(Value: bwMedium; Name: 'medium'),
(Value: bwThick; Name: 'thick'));
cxWebNumberingStyles: array[TcxWebNumberingStyle] of string =
('none', 'circle', 'disc', 'square', 'decimal', 'upper-roman', 'upper-alpha',
'lower-alpha', 'lower-roman', '');
cxWebNumberingPositions: array[TcxWebNumberingPosition] of string =
('inside', 'outside');
type
PcxWebBrowserRecord = ^TcxWebBrowserRecord;
TcxWebBrowserRecord = record
Browser: TcxWebBrowserClass;
RenderProc: TcxWebRenderProc;
end;
function cxWebWidthToString(Width: TcxWebBorderWidth): string;
begin
if not cxWebWidthToIdent(Width, Result) then
FmtStr(Result, '%d', [Width]);
end;
function cxWebWidthToCursor(const S: string): TcxWebBorderWidth;
var
L: Longint;
begin
if not cxWebIdentToWidth(S, L) then
L := StrToInt(S);
Result := L;
end;
procedure cxWebGetWidthValues(Proc: TGetStrProc);
var
I: Integer;
begin
for I := Low(cxWebBorderWidths) to High(cxWebBorderWidths) do
Proc(cxWebBorderWidths[I].Name);
end;
function cxWebWidthToIdent(Width: Longint; var Ident: string): Boolean;
begin
Result := IntToIdent(Width, Ident, cxWebBorderWidths);
end;
function cxWebIdentToWidth(const Ident: string; var Width: Longint): Boolean;
begin
Result := IdentToInt(Ident, Width, cxWebBorderWidths);
end;
function IsAnyBorderStyleAssigned(ASyleItem: TcxWebStyleItem): Boolean;
begin
if (ASyleItem <> nil) and not (csDestroying in ASyleItem.ComponentState) then
Result := (wbavStyle in ASyleItem.Style.Borders.Left.AssignedValues) or
((wbavStyle in ASyleItem.Style.Borders.Top.AssignedValues)) or
((wbavStyle in ASyleItem.Style.Borders.Right.AssignedValues)) or
((wbavStyle in ASyleItem.Style.Borders.Bottom.AssignedValues))
else
Result := False;
end;
function IsAnyBorderWidthAssigned(ASyleItem: TcxWebStyleItem): Boolean;
begin
if (ASyleItem <> nil) and not (csDestroying in ASyleItem.ComponentState) then
Result := (wbavWidth in ASyleItem.Style.Borders.Left.AssignedValues) or
((wbavWidth in ASyleItem.Style.Borders.Top.AssignedValues)) or
((wbavWidth in ASyleItem.Style.Borders.Right.AssignedValues)) or
((wbavWidth in ASyleItem.Style.Borders.Bottom.AssignedValues))
else
Result := False;
end;
function IsAnyBorderColorAssigned(ASyleItem: TcxWebStyleItem): Boolean;
begin
if ASyleItem <> nil then
Result := (wbavColor in ASyleItem.Style.Borders.Left.AssignedValues) or
((wbavColor in ASyleItem.Style.Borders.Top.AssignedValues)) or
((wbavColor in ASyleItem.Style.Borders.Right.AssignedValues)) or
((wbavColor in ASyleItem.Style.Borders.Bottom.AssignedValues))
else
Result := False;
end;
type
TPersistentAccess = class(TPersistent);
TComponentAccess = class(TComponent);
{ TcxWebHelper }
constructor TcxWebHelper.Create(AComponent: TComponent);
begin
FComponent := AComponent;
end;
{ TcxWebActionsHelper }
type
PMethod = ^TMethod;
constructor TcxWebActionsHelper.Create(AComponent: TComponent);
begin
inherited;
FActions := TStringList.Create;
end;
destructor TcxWebActionsHelper.Destroy;
begin
FActions.Free;
inherited;
end;
procedure TcxWebActionsHelper.ClearActions;
var
I: Integer;
begin
for I := 0 to FActions.Count - 1 do
Dispose(PMethod(FActions.Objects[I]));
FActions.Clear;
end;
procedure TcxWebActionsHelper.RegisterAction(const ActionName: string; const Action: TcxWebComponentActionProc);
var
Method: PMethod;
begin
New(Method);
Method^ := TMethod(Action);
FActions.AddObject(ActionName, TObject(Method));
end;
procedure TcxWebActionsHelper.DoPerformAction(const ActionName: string; const ActionParameters: TcxActionParameters);
var
Index: Integer;
Method: TcxWebComponentActionProc;
begin
Index := FActions.IndexOf(ActionName);
if Index <> -1 then
begin
TMethod(Method) := PMethod(FActions.Objects[Index])^;
if Assigned(Method) then
begin
Method(ActionParameters);
end;
end;
end;
{ TcxCustomEventItem }
constructor TcxCustomEventItem.Create(Collection: TCollection);
begin
inherited;
FHandlerText := TStringList.Create;
FEventProcType := etProcedure;
end;
destructor TcxCustomEventItem.Destroy;
begin
FHandlerText.Free;
inherited;
end;
function TcxCustomEventItem.GetDisplayName: string;
begin
Result := GetEnumName(TcxCustomEvents(Collection).EventsHelper.EventTypeInfo, EventType);
end;
procedure TcxCustomEventItem.SetHandlerText(Value: TStrings);
begin
FHandlerText.Assign(Value);
end;
{ TcxCustomEvents }
constructor TcxCustomEvents.Create(AEventsHelper: TcxWebEventsHelper);
begin
FEventsHelper := AEventsHelper;
inherited Create(TcxCustomEventItem);
end;
function TcxCustomEvents.GetItem(Index: Integer): TcxCustomEventItem;
begin
Result := TcxCustomEventItem(inherited Items[Index]);
end;
procedure TcxCustomEvents.SetItem(Index: Integer; Value: TcxCustomEventItem);
begin
Items[Index].Assign(Value);
end;
function TcxCustomEvents.GetOwner: TPersistent;
begin
if FEventsHelper <> nil then
Result := FEventsHelper.Component
else Result := nil;
end;
function TcxCustomEvents.Add: TcxCustomEventItem;
begin
Result := TcxCustomEventItem(inherited Add);
end;
{ TcxWebEventsHelper }
constructor TcxWebEventsHelper.Create(AComponent: TComponent);
begin
inherited;
FEvents := TcxCustomEvents.Create(Self);
FCustomEvents := TcxCustomEvents.Create(Self);
end;
destructor TcxWebEventsHelper.Destroy;
begin
FCustomEvents.Free;
FEvents.Free;
inherited;
end;
procedure TcxWebEventsHelper.ClearEvents;
begin
FEvents.Clear;
end;
procedure TcxWebEventsHelper.FindEvents(const AEvent: Integer; AList: TList);
var
I: Integer;
begin
for I := 0 to FCustomEvents.Count - 1 do
if CustomEvents[I].EventType = AEvent then
AList.Add(CustomEvents[I]);
for I := 0 to FEvents.Count - 1 do
if FEvents[I].EventType = AEvent then
AList.Add(FEvents[I]);
end;
procedure TcxWebEventsHelper.WriteEvent(AHTMLTextBuilder: TcxHTMLTextBuilder; AList: TList);
var
EventItem: TcxCustomEventItem;
Text: string;
begin
if AList.Count <> 0 then
begin
EventItem := TcxCustomEventItem(AList[0]);
if (AList.Count = 1) and (EventItem.EventProcType = etSingleLine) then
begin
Text := StringReplace(EventItem.HandlerText.Text, #13#10, '', [rfReplaceAll, rfIgnoreCase]);
if Text <> '' then
AHTMLTextBuilder.WriteUnknownAttribute(EventName(EventItem.EventType), Text);
end
else AHTMLTextBuilder.WriteUnknownAttribute(EventName(EventItem.EventType),
EventProc(EventItem.EventType));
end;
end;
procedure TcxWebEventsHelper.WriteEventScript(AHTMLTextBuilder: TcxHTMLTextBuilder; AList: TList);
var
I: Integer;
Text: string;
begin
if AList.Count <> 0 then
begin
if (AList.Count > 1) or (TcxCustomEventItem(AList[0]).EventProcType = etProcedure) then
begin
AHTMLTextBuilder.WriteText(Format('function %s',
[EventProc(TcxCustomEventItem(AList[0]).EventType)]));
AHTMLTextBuilder.WriteText('{');
for I := 0 to AList.Count - 1 do
begin
Text := TcxCustomEventItem(AList[I]).HandlerText.Text;
AHTMLTextBuilder.WriteText(Text);
end;
AHTMLTextBuilder.WriteText('}');
end;
end;
end;
procedure TcxWebEventsHelper.WriteEvents(AHTMLTextBuilder: TcxHTMLTextBuilder);
var
Event: Integer;
List: TList;
begin
List := TList.Create;
try
for Event := MinEventValue to MaxEventValue do
begin
FindEvents(Event, List);
if List.Count > 0 then WriteEvent(AHTMLTextBuilder, List);
List.Clear;
end;
finally
List.Free;
end;
end;
procedure TcxWebEventsHelper.WriteEventsScript(AHTMLTextBuilder: TcxHTMLTextBuilder);
var
Event: Integer;
List: TList;
begin
List := TList.Create;
try
for Event := MinEventValue to MaxEventValue do
begin
FindEvents(Event, List);
if List.Count > 0 then WriteEventScript(AHTMLTextBuilder, List);
List.Clear;
end;
finally
List.Free;
end;
end;
function TcxWebEventsHelper.EventName(const AEvent: Integer): string;
const
cxHTMLEvent: array[TcxHTMLEvent] of string =
('onblur', 'onchange', 'onclick', 'ondblclick', 'ondragstart', 'ondragend',
'onfocus', 'onkeypress', 'onload', 'onmousedown', 'onmousemove', 'onmouseover',
'onmouseout', 'onmouseup', 'onselect', 'onselectstart', 'onunload', 'onpropertychange');
begin
Result := cxHTMLEvent[TcxHTMLEvent(AEvent)];
end;
function TcxWebEventsHelper.EventProc(const AEvent: Integer): string;
begin
Result := EventProcName(AEvent) + EventProcParams(AEvent);
end;
function TcxWebEventsHelper.EventProcName(const AEvent: Integer): string;
begin
Result := '__' + Component.Name + EventName(AEvent);
end;
function TcxWebEventsHelper.EventProcParams(const AEvent: Integer): string;
begin
Result := '(event)';
end;
function TcxWebEventsHelper.MaxEventValue: Integer;
begin
Result := GetTypeData(EventTypeInfo)^.MaxValue;
end;
function TcxWebEventsHelper.MinEventValue: Integer;
begin
Result := GetTypeData(EventTypeInfo)^.MinValue;
end;
function TcxWebEventsHelper.EventTypeInfo: PTypeInfo;
begin
Result := TypeInfo(TcxHTMLEvent);
end;
procedure TcxWebEventsHelper.RegisterEvent(const AEvent: TcxHTMLEvent;
const AEventProc: TcxWebComponentEventProc;
const AEventProcType: TcxWebComponentEventProcType);
var
AHandlerText: string;
begin
if TypeInfo(TcxHTMLEvent) <> EventTypeInfo then exit;
with FEvents.Add do
begin
EventType := Integer(AEvent);
AEventProc(AHandlerText);
HandlerText.Text := AHandlerText;
EventProcType := AEventProcType
end;
end;
{ TcxWebScriptEventsHelper }
function TcxWebScriptEventsHelper.ScriptObject: string;
begin
Result := '';
end;
procedure TcxWebScriptEventsHelper.WriteEvent(AHTMLTextBuilder: TcxHTMLTextBuilder; AList: TList);
var
EventItem: TcxCustomEventItem;
Text, HandlerText: string;
begin
if AList.Count <> 0 then
begin
EventItem := TcxCustomEventItem(AList[0]);
if (AList.Count = 1) and (EventItem.EventProcType = etSingleLine) then
begin
HandlerText := 'function ' + EventProc(EventItem.EventType) + ' { ' + EventItem.HandlerText.Text + ' } ';
HandlerText := StringReplace(HandlerText, #13#10, '', [rfReplaceAll]);
end
else HandlerText := EventProcName(EventItem.EventType) + ';';
Text := ' ' + ScriptObject + '.' + EventName(EventItem.EventType) + ' = ' + HandlerText;
AHTMLTextBuilder.WriteText(Text);
AHTMLTextBuilder.WriteText('');
end;
end;
{ TcxWebRenderHelper }
constructor TcxWebRenderHelper.Create(AComponent: TComponent);
begin
inherited;
FRenderers := TClassList.Create;
end;
destructor TcxWebRenderHelper.Destroy;
begin
FRenderers.Free;
inherited;
end;
procedure TcxWebRenderHelper.ClearEvents;
var
EventsIntf: IcxWebEvents;
begin
if Component.GetInterface(IcxWebEvents, EventsIntf) then
EventsIntf.ClearEvents;
end;
procedure TcxWebRenderHelper.RegisterEvents;
var
EventsIntf: IcxWebEvents;
begin
if Component.GetInterface(IcxWebEvents, EventsIntf) then
EventsIntf.RegisterEvents;
end;
procedure TcxWebRenderHelper.DoAfterRender;
begin
if Assigned(FOnAfterRender) then FOnAfterRender(Component);
ClearEvents;
end;
procedure TcxWebRenderHelper.DoBeforeRender;
begin
RegisterEvents;
if Assigned(FOnBeforeRender) then FOnBeforeRender(Component);
end;
function TcxWebRenderHelper.GetRenderer(AHTMLTextBuilder: TcxHTMLTextBuilder): TcxWebRenderer;
var
RenderClass: TcxWebRendererClass;
begin
RenderClass := GetRendererClass(AHTMLTextBuilder.Browser);
if RenderClass <> nil then
Result := RenderClass.Create(Component, AHTMLTextBuilder)
else Result := TcxWebRenderer.Create(Component, AHTMLTextBuilder);
end;
function TcxWebRenderHelper.GetRendererClass(Browser: TcxWebBrowserClass): TcxWebRendererClass;
var
I: Integer;
begin
Result := WebRendererFactory.FindRenderer(TComponentClass(Component.ClassType), Browser);
if Result = nil then
for I := FRenderers.Count - 1 downto 0 do
if TcxWebRendererClass(FRenderers.Items[I]).IsBrowserSupported(Browser) then
begin
Result := TcxWebRendererClass(FRenderers.Items[I]);
break;
end;
end;
procedure TcxWebRenderHelper.RegisterRenderer(ARendererClass: TcxWebRendererClass);
begin
FRenderers.Add(ARendererClass);
end;
procedure TcxWebRenderHelper.ClearRenderers;
begin
FRenderers.Clear;
end;
{ IcxCodeProvider }
procedure TcxWebRenderHelper.GetScriptFiles(HTMLTextBuilder: TcxHTMLTextBuilder; AList: TStrings);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.GetScriptFiles(AList);
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteClassScripts(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteClassScripts(HTMLTextBuilder);
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteBeginHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
DoBeforeRender;
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteBeginHTML;
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteClassHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteClassHTML(HTMLTextBuilder);
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteHiddenFormElements(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteHiddenFormElements;
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
DoBeforeRender;
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteHTML;
Renderer.Free;
DoAfterRender;
end;
procedure TcxWebRenderHelper.WriteEndHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteEndHTML;
Renderer.Free;
DoAfterRender;
end;
procedure TcxWebRenderHelper.WriteClassOutOfFormHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteClassOutOfFormHTML(HTMLTextBuilder);
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteOutOfFormHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteOutOfFormHTML;
Renderer.Free;
end;
procedure TcxWebRenderHelper.WriteScripts(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
RegisterEvents;
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteScripts;
Renderer.Free;
ClearEvents;
end;
procedure TcxWebRenderHelper.WriteXML(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteXML;
Renderer.Free;
end;
{ IcxStylesProvider }
procedure TcxWebRenderHelper.WriteStyles(HTMLTextBuilder: TcxHTMLTextBuilder);
var
Renderer: TcxWebRenderer;
begin
Renderer := GetRenderer(HTMLTextBuilder);
Renderer.WriteStyles(HTMLTextBuilder);
Renderer.Free;
end;
{ TcxWebScriptsHelper }
constructor TcxWebScriptsHelper.Create(AComponent: TComponent);
begin
inherited;
FScripts := TClassList.Create;
end;
destructor TcxWebScriptsHelper.Destroy;
begin
FScripts.Free;
inherited;
end;
procedure TcxWebScriptsHelper.ScriptSubscription(const AClass: TClass);
begin
WebScriptFactory.Subscribe(TcxWebScriptClass(AClass));
if FScripts.IndexOf(AClass) = -1 then
FScripts.Add(AClass);
end;
{ TcxWebValuesHelper }
constructor TcxWebValuesHelper.Create(AComponent: TComponent);
begin
inherited;
FValues := TStringList.Create;
end;
destructor TcxWebValuesHelper.Destroy;
begin
FValues.Free;
inherited;
end;
function TcxWebValuesHelper.GetValues: TStrings;
begin
Result := FValues;
end;
procedure TcxWebValuesHelper.RegisterValue(const AName: string; AValue: string);
begin
FValues.Add(AName + '=' + AValue);
end;
{ TcxWebComponent }
constructor TcxWebComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStyles := TcxWebStyles.Create(Self);
FWebComponentState := [wcsLoading];
RegisterRenderers;
end;
destructor TcxWebComponent.Destroy;
begin
FStyles.Free;
WebRenderHelper.ClearRenderers;
FreeAndNil(FWebActionsHelper);
FreeAndNil(FWebEventsHelper);
FreeAndNil(FWebRenderHelper);
FreeAndNil(FWebScriptsHelper);
FreeAndNil(FWebValuesHelper);
inherited Destroy;
end;
procedure TcxWebComponent.Loaded;
begin
inherited;
end;
procedure TcxWebComponent.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if not IsDestroying and (AComponent is TcxWebStyleItem) then
Styles.Notification(AComponent, Operation);
end;
{ actions }
procedure TcxWebComponent.DoAfterPerformActions;
begin
end;
procedure TcxWebComponent.RegisterActions;
begin
end;
function TcxWebComponent.GetWebActionsHelper: TcxWebActionsHelper;
begin
if FWebActionsHelper = nil then
FWebActionsHelper := TcxWebActionsHelper.Create(Self);
Result := FWebActionsHelper;
end;
{ renderers }
procedure TcxWebComponent.RegisterRenderers;
begin
WebRenderHelper.RegisterRenderer(TcxWebRenderer);
end;
{ events }
procedure TcxWebComponent.RegisterEvents;
begin
if Styles.Hover <> nil then
begin
WebEventsHelper.RegisterEvent(eOnMouseOut, GetDefaultStyleProc, etSingleLine);
WebEventsHelper.RegisterEvent(eOnMouseOver, GetHoverStyleProc, etSingleLine);
end;
end;
class function TcxWebComponent.GetWebEventsHelperClass: TcxWebEventsHelperClass;
begin
Result := TcxWebEventsHelper;
end;
function TcxWebComponent.GetWebEventsHelper: TcxWebEventsHelper;
begin
if FWebEventsHelper = nil then
FWebEventsHelper := GetWebEventsHelperClass.Create(Self);
Result := FWebEventsHelper;
end;
{ IcxCodeProvider }
function TcxWebComponent.GetWebRenderHelper: TcxWebRenderHelper;
begin
if FWebRenderHelper = nil then
begin
FWebRenderHelper := TcxWebRenderHelper.Create(Self);
FWebRenderHelper.OnAfterRender := DoAfterRenderProc;
FWebRenderHelper.OnBeforeRender := DoBeforeRenderProc;
end;
Result := FWebRenderHelper;
end;
{ scripts }
procedure TcxWebComponent.ScriptsSubscription;
begin
if TcxWebStyles(Styles).Hover <> nil then
WebScriptsHelper.ScriptSubscription(TcxWebChangeStyleScript);
end;
function TcxWebComponent.GetWebScriptsHelper: TcxWebScriptsHelper;
begin
if FWebScriptsHelper = nil then
FWebScriptsHelper := TcxWebScriptsHelper.Create(Self);
Result := FWebScriptsHelper;
end;
{ IcxWebProvidersSupport}
procedure TcxWebComponent.GetProviders(AList: TList);
begin
ImplGetProviders(AList);
end;
procedure TcxWebComponent.ImplGetProviders(AList: TList);
begin
AddStylesToProviderList(AList, [Styles]);
end;
procedure TcxWebComponent.AddStylesToProviderList(AList: TList; AStylesArray: Array of TcxWebStyles);
procedure AddStyleToProviderList(AStyles: TcxWebStyles);
var
I: Integer;
AStyleController: TComponent;
begin
for I := 0 to AStyles.ItemCount - 1 do
begin
if AStyles.Items[I] <> nil then
begin
AStyleController := AStyles.Items[I].Controller;
if AList.IndexOf(AStyleController) < 0 then
AList.Add(AStyleController);
end;
end;
end;
var
I: Integer;
begin
for I := Low(AStylesArray) to High(AStylesArray) do
AddStyleToProviderList(AStylesArray[I]);
end;
{ styles }
procedure TcxWebComponent.StyleChanged(Style: TcxWebStyleItem);
begin
end;
{ values }
function TcxWebComponent.CanSetValues: Boolean;
begin
Result := True;
end;
procedure TcxWebComponent.DoSetValues;
begin
end;
procedure TcxWebComponent.DoAfterSetValues;
begin
end;
procedure TcxWebComponent.RegisterValues;
begin
end;
function TcxWebComponent.GetWebValuesHelper: TcxWebValuesHelper;
begin
if FWebValuesHelper = nil then
FWebValuesHelper := TcxWebValuesHelper.Create(Self);
Result := FWebValuesHelper;
end;
{ IWebVariableName }
function TcxWebComponent.GetVariableName: string;
begin
Result := ImplGetVariableName;
end;
function TcxWebComponent.ImplGetVariableName: string;
begin
Result := Self.Name;
end;
function TcxWebComponent.GetState: TcxWebComponentStates;
begin
Result := FWebComponentState;
end;
procedure TcxWebComponent.SetState(Value: TcxWebComponentStates);
begin
FWebComponentState := Value;
end;
{ design - time support }
function TcxWebComponent.IsDesigning: Boolean;
begin
Result := (csDesigning in ComponentState) or ((Owner <> nil) and (csDesigning in Owner.ComponentState));
end;
function TcxWebComponent.IsDestroying: Boolean;
begin
Result := csDestroying in ComponentState;
end;
function TcxWebComponent.IsLoading: Boolean;
begin
Result := csLoading in ComponentState;
end;
function TcxWebComponent.GetWebRendererClass(ABrowser: TcxWebBrowserClass): TcxWebRendererClass;
begin
Result := WebRenderHelper.GetRendererClass(ABrowser);
end;
function TcxWebComponent.GetCustomEvents: TcxCustomEvents;
begin
Result := WebEventsHelper.CustomEvents;
end;
procedure TcxWebComponent.DoBeforeRenderProc(Sender: TObject);
begin
DoBeforeRender;
end;
procedure TcxWebComponent.DoAfterRenderProc(Sender: TObject);
begin
DoAfterRender;
end;
procedure TcxWebComponent.DoBeforeRender;
begin
if Assigned(onBeforeRender) then
onBeforeRender(self);
end;
procedure TcxWebComponent.DoAfterRender;
begin
if Assigned(onAfterRender) then
onAfterRender(self);
end;
procedure TcxWebComponent.SetCustomEvents(Value: TcxCustomEvents);
begin
WebEventsHelper.CustomEvents := Value;
end;
function TcxWebComponent.GetStyles: TcxWebStyles;
begin
if FStyles = nil then
FStyles := TcxWebStyles.Create(Self);
Result := FStyles;
end;
procedure TcxWebComponent.SetStyles(Value: TcxWebStyles);
begin
Styles.Assign(Value);
end;
function TcxWebComponent.GetStyleItem_Default: TcxWebStyleItem;
begin
Result := Styles.Default;
end;
function TcxWebComponent.GetStyleItem_Hover: TcxWebStyleItem;
begin
Result := Styles.Hover;
end;
procedure TcxWebComponent.SetStyleItem_Default(Value: TcxWebStyleItem);
begin
Styles.Default := Value;;
end;
procedure TcxWebComponent.SetStyleItem_Hover(Value: TcxWebStyleItem);
begin
Styles.Hover := Value;
end;
procedure TcxWebComponent.GetDefaultStyleProc(var AScript: string);
begin
AScript := TcxWebComponentRenderer.GetDefaultStyleProc(Styles.Default);
end;
procedure TcxWebComponent.GetHoverStyleProc(var AScript: string);
begin
AScript := TcxWebComponentRenderer.GetHoverStyleProc(Styles.Hover);
end;
{ TcxWebComponentRenderer }
function TcxWebComponentRenderer.GetWebComponent: TcxWebComponent;
begin
Result := Component as TcxWebComponent;
end;
class function TcxWebComponentRenderer.GetDefaultStyleProc(AStyle: TcxWebStyleItem): string;
begin
Result := '__ChangeStyle(event, this);';
end;
class function TcxWebComponentRenderer.GetHoverStyleProc(AStyle: TcxWebStyleItem): string;
begin
if AStyle <> nil then
Result := Format('__ChangeStyle(event, this, ''%s'');', [AStyle.FullName])
else Result := '';
end;
procedure TcxWebComponentRenderer.WriteDefaultStyle;
begin
if WebComponent.Styles.Default <> nil then
HTMLTextBuilder.WriteAttribute(aClass, WebComponent.Styles.Default.FullName);
end;
procedure TcxWebComponentRenderer.WriteEvents;
begin
WebComponent.WebEventsHelper.WriteEvents(HTMLTextBuilder);
end;
procedure TcxWebComponentRenderer.WriteEventsScript;
begin
WebComponent.WebEventsHelper.WriteEventsScript(HTMLTextBuilder);
end;
class procedure TcxWebComponentRenderer.GetScriptFiles(AList: TStrings);
begin
AList.Add(scxCommonScriptName);
end;
procedure TcxWebComponentRenderer.WriteScripts;
begin
WriteEventsScript;
end;
{ TcxURL }
constructor TcxURL.Create(AOwner: TComponent);
begin
FOwner := AOwner;
end;
procedure TcxURL.Assign(Source: TPersistent);
begin
if Source is TcxURL then
begin
Href := TcxURL(Source).Href;
Target := TcxURL(Source).Target;
end
else inherited;
end;
procedure TcxURL.Write(AHTMLTextBuilder: TcxHTMLTextBuilder);
begin
if Href <> '' then
begin
AHTMLTextBuilder.WriteAttribute(aHref, Href);
if Target <> '' then AHTMLTextBuilder.WriteAttribute(aTarget, Target);
end;
end;
procedure TcxURL.UpdateOwner;
var
AControl: IcxWebControl;
begin
if (Owner <> nil) and not (csDestroying in Owner.ComponentState) then
if Supports(Owner, IcxWebControl, AControl) and (AControl.DesignerControl <> nil) then
AControl.DesignerControl.UpdateContext;
end;
procedure TcxURL.SetHref(Value: string);
begin
if FHref <> Value then
begin
FHref := Value;
UpdateOwner;
end;
end;
procedure TcxURL.SetTarget(Value: string);
begin
if FTarget <> Value then
begin
FTarget := Value;
UpdateOwner;
end;
end;
{ TcxWebStyleObject }
constructor TcxWebStyleObject.Create(AWebStyle: TBasecxWebStyle);
begin
inherited Create;
DoRestoreDefaults;
FWebStyle := AWebStyle;
end;
procedure TcxWebStyleObject.BeginUpdate;
begin
if WebStyle <> nil then
WebStyle.BeginUpdate;
end;
procedure TcxWebStyleObject.EndUpdate;
begin
if WebStyle <> nil then
WebStyle.EndUpdate;
end;
procedure TcxWebStyleObject.RestoreDefaults;
begin
BeginUpdate;
try
DoRestoreDefaults;
finally
EndUpdate;
end;
end;
function TcxWebStyleObject.CanAssignValue: Boolean;
begin
Result := WebStyle <> nil;
if Result and (WebStyle.GetOwner <> nil) then
Result := not (csLoading in (WebStyle.GetOwner as TComponent).ComponentState);
end;
procedure TcxWebStyleObject.Changed;
begin
if WebStyle <> nil then
WebStyle.Changed;
end;
procedure TcxWebStyleObject.DoRestoreDefaults;
begin
end;
{ TcxWebBorder }
constructor TcxWebBorder.Create(ABorders: TcxWebBorders);
begin
inherited Create;
RestoreDefaults;
FBorders := ABorders;
end;
procedure TcxWebBorder.Assign(Source: TPersistent);
begin
if Source is TcxWebBorder then
begin
if Borders <> nil then Borders.BeginUpdate;
try
Color := TcxWebBorder(Source).Color;
Style := TcxWebBorder(Source).Style;
Width := TcxWebBorder(Source).Width;
AssignedValues := TcxWebBorder(Source).AssignedValues;
finally
if Borders <> nil then Borders.EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TcxWebBorder.Merge(Source: TcxWebBorder);
begin
if Borders <> nil then Borders.BeginUpdate;
try
if not (wbavColor in AssignedValues) and
(wbavColor in Source.AssignedValues) then
begin
Color := Source.Color;
AssignedValues := AssignedValues + [wbavColor];
end;
if not (wbavStyle in AssignedValues) and
(wbavStyle in Source.AssignedValues) then
begin
Style := Source.Style;
AssignedValues := AssignedValues + [wbavStyle];
end;
if not (wbavWidth in AssignedValues) and
(wbavWidth in Source.AssignedValues) then
begin
Width := Source.Width;
AssignedValues := AssignedValues + [wbavWidth];
end;
finally
if Borders <> nil then Borders.EndUpdate;
end;
end;
procedure TcxWebBorder.RestoreDefaults;
begin
Color := cxclDefaultStyleBorderColor;
Style := wbsNone;
Width := 2;
AssignedValues := [];
end;
procedure TcxWebBorder.Changed;
begin
if Borders <> nil then
Borders.Changed;
end;
function TcxWebBorder.IsColorStored: Boolean;
begin
Result := (Borders = nil) or not Borders.SameColors;
end;
function TcxWebBorder.IsStyleStored: Boolean;
begin
Result := (Borders = nil) or not Borders.SameStyles;
end;
function TcxWebBorder.IsWidthStored: Boolean;
begin
Result := (Borders = nil) or not Borders.SameWidths;
end;
procedure TcxWebBorder.SetAssignedValues(Value: TcxWebBorderAssignedValues);
begin
if FAssignedValues <> Value then
begin
FAssignedValues := Value;
Changed;
end;
end;
procedure TcxWebBorder.SetColor(Value: TcxWebColor);
begin
if FColor <> Value then
begin
FColor := Value;
if (Borders <> nil) and Borders.CanAssignValue then
AssignedValues := AssignedValues + [wbavColor];
Changed;
end;
end;
procedure TcxWebBorder.SetStyle(Value: TcxWebBorderStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if (Borders <> nil) and Borders.CanAssignValue then
AssignedValues := AssignedValues + [wbavStyle];
Changed;
end;
end;
procedure TcxWebBorder.SetWidth(Value: TcxWebBorderWidth);
begin
if FWidth <> Value then
begin
FWidth := Value;
if (Borders <> nil) and Borders.CanAssignValue then
AssignedValues := AssignedValues + [wbavWidth];
Changed;
end;
end;
{ TcxWebBorders }
constructor TcxWebBorders.Create(AWebStyle: TBasecxWebStyle);
begin
FBottom := TcxWebBorder.Create(Self);
FLeft := TcxWebBorder.Create(Self);
FRight := TcxWebBorder.Create(Self);
FTop := TcxWebBorder.Create(Self);
inherited Create(AWebStyle);
end;
destructor TcxWebBorders.Destroy;
begin
FBottom.Free;
FLeft.Free;
FRight.Free;
FTop.Free;
inherited;
end;
procedure TcxWebBorders.Assign(Source: TPersistent);
begin
if Source is TcxWebBorders then
begin
BeginUpdate;
try
Bottom := TcxWebBorders(Source).Bottom;
Left := TcxWebBorders(Source).Left;
Right := TcxWebBorders(Source).Right;
Top := TcxWebBorders(Source).Top;
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TcxWebBorders.Merge(Source: TcxWebBorders);
begin
BeginUpdate;
try
Bottom.Merge(Source.Bottom);
Left.Merge(Source.Left);
Right.Merge(Source.Right);
Top.Merge(Source.Top);
finally
EndUpdate;
end;
end;
function TcxWebBorders.SameColors: Boolean;
begin
Result := (Left.Color = Top.Color) and (Top.Color = Right.Color) and
(Right.Color = Bottom.Color);
end;
function TcxWebBorders.SameStyles: Boolean;
begin
Result := (Left.Style = Top.Style) and (Top.Style = Right.Style) and
(Right.Style = Bottom.Style);
end;
function TcxWebBorders.SameWidths: Boolean;
begin
Result := (Left.Width = Top.Width) and (Top.Width = Right.Width) and
(Right.Width = Bottom.Width);
end;
function TcxWebBorders.HorzBordersSize: Integer;
begin
Result := 0;
if wbavWidth in Left.AssignedValues then
Inc(Result, Left.Width);
if wbavWidth in Right.AssignedValues then
Inc(Result, Right.Width);
end;
function TcxWebBorders.VertBordersSize: Integer;
begin
Result := 0;
if wbavWidth in Top.AssignedValues then
Inc(Result, Top.Width);
if wbavWidth in Bottom.AssignedValues then
Inc(Result, Bottom.Width);
end;
procedure TcxWebBorders.WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
begin
if SameColors and (wbavColor in Bottom.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderColor, cxWebColorToWebString(Bottom.Color))
else
begin
if wbavColor in Bottom.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderBottomColor, cxWebColorToWebString(Bottom.Color));
if wbavColor in Left.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderLeftColor, cxWebColorToWebString(Left.Color));
if wbavColor in Right.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderRightColor, cxWebColorToWebString(Right.Color));
if wbavColor in Top.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderTopColor, cxWebColorToWebString(Top.Color));
end;
if SameStyles and (wbavStyle in Bottom.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderStyle, scxWebBorderStyles[Bottom.Style])
else
begin
if wbavStyle in Bottom.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderBottomStyle, scxWebBorderStyles[Bottom.Style]);
if wbavStyle in Left.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderLeftStyle, scxWebBorderStyles[Left.Style]);
if wbavStyle in Right.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderRightStyle, scxWebBorderStyles[Right.Style]);
if wbavStyle in Top.AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBorderTopStyle, scxWebBorderStyles[Top.Style]);
end;
if SameWidths and (wbavWidth in Bottom.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderWidth, Bottom.Width, 'px')
else
begin
if (wbavWidth in Bottom.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderBottomWidth, Bottom.Width, 'px');
if (wbavWidth in Left.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderLeftWidth, Left.Width, 'px');
if (wbavWidth in Right.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderRightWidth, Right.Width, 'px');
if (wbavWidth in Top.AssignedValues) then
HTMLTextBuilder.WriteStyleAttribute(saBorderTopWidth, Top.Width, 'px');
end;
end;
procedure TcxWebBorders.DoRestoreDefaults;
begin
Bottom.RestoreDefaults;
Left.RestoreDefaults;
Right.RestoreDefaults;
Top.RestoreDefaults;
end;
function TcxWebBorders.GetColor: TcxWebColor;
begin
Result := FLeft.Color;
end;
function TcxWebBorders.GetStyle: TcxWebBorderStyle;
begin
Result := FLeft.Style;
end;
function TcxWebBorders.GetWidth: TcxWebBorderWidth;
begin
Result := FLeft.Width;
end;
function TcxWebBorders.IsColorStored: Boolean;
begin
Result := SameColors;
end;
function TcxWebBorders.IsStyleStored: Boolean;
begin
Result := SameStyles;
end;
function TcxWebBorders.IsWidthStored: Boolean;
begin
Result := SameWidths;
end;
procedure TcxWebBorders.SetBottom(Value: TcxWebBorder);
begin
Bottom.Assign(Value);
end;
procedure TcxWebBorders.SetColor(Value: TcxWebColor);
begin
BeginUpdate;
try
Bottom.Color := Value;
Left.Color := Value;
Right.Color := Value;
Top.Color := Value;
finally
EndUpdate;
end;
end;
procedure TcxWebBorders.SetLeft(Value: TcxWebBorder);
begin
Left.Assign(Value);
end;
procedure TcxWebBorders.SetRight(Value: TcxWebBorder);
begin
Right.Assign(Value);
end;
procedure TcxWebBorders.SetStyle(Value: TcxWebBorderStyle);
begin
BeginUpdate;
try
Bottom.Style := Value;
Left.Style := Value;
Right.Style := Value;
Top.Style := Value;
finally
EndUpdate;
end;
end;
procedure TcxWebBorders.SetTop(Value: TcxWebBorder);
begin
Top.Assign(Value);
end;
procedure TcxWebBorders.SetWidth(Value: TcxWebBorderWidth);
begin
BeginUpdate;
try
Bottom.Width := Value;
Left.Width := Value;
Right.Width := Value;
Top.Width := Value;
finally
EndUpdate;
end;
end;
{ TcxWebNumbering }
procedure TcxWebNumbering.Assign(Source: TPersistent);
begin
if Source is TcxWebNumbering then
begin
BeginUpdate;
try
Style := TcxWebNumbering(Source).Style;
Position := TcxWebNumbering(Source).Position;
AssignedValues := TcxWebNumbering(Source).AssignedValues;
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TcxWebNumbering.Merge(Source: TcxWebNumbering);
begin
BeginUpdate;
try
if not (wnavStyle in AssignedValues) and
(wnavStyle in Source.AssignedValues) then
begin
Style := Source.Style;
AssignedValues := AssignedValues + [wnavStyle];
end;
if not (wnavPosition in AssignedValues) and
(wnavPosition in Source.AssignedValues) then
begin
Position := Source.Position;
AssignedValues := AssignedValues + [wnavPosition];
end;
finally
EndUpdate;
end;
end;
procedure TcxWebNumbering.WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
begin
if wnavStyle in AssignedValues then
if Style < wnsPicture then
HTMLTextBuilder.WriteStyleAttribute(saListStyleType, cxWebNumberingStyles[Style])
else
HTMLTextBuilder.WriteStyleAttribute(saListStyleImage, 'url(' + Picture + ')');
if wnavPosition in AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saListStylePosition, cxWebNumberingPositions[Position]);
end;
procedure TcxWebNumbering.DoRestoreDefaults;
begin
Position := wnpOutside;
Style := wnsNone;
AssignedValues := [];
end;
procedure TcxWebNumbering.SetAssignedValues(Value: TcxWebNumberingAssignedValues);
begin
if FAssignedValues <> Value then
FAssignedValues := Value;
end;
procedure TcxWebNumbering.SetPicture(const Value: string);
begin
FPicture := Value;
end;
procedure TcxWebNumbering.SetPosition(Value: TcxWebNumberingPosition);
begin
if FPosition <> Value then
begin
FPosition := Value;
if CanAssignValue then
AssignedValues := AssignedValues + [wnavPosition];
Changed;
end;
end;
procedure TcxWebNumbering.SetStyle(Value: TcxWebNumberingStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if CanAssignValue then
AssignedValues := AssignedValues + [wnavStyle];
Changed;
end;
end;
{ TcxWebShading }
procedure TcxWebShading.Assign(Source: TPersistent);
begin
if Source is TcxWebShading then
begin
BeginUpdate;
try
Color := TcxWebShading(Source).Color;
AssignedValues := TcxWebShading(Source).AssignedValues;
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TcxWebShading.Merge(Source: TcxWebShading);
begin
BeginUpdate;
try
if not (wsavColor in AssignedValues) and
(wsavColor in Source.AssignedValues) then
begin
Color := Source.Color;
AssignedValues := AssignedValues + [wsavColor];
end;
finally
EndUpdate;
end;
end;
procedure TcxWebShading.WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
begin
if wsavColor in AssignedValues then
HTMLTextBuilder.WriteStyleAttribute(saBackgroundColor, cxWebColorToWebString(Color));
end;
procedure TcxWebShading.DoRestoreDefaults;
begin
Color := cxclDefaultStyleBkColor;
AssignedValues := [];
end;
procedure TcxWebShading.SetAssignedValues(Value: TcxWebShadingAssignedValues);
begin
if FAssignedValues <> Value then
begin
FAssignedValues := Value;
Changed;
end;
end;
procedure TcxWebShading.SetColor(Value: TcxWebColor);
begin
if FColor <> Value then
begin
FColor := Value;
if CanAssignValue then
AssignedValues := AssignedValues + [wsavColor];
Changed;
end;
end;
{ TBasecxWebStyle }
constructor TBasecxWebStyle.Create;
begin
inherited Create;
FBorders := TcxWebBorders.Create(Self);
FFont := TcxWebFont.Create;
FNumbering := TcxWebNumbering.Create(Self);
FShading := TcxWebShading.Create(Self);
DoRestoreDefaults;
FFont.OnChange := FontChanged;
end;
destructor TBasecxWebStyle.Destroy;
begin
FShading.Free;
FNumbering.Free;
FFont.Free;
FBorders.Free;
inherited;
end;
procedure TBasecxWebStyle.Assign(Source: TPersistent);
begin
if Source is TBasecxWebStyle then
begin
BeginUpdate;
try
Borders := TBasecxWebStyle(Source).Borders;
Font := TBasecxWebStyle(Source).Font;
Numbering := TBasecxWebStyle(Source).Numbering;
Shading := TBasecxWebStyle(Source).Shading;
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TBasecxWebStyle.Merge(Source: TBasecxWebStyle);
begin
BeginUpdate;
try
Borders.Merge(Source.Borders);
// Font.Assign(Source.Font);
Numbering.Merge(Source.Numbering);
Shading.Merge(Source.Shading);
finally
EndUpdate;
end;
end;
procedure TBasecxWebStyle.BeginUpdate;
begin
Inc(FUpdateCount);
end;
procedure TBasecxWebStyle.EndUpdate;
begin
if FUpdateCount <> 0 then
begin
Dec(FUpdateCount);
if FUpdateCount = 0 then
Changed;
end;
end;
procedure TBasecxWebStyle.RestoreDefaults;
begin
BeginUpdate;
try
DoRestoreDefaults;
finally
EndUpdate;
end;
end;
procedure TBasecxWebStyle.WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
begin
Shading.WriteHTML(HTMLTextBuilder);
Borders.WriteHTML(HTMLTextBuilder);
Font.WriteHTML(HTMLTextBuilder);
Numbering.WriteHTML(HTMLTextBuilder);
end;
procedure TBasecxWebStyle.Changed;
begin
if FUpdateCount = 0 then
DoChanged;
end;
procedure TBasecxWebStyle.DoChanged;
begin
end;
procedure TBasecxWebStyle.DoRestoreDefaults;
begin
BeginUpdate;
try
Borders.RestoreDefaults;
Font.Assign(cxWebDefaultFont);
Numbering.RestoreDefaults;
Shading.RestoreDefaults;
finally
EndUpdate;
end;
end;
procedure TBasecxWebStyle.SetBorders(Value: TcxWebBorders);
begin
Borders.Assign(Value);
end;
procedure TBasecxWebStyle.SetFont(Value: TcxWebFont);
begin
Font.Assign(Value);
end;
procedure TBasecxWebStyle.SetNumbering(Value: TcxWebNumbering);
begin
Numbering.Assign(Value);
end;
procedure TBasecxWebStyle.SetShading(Value: TcxWebShading);
begin
Shading.Assign(Value);
end;
procedure TBasecxWebStyle.FontChanged(Sender: TObject);
begin
Changed;
end;
{ TcxWebStyle }
constructor TcxWebStyle.Create(AStyleItem: TcxWebStyleItem);
begin
inherited Create;
FStyleItem := AStyleItem;
end;
function TcxWebStyle.GetOwner: TPersistent;
begin
Result := StyleItem;
end;
procedure TcxWebStyle.DoChanged;
begin
if StyleItem <> nil then
StyleItem.Changed;
end;
{ TcxWebStyleItem }
constructor TcxWebStyleItem.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStyle := TcxWebStyle.Create(Self);
FCustomHTML := TStringList.Create;
end;
destructor TcxWebStyleItem.Destroy;
begin
Controller := nil;
while FClients <> nil do
UnregisterClient(Clients[ClientCount - 1]);
FCustomHTML.Free;
FStyle.Free;
inherited Destroy;
end;
procedure TcxWebStyleItem.Assign(Source: TPersistent);
begin
if Source is TcxWebStyleItem then
Style := TcxWebStyleItem(Source).Style
else
inherited;
end;
function TcxWebStyleItem.GetParentComponent: TComponent;
begin
Result := Controller;
end;
function TcxWebStyleItem.HasParent: Boolean;
begin
HasParent := Controller <> nil;
end;
procedure TcxWebStyleItem.RegisterClient(AComponent: IcxWebStyleChanged);
begin
if (AComponent = nil) or IsClient(AComponent) then
Exit;
if FClients = nil then
FClients := TList.Create;
FClients.Add(Pointer(AComponent));
end;
procedure TcxWebStyleItem.UnregisterClient(AComponent: IcxWebStyleChanged);
begin
if FClients <> nil then
begin
FClients.Remove(Pointer(AComponent));
if (FClients.Count = 0) then
begin
FClients.Free;
FClients := nil;
end;
end;
end;
procedure TcxWebStyleItem.WriteHTML(HTMLTextBuilder: TcxHTMLTextBuilder);
begin
if (CustomHTML.Count > 0) and (Length(CustomHTML.Text) < 1024) then
HTMLTextBuilder.WriteUnknownStyleAttribute(CustomHTML.Text)
else Style.WriteHTML(HTMLTextBuilder);
end;
procedure TcxWebStyleItem.Notification(AComponent: TComponent; Operation: TOperation);
var
AStyleChanged: IcxWebStyleChanged;
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = Controller then
Controller := nil;
if Supports(AComponent, IcxWebStyleChanged, AStyleChanged) then
UnregisterClient(AStyleChanged);
end;
end;
procedure TcxWebStyleItem.ReadState(Reader: TReader);
begin
inherited;
if Reader.Parent is TcxWebStyleController then
Controller := TcxWebStyleController(Reader.Parent);
end;
procedure TcxWebStyleItem.SetName(const NewName: TComponentName);
begin
inherited;
DesignerUpdate(False);
end;
procedure TcxWebStyleItem.SetParentComponent(AParent: TComponent);
begin
inherited;
if not (csLoading in ComponentState) then
Controller := AParent as TcxWebStyleController;
end;
{ IWebVariableName }
function TcxWebStyleItem.GetVariableName: string;
begin
Result := ImplGetVariableName;
end;
function TcxWebStyleItem.ImplGetVariableName: string;
begin
Result := Name;
end;
procedure TcxWebStyleItem.DesignerUpdate(TheAll: Boolean);
begin
if Controller <> nil then
if TheAll then
Controller.DesignerUpdate(nil)
else
Controller.DesignerUpdate(Self);
end;
procedure TcxWebStyleItem.Changed;
var
I: Integer;
begin
if ClientCount = 0 then
Exit;
for I := 0 to ClientCount - 1 do
Clients[I].StyleChanged(Self);
UpdateDesigner;
end;
function TcxWebStyleItem.GetClient(Index: Integer): IcxWebStyleChanged;
begin
Result := IcxWebStyleChanged(FClients[Index]);
end;
function TcxWebStyleItem.GetClientCount: Integer;
begin
if FClients <> nil then
Result := FClients.Count
else
Result := 0;
end;
function TcxWebStyleItem.GetFullName: string;
begin
if FCSSClassName = '' then
Result := Format('%s%s', [Owner.Name, Name])
else Result := FCSSClassName;
end;
function TcxWebStyleItem.GetIndex: Integer;
begin
if Controller <> nil then
Result := Controller.IndexOf(Self)
else
Result := -1;
end;
procedure TcxWebStyleItem.SetController(Value: TcxWebStyleController);
begin
if FController <> Value then
begin
if FController <> nil then
FController.RemoveItem(Self);
if Value <> nil then
Value.InsertItem(Self);
end;
end;
procedure TcxWebStyleItem.SetCustomHTML(Value: TStrings);
begin
FCustomHTML.Assign(Value);
end;
procedure TcxWebStyleItem.SetIndex(Value: Integer);
var
CurIndex: Integer;
begin
if Controller = nil then
Exit;
if Value < 0 then
Value := 0;
if Value > Controller.Count - 1 then
Value := Controller.Count - 1;
CurIndex := Index;
if CurIndex <> Value then
Controller.MoveItem(CurIndex, Value);
end;
procedure TcxWebStyleItem.SetStyle(Value: TcxWebStyle);
begin
FStyle.Assign(Value);
end;
function TcxWebStyleItem.IsClient(AComponent: IcxWebStyleChanged): Boolean;
begin
Result := (FClients <> nil) and (FClients.IndexOf(Pointer(AComponent)) <> -1);
end;
procedure TcxWebStyleItem.UpdateDesigner;
var
AWebControl: IcxWebControl;
I: Integer;
begin
for I := 0 to ClientCount - 1 do
if Supports(Clients[I], IcxWebControl, AWebControl) and
(AWebControl.DesignerControl <> nil) then
AWebControl.DesignerControl.UpdateContext;
end;
{ TcxWebStyleController }
constructor TcxWebStyleController.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TList.Create;
end;
destructor TcxWebStyleController.Destroy;
begin
{$IFNDEF DELPHI5}
Destroying;
{$ENDIF}
FDesigner.Free;
Clear;
FItems.Free;
inherited Destroy;
end;
function TcxWebStyleController.Add: TcxWebStyleItem;
begin
Result := TcxWebStyleItem.Create(Owner);
Result.Controller := Self;
end;
procedure TcxWebStyleController.AssignItems(ASource: TcxWebStyleController);
var
I: Integer;
begin
Clear;
if ASource <> nil then
for I := 0 to ASource.Count - 1 do
Add.Assign(ASource[I]);
end;
procedure TcxWebStyleController.Clear;
begin
while Count > 0 do
Delete(Count - 1);
end;
procedure TcxWebStyleController.Delete(AIndex: Integer);
var
Item: TcxWebStyleItem;
begin
if (AIndex > -1) and (AIndex < Count) then
begin
Item := Items[AIndex];
Item.Free;
end;
end;
procedure TcxWebStyleController.GetStyleList(const AList: TList);
var
I: Integer;
begin
for I := 0 to Count - 1 do
AList.Add(Items[I]);
end;
function TcxWebStyleController.IndexOf(AItem: TcxWebStyleItem): Integer;
begin
Result := FItems.IndexOf(AItem);
end;
function TcxWebStyleController.ItemByName(const AName: string): TcxWebStyleItem;
var
I: Integer;
begin
for I := 0 to Count - 1 do
begin
Result := Items[I];
if CompareText(AName, Result.Name) = 0 then
Exit;
end;
Result := nil;
end;
procedure TcxWebStyleController.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
I: Integer;
Item: TcxWebStyleItem;
begin
for I := 0 to Count - 1 do
begin
Item := Items[I];
if Item.Owner = Root then Proc(Item);
end;
end;
procedure TcxWebStyleController.SetName(const NewName: TComponentName);
var
OldName, NewItemName: string;
I, L: Integer;
Item: TcxWebStyleItem;
begin
OldName := Name;
L := Length(OldName);
inherited;
if (csDesigning in ComponentState) and (Count > 0) then
begin
if Designer <> nil then Designer.BeginUpdate;
try
for I := 0 to Count - 1 do
begin
Item := Items[I];
NewItemName := Item.Name;
if Pos(OldName, NewItemName) = 1 then
begin
System.Delete(NewItemName, 1, L);
System.Insert(Name, NewItemName, 1);
try
Item.Name := NewItemName;
except
on EComponentError do ; {Ignore rename errors }
end;
end;
end;
finally
if Designer <> nil then Designer.EndUpdate;
end;
end;
end;
{ IcxStylesProvider }
procedure TcxWebStyleController.GetCSSFiles(HTMLTextBuilder: TcxHTMLTextBuilder; AList: TStrings);
begin
if FCSSFileName <> '' then
AList.Add(FCSSFileName);
end;
procedure TcxWebStyleController.WriteStyles(HTMLTextBuilder: TcxHTMLTextBuilder);
var
I: Integer;
Style: TcxWebStyleItem;
begin
for I := 0 to Count - 1 do
begin
Style := Items[I];
if Style.CSSClassName = '' then
begin
HTMLTextBuilder.WriteStyle(Style.FullName);
Style.WriteHTML(HTMLTextBuilder)
end;
end;
end;
{ IWebVariableName }
function TcxWebStyleController.GetVariableName: string;
begin
Result := ImplGetVariableName;
end;
function TcxWebStyleController.ImplGetVariableName: string;
begin
Result := Name;
end;
procedure TcxWebStyleController.DesignerModified;
begin
if Designer <> nil then Designer.Modified;
end;
procedure TcxWebStyleController.DesignerUpdate(AItem: TcxWebStyleItem);
begin
if Designer <> nil then Designer.Update(AItem);
end;
function TcxWebStyleController.GetCount: Integer;
begin
Result := FItems.Count;
end;
function TcxWebStyleController.GetItem(Index: Integer): TcxWebStyleItem;
begin
Result := TcxWebStyleItem(FItems[Index]);
end;
procedure TcxWebStyleController.SetItem(Index: Integer; Value: TcxWebStyleItem);
begin
Items[Index].Assign(Value);
end;
procedure TcxWebStyleController.InsertItem(Value: TcxWebStyleItem);
begin
FItems.Add(Value);
Value.FController := Self;
end;
procedure TcxWebStyleController.MoveItem(ACurIndex, ANewIndex: Integer);
begin
FItems.Move(ACurIndex, ANewIndex);
DesignerUpdate(nil);
end;
procedure TcxWebStyleController.RemoveItem(Value: TcxWebStyleItem);
begin
Value.FController := nil;
FItems.Remove(Value);
end;
{ TcxWebStyles }
constructor TcxWebStyles.Create(AOwner: TComponent);
begin
inherited Create;
FOwner := AOwner;
end;
procedure TcxWebStyles.Assign(Source: TPersistent);
begin
if Source is TcxWebStyles then
begin
Default := TcxWebStyles(Source).Default;
Hover := TcxWebStyles(Source).Hover;
end
else
inherited;
end;
procedure TcxWebStyles.Notification(AComponent: TComponent; AOperation: TOperation);
begin
if AOperation = opRemove then
begin
if AComponent = Default then Default := nil;
if AComponent = Hover then Hover := nil;
end;
end;
procedure TcxWebStyles.UpdateDesigner;
var
AWebControl: IcxWebControl;
begin
if Supports(Component, IcxWebControl, AWebControl) and
(AWebControl.DesignerControl <> nil) then
AWebControl.DesignerControl.UpdateContext;
end;
procedure TcxWebStyles.SetDefault(Value: TcxWebStyleItem);
begin
if FDefault <> Value then
begin
if FDefault <> nil then
begin
if StyleChanged <> nil then
FDefault.UnregisterClient(StyleChanged);
FDefault.RemoveFreeNotification(Component);
end;
FDefault := Value;
if FDefault <> nil then
begin
FDefault.FreeNotification(Component);
if StyleChanged <> nil then
FDefault.RegisterClient(StyleChanged);
end;
if StyleChanged <> nil then
StyleChanged.StyleChanged(Default); // TODO: redesign
UpdateDesigner;
end;
end;
procedure TcxWebStyles.SetHover(Value: TcxWebStyleItem);
begin
if FHover <> Value then
begin
if FHover <> nil then
begin
if StyleChanged <> nil then
FHover.UnregisterClient(StyleChanged);
FHover.RemoveFreeNotification(Component);
end;
FHover := Value;
if FHover <> nil then
begin
FHover.FreeNotification(Component);
if StyleChanged <> nil then
FHover.RegisterClient(StyleChanged);
end;
if StyleChanged <> nil then
StyleChanged.StyleChanged(Hover); // TODO: redesign
UpdateDesigner;
end;
end;
function TcxWebStyles.GetItem(Index: Integer): TcxWebStyleItem;
begin
Result := nil;
case Index of
0: Result := Default;
1: Result := Hover;
end;
end;
function TcxWebStyles.GetOwner: TPersistent;
begin
Result := FOwner;
end;
function TcxWebStyles.StyleChanged: IcxWebStyleChanged;
begin
if FOwner <> nil then
Supports(FOwner, IcxWebStyleChanged, Result)
else Result := nil;
end;
function TcxWebStyles.ItemCount: Integer;
begin
Result := 2;
end;
{ TAbstractcxWebStyleControllerDesigner }
constructor TAbstractcxWebStyleControllerDesigner.Create(AController: TcxWebStyleController);
begin
FController := AController;
if FController <> nil then
FController.FDesigner := Self;
end;
destructor TAbstractcxWebStyleControllerDesigner.Destroy;
begin
if Controller <> nil then
Controller.FDesigner := nil;
inherited;
end;
initialization
RegisterIntegerConsts(TypeInfo(TcxWebBorderWidth), cxWebIdentToWidth, cxWebWidthToIdent);
RegisterClasses([TcxWebStyleItem, TcxWebStyleController]);
end.
Reference in New Issue View Git Blame Copy Permalink