david
08e42642b8
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@21 05c56307-c608-d34a-929d-697000501d7a
3062 lines
84 KiB
ObjectPascal
3062 lines
84 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ 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.
|
|
|