{*******************************************************************} { } { ExpressWeb Framework by Developer Express } { Designer Module } { } { 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 cb levfnmivil 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 cxWebDsgnCtrls; {$I cxVer.inc} interface uses Classes, {$IFDEF VCL} Forms, ExtCtrls, Windows, Controls, Messages, Graphics, StdCtrls, {$ELSE} QForms, QExtCtrls, Qt, Types, QControls, QGraphics, QStdCtrls, {$ENDIF} cxWebIntf, cxWebDsgnIntf, cxWebDsgnIntfImpl, cxCustomData, cxWebTypes, cxWebModule, cxWebClasses, cxWebGraphics, cxWebControls, cxWebStdCtrls, cxWebDataCtrls, cxWebGrids, cxWebDataNavigator, cxWebTV, cxWebMenus, cxWebMainMenu, cxWebCalendar, cxWebDateEdit, cxWebTable, cxWebDBLookup, cxWebNavBar; type TcxWebDesignControlClass = class of TcxWebDesignControl; TcxWebDesignControl = class(TCustomControl, IInterface, IcxWebDesignerControl, IcxWebDesignerControlNotify, IcxWebDesignerControlUpdatePosition, IcxWebDesignerControlRepaint) private FIsBgPainting: Boolean; FBuffBitmap: TBitmap; FDesignerControlHelper: TcxWebDesignerControlHelper; FOnUpdateConstrolPosition: TUpdateConstrolPositionEvent; FRefCount: Integer; FDefaultWebStyle: TcxWebStyle; FControlWebStyle: TcxWebStyle; function GetControlWebStyle: TcxWebStyle; function IsTransparent: Boolean; {$IFDEF VCL} procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; {$ENDIF} protected {$IFDEF VCL} procedure CreateWnd; override; {$ELSE} function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override; {$ENDIF} procedure Paint; override; procedure DrawBorder(var R: TRect); virtual; procedure DrawBackground; virtual; procedure DrawFace; virtual; procedure DrawInterior(var R: TRect); virtual; function GetDrawStyle(AStyleItem: TcxWebStyleItem; ADefStyle: TcxWebStyle): TcxWebStyle; function GetMainControlStyles: TcxWebStyles; virtual; function GetInternalWebControl: TcxWebControl; overload; virtual; procedure SetOnUpdateConstrolPosition(Value: TUpdateConstrolPositionEvent); { IInterface } function IInterface.QueryInterface = _QueryInterface; function _QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; { IcxWebDesignerControlRepaint } procedure RepaintControl; procedure DefineDefaultWebStyle; virtual; property DesignerControlHelper: TcxWebDesignerControlHelper read FDesignerControlHelper implements IcxWebDesignerControl, IcxWebDesignerControlNotify; property DefaultWebStyle: TcxWebStyle read FDefaultWebStyle; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; property ControlWebStyle: TcxWebStyle read GetControlWebStyle; property WebControl: TcxWebControl read GetInternalWebControl; end; TcxWebDesignCustomControl = class(TcxWebDesignControl) protected procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxWebCustomControl; reintroduce; overload; end; TcxWebDesignLabel = class(TcxWebDesignControl) protected procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebLabel; reintroduce; overload; public property WebLabel: TcxCustomWebLabel read GetInternalWebControl; end; TcxWebDesignButton = class(TcxWebDesignControl) protected procedure DefineDefaultWebStyle; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxWebButton; reintroduce; overload; public property WebButton: TcxWebButton read GetInternalWebControl; end; TcxWebDesignEditControl = class(TcxWebDesignControl) protected function GetControlText: string; virtual; procedure DefineDefaultWebStyle; override; end; TcxWebDesignScrollControl = class(TcxWebDesignEditControl) private FScrollBar: TScrollBar; FPrevRect: TRect; procedure UpdateScrollBar(R: TRect); protected function ShowScrollBar: Boolean; virtual; procedure DrawInterior(var R: TRect); override; public constructor Create(AOwner: TComponent); override; end; TcxWebDesignEdit = class(TcxWebDesignEditControl) protected function GetControlText: string; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebEdit; reintroduce; overload; public property WebEdit: TcxCustomWebEdit read GetInternalWebControl; end; TcxWebDesignMemo = class(TcxWebDesignScrollControl) protected procedure DefineDefaultWebStyle; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebMemo; reintroduce; overload; public property WebMemo: TcxCustomWebMemo read GetInternalWebControl; end; TcxWebDesignListBox = class(TcxWebDesignScrollControl) protected function ShowScrollBar: Boolean; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebListBox; reintroduce; overload; public property WebListBox: TcxCustomWebListBox read GetInternalWebControl; end; TcxWebDesignComboBox = class(TcxWebDesignEditControl) protected function GetControlText: string; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebComboBox; reintroduce; overload; public property WebComboBox: TcxCustomWebComboBox read GetInternalWebControl; end; TcxWebDesignCheckBox = class(TcxWebDesignControl) protected procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebCheckBox; reintroduce; overload; public property WebCheckBox: TcxCustomWebCheckBox read GetInternalWebControl; end; TcxWebDesignRadioGroup = class(TcxWebDesignControl) protected procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebRadioGroup; reintroduce; overload; public property WebRadioGroup: TcxCustomWebRadioGroup read GetInternalWebControl; end; TcxWebDesignImage = class(TcxWebDesignControl) protected procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebImage; reintroduce; overload; public property WebImage: TcxCustomWebImage read GetInternalWebControl; end; TcxWebDesignCustomGrid = class(TcxWebDesignControl) private FBitmaps: array[TcxWebGridButtons] of TBitmap; FGroupDefStyle: TcxWebStyle; FHeaderDefStyle: TcxWebStyle; FIndDefStyle: TcxWebStyle; FStatusDefStyle: TcxWebStyle; FGroupNodeDefStyle: TcxWebStyle; FItemsDefStyle: TcxWebStyle; procedure LoadBitmaps; procedure FreeBitmaps; procedure DrawCell(var R: TRect; ARowIndex, AColIndex: Integer); procedure DrawHeaderCell(var R: TRect; AIndex, AMargin: Integer); procedure DrawGroupNode(R: TRect; ARowIndex: Integer); procedure DrawIndicator(var R: TRect; ABtn1, ABtn2: TcxWebGridButtons); procedure DrawHeader(var R: TRect); procedure DrawGroupPanel(var R: TRect); procedure DrawRow(AIndex: Integer; var R: Trect); procedure DrawStatusPanel(var R: TRect); protected procedure DefineDefaultWebStyle; override; procedure DrawBorder(var R: TRect); override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebGrid; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property WebGrid: TcxCustomWebGrid read GetInternalWebControl; end; TcxWebDesignDataNavigator = class(TcxWebDesignControl) private FBitmaps: array[TcxWebNavigatorButtonType] of TBitmap; FEdStyle: TcxWebStyle; procedure LoadBitmaps; procedure FreeBitmaps; procedure DrawButton(var XPos, YPos: Integer; Index: Integer); procedure DrawEdit(var XPos, YPos: Integer; Text: string); protected procedure DefineDefaultWebStyle; override; procedure DrawFace; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebDataNavigator; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property WebDataNavigator: TcxCustomWebDataNavigator read GetInternalWebControl; end; TcxWebDesignTreeView = class(TcxWebDesignControl) private procedure DrawItems(var R: TRect; AItem: TcxWebTreeItem); protected procedure DrawBorder(var R: TRect); override; procedure DefineDefaultWebStyle; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxWebTreeView; reintroduce; overload; public property WebTreeView: TcxWebTreeView read GetInternalWebControl; end; TcxWebDesignPanel = class(TcxWebDesignControl) protected procedure DefineDefaultWebStyle; override; procedure DrawBorder(var R: TRect); override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxWebPanel; reintroduce; overload; public constructor Create(AOwner: TComponent); override; property Panel: TcxWebPanel read GetInternalWebControl; end; TcxWebDesignMainMenu = class(TcxWebDesignControl) private procedure DrawEmptyMenu(R: TRect); procedure DrawMenuItem(R: TRect; AItem: TcxWebMenuItem); protected procedure DefineDefaultWebStyle; override; procedure DrawBorder(var R: TRect); override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxWebMainMenu; reintroduce; overload; public property WebMainMenu: TcxWebMainMenu read GetInternalWebControl; end; TcxWebDesignCalendar = class(TcxWebDesignControl) private FDayHeaderDefStyle: TcxWebStyle; FOtherMonthDayDefStyle: TcxWebStyle; FSelectedDefStyle: TcxWebStyle; FTitleDefStyle: TcxWebStyle; FTodayPanelDefStyle: TcxWebStyle; procedure DrawFooter(var R: TRect); procedure DrawSheet(var R: TRect); procedure DrawHeader(var R: TRect); procedure DrawTitle(var R: TRect); protected procedure DefineDefaultWebStyle; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxCustomWebCalendar; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property WebCalendar: TcxCustomWebCalendar read GetInternalWebControl; end; TcxWebDesignDateEdit = class(TcxWebDesignEditControl) private FButtonImage: TBitmap; FButtonDefStyle: TcxWebStyle; procedure DrawButton(var R: TRect); protected function GetMainControlStyles: TcxWebStyles; override; procedure DefineDefaultWebStyle; override; procedure DrawFace; override; function GetControlText: string; override; function GetInternalWebControl: TcxCustomWebDateEdit; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property WebDateEdit: TcxCustomWebDateEdit read GetInternalWebControl; end; TcxAccessWebTable = class(TcxCustomWebTable); TcxWebDesignCustomTable = class(TcxWebDesignControl) private FPagingDefStyle: TcxWebStyle; FPagingNumDefStyle: TcxWebStyle; FItemsDefStyle: TcxWebStyle; FHeaderDefStyle: TcxWebStyle; function GetColumnWidth(AColumn: TcxCustomWebTableColumn): Integer; procedure DrawPaging(ARect: TRect); procedure DrawPagings(var ARect: TRect); procedure DrawHeader(var ARect: TRect); procedure DrawCell(Index: Integer; AStyle: TcxWebStyle; AAlignment: TcxWebHorzAlignment; Text: string; var ARect: TRect); procedure DrawItems(var ARect: TRect); procedure DrawRow(AIndex: Integer; var ARect: TRect); protected procedure DefineDefaultWebStyle; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxAccessWebTable; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Table: TcxAccessWebTable read GetInternalWebControl; end; TcxWebDesignExtDBLookup = class(TcxWebDesignEditControl) private FButtonImage: TBitmap; FButtonDefStyle: TcxWebStyle; procedure DrawButton(var R: TRect); protected function GetMainControlStyles: TcxWebStyles; override; procedure DefineDefaultWebStyle; override; procedure DrawFace; override; function GetControlText: string; override; function GetInternalWebControl: TcxWebExtDBLookup; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property WebExtDBLookup: TcxWebExtDBLookup read GetInternalWebControl; end; TcxWebDesignNavBar = class(TcxWebDesignControl) private FHeaderDefStyle: TcxWebStyle; FColHeaderDefStyle: TcxWebStyle; FLeftColImage, FLeftExpImage: TBitmap; FRightColImage, FRightExpImage: TBitmap; procedure DrawGroup(Index: Integer; var XPos, YPos: Integer); procedure DrawGroupHeader(Index: Integer; var XPos, YPos: Integer); procedure DrawGroupBody(Index: Integer; var XPos, YPos: Integer); protected procedure DefineDefaultWebStyle; override; procedure DrawFace; override; procedure DrawInterior(var R: TRect); override; function GetInternalWebControl: TcxWebNavBar; reintroduce; overload; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property WebNavBar: TcxWebNavBar read GetInternalWebControl; end; implementation {$R cxWebNavImgs.res} {$R cxWebGridImgs.res} uses SysUtils, ToolsAPI, DateUtils, cxWebUtils, cxWebDsgnConsts, cxWebDsgnGraphics, cxWebColors, cxWebCtrlsFactory, Math, cxWebDsgnUtils, cxWebMetrics; { utilities } type TCanvasAccess = class(TCanvas); TCustomControlAccess = class(TCustomControl); TcxTextHAlignment = (thaNone, thaLeft, thaRight, thaCenter); TcxTextVAlignment = (tvaNone, tvaTop, tvaBottom, tvaCenter); TcxBorderEdge = (cxbeLeft, cxbeTop, cxbeRight, cxbeBottom); TcxBorderEdges = set of TcxBorderEdge; PTrapezium = ^TTrapezium; TTrapezium = array[0..3] of TPoint; TcxAbstractStylePainter = class protected class function GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; virtual; class function GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; virtual; class function GetWidth(const R: TRect; AEdge: TcxBorderEdge): Integer; class function IsTopLeft(AEdge: TcxBorderEdge): Boolean; class function IsVertical(AEdge: TcxBorderEdge): Boolean; public class procedure PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); virtual; end; TcxStylePainterClass = class of TcxAbstractStylePainter; TcxSolidStylePainter = class(TcxAbstractStylePainter) public class procedure PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); override; end; TcxDottedStylePainter = class(TcxAbstractStylePainter) public class procedure PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); override; end; TcxDashedStylePainter = class(TcxAbstractStylePainter) public class procedure PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); override; end; TcxDoubleStylePainter = class(TcxAbstractStylePainter) public class procedure PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); override; end; TcxGrooveStylePainter = class(TcxAbstractStylePainter) protected class function GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; override; class function GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; override; public class procedure PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); override; end; TcxRidgeStylePainter = class(TcxGrooveStylePainter) protected class function GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; override; class function GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; override; end; TcxInsetStylePainter = class(TcxGrooveStylePainter) protected class function GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; override; class function GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; override; end; TcxOutsetStylePainter = class(TcxInsetStylePainter) protected class function GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; override; class function GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; override; end; TcxBaseBorderPainter = class private FPoints: TTrapezium; function GetPaintRect: TRect; protected procedure CalcTrapezium(OuterRect, InnerRect: TRect); virtual; abstract; function GetEdge: TcxBorderEdge; virtual; abstract; public procedure DrawBorderEdge(ACanvas: TCanvas; ABorder: TcxWebBorder); constructor Create(OuterRect, InnerRect: TRect); end; TcxTopBorderPainter = class(TcxBaseBorderPainter) protected procedure CalcTrapezium(OuterRect, InnerRect: TRect); override; function GetEdge: TcxBorderEdge; override; end; TcxLeftBorderPainter = class(TcxBaseBorderPainter) protected procedure CalcTrapezium(OuterRect, InnerRect: TRect); override; function GetEdge: TcxBorderEdge; override; end; TcxBottomBorderPainter = class(TcxBaseBorderPainter) protected procedure CalcTrapezium(OuterRect, InnerRect: TRect); override; function GetEdge: TcxBorderEdge; override; end; TcxRightBorderPainter = class(TcxBaseBorderPainter) protected procedure CalcTrapezium(OuterRect, InnerRect: TRect); override; function GetEdge: TcxBorderEdge; override; end; const cxStylePainters: array[TcxWebBorderStyle] of TcxStylePainterClass = (nil, TcxSolidStylePainter, TcxDottedStylePainter, TcxDashedStylePainter, TcxDoubleStylePainter, TcxGrooveStylePainter, TcxRidgeStylePainter, TcxInsetStylePainter, TcxOutsetStylePainter); var FCanvasBrush: TBrush; FCanvasCopyMode: TCopyMode; FCanvasFont: TFont; FCanvasPen: TPen; procedure StoreCanvas(ACanvas: TCanvas); begin with ACanvas do begin FCanvasBrush.Assign(Brush); FCanvasCopyMode := CopyMode; FCanvasFont.Assign(Font); FCanvasPen.Assign(Pen); end; end; procedure RestoreCanvas(ACanvas: TCanvas); begin ACanvas.Lock; try ACanvas.Brush := FCanvasBrush; ACanvas.CopyMode := FCanvasCopyMode; ACanvas.Font := FCanvasFont; ACanvas.Pen := FCanvasPen; finally ACanvas.Unlock; end; end; {$IFNDEF VCL} function GetRValue(Color: Integer): Byte; begin Result := Byte(Color); end; function GetGValue(Color: Integer): Byte; begin Result := Byte(Color shr 8); end; function GetBValue(Color: Integer): Byte; begin Result := Byte(Color shr 16); end; function RGB(R, G, B: Byte): Integer; begin Result := (R or (G shl 8) or (B shl 16)); end; function ColorToRGB(Color: TColor): Longint; var R, G, B: Byte; begin Result := QGraphics.ColorToRGB(Color); if Color < 0 then begin R := GetRValue(Result); G := GetGValue(Result); B := GetBValue(Result); Result := RGB(B, G, R); end; end; {$ENDIF} function cxGetShadowColor(AColor: TColor): TColor; var RGBValue: Cardinal; begin RGBValue := ColorToRGB(AColor); Result := RGB(GetRValue(RGBValue) div 4 * 3, GetGValue(RGBValue) div 4 * 3, GetBValue(RGBValue) div 4 * 3); end; function cxGetDarkColor(AColor: TColor): TColor; var RGBValue: Cardinal; begin RGBValue := ColorToRGB(AColor); Result := RGB(GetRValue(RGBValue) div 2, GetGValue(RGBValue) div 2, GetBValue(RGBValue) div 2); end; function cxGetDarkDarkColor(AColor: TColor): TColor; begin Result := cxGetDarkColor(cxGetDarkColor(AColor)); end; procedure DoTextRect(ACanvas: TCanvas; const ARect: TRect; const X, Y: Integer; const AText: string; const AHorzAlignment: TcxTextHAlignment = thaNone; const AVertAlignment: TcxTextVAlignment = tvaNone; AWordBreak: Boolean = False); const {$IFDEF VCL} HAlignments: array[TcxTextHAlignment] of Integer = (0, DT_LEFT, DT_RIGHT, DT_CENTER); VAlignments: array[TcxTextVAlignment] of Integer = (0, DT_TOP, DT_BOTTOM, DT_VCENTER); {$ELSE} HAlignments: array[TcxTextHAlignment] of Integer = (0, Ord(AlignmentFlags_AlignLeft), Ord(AlignmentFlags_AlignRight), Ord(AlignmentFlags_AlignHCenter)); VAlignments: array[TcxTextVAlignment] of Integer = (0, Ord(AlignmentFlags_AlignTop), Ord(AlignmentFlags_AlignBottom), Ord(AlignmentFlags_AlignVCenter)); {$ENDIF} var Flags: Integer; {$IFDEF VCL} R: TRect; {$ENDIF} begin Flags := HAlignments[AHorzAlignment] or VAlignments[AVertAlignment]; if AVertAlignment <> tvaNone then Flags := Flags or {$IFDEF VCL}DT_SINGLELINE{$ELSE}Ord(AlignmentFlags_SingleLine){$ENDIF}; if AWordBreak then Flags := Flags or {$IFDEF VCL}DT_WORDBREAK{$ELSE}Ord(AlignmentFlags_WordBreak){$ENDIF}; {$IFDEF VCL} R.Left := X; R.Top := Y; R.Right := ARect.Right; R.Bottom := ARect.Bottom; DrawText(ACanvas.Handle, PChar(AText), Length(AText), R, Flags); {$ELSE} ACanvas.TextRect(ARect, X, Y, AText, Flags); {$ENDIF} end; procedure DrawFrame(ACanvas: TCanvas; AColor: TColor; var R: TRect); begin StoreCanvas(ACanvas); try with ACanvas do begin Pen.Style := psSolid; Pen.Color := AColor; Brush.Style := bsClear; Rectangle(R); end; InflateRect(R, -1, -1); finally RestoreCanvas(ACanvas); end; end; function CalcStylishTextExtent(ACanvas: TCanvas; AStyle: TcxWebStyle; const AText: string): TSize; var SaveFont: TFont; begin SaveFont := TFont.Create; try SaveFont.Assign(ACanvas.Font); try if AStyle <> nil then WebFontToFont(AStyle.Font, ACanvas.Font); Result := ACanvas.TextExtent(AText); finally ACanvas.Font := SaveFont; end; finally SaveFont.Free; end; end; { TcxBaseBorderPainter } constructor TcxBaseBorderPainter.Create(OuterRect, InnerRect: TRect); begin inherited Create; CalcTrapezium(OuterRect, InnerRect); end; function TcxBaseBorderPainter.GetPaintRect: TRect; function Min(const Data: array of Integer): Integer; var I: Integer; begin Result := Data[Low(Data)]; for I := Low(Data) + 1 to High(Data) do if Result > Data[I] then Result := Data[I]; end; function Max(const Data: array of Integer): Integer; var I: Integer; begin Result := Data[Low(Data)]; for I := Low(Data) + 1 to High(Data) do if Result < Data[I] then Result := Data[I]; end; begin Result.Left := Min([FPoints[0].X, FPoints[1].X, FPoints[2].X, FPoints[3].X]); Result.Top := Min([FPoints[0].Y, FPoints[1].Y, FPoints[2].Y, FPoints[3].Y]); Result.Right := Max([FPoints[0].X, FPoints[1].X, FPoints[2].X, FPoints[3].X]); Result.Bottom := Max([FPoints[0].Y, FPoints[1].Y, FPoints[2].Y, FPoints[3].Y]); end; procedure TcxBaseBorderPainter.DrawBorderEdge(ACanvas: TCanvas; ABorder: TcxWebBorder); var SaveRgn, DrawRgn: {$IFDEF VCL}HRGN{$ELSE}QRegionH{$ENDIF}; {$IFDEF VCL} ClipRgnExists: Boolean; {$ELSE} I: Integer; Points: TPointArray; {$ENDIF} begin if cxStylePainters[ABorder.Style] = nil then Exit; {$IFDEF VCL} SaveRgn := CreateRectRgn(0, 0, 0, 0); ClipRgnExists := GetClipRgn(ACanvas.Handle, SaveRgn) = 1; {$ELSE} SaveRgn := QRegion_create(QPainter_clipRegion(ACanvas.Handle)); {$ENDIF} try {$IFDEF VCL} DrawRgn := CreatePolygonRgn(FPoints, 4, WINDING); SelectClipRgn(ACanvas.Handle, DrawRgn); DeleteObject(DrawRgn); {$ELSE} SetLength(Points, High(FPoints) + 1); for I := Low(FPoints) to High(FPoints) do Points[I] := FPoints[I]; DrawRgn := QRegion_create(@Points[0], True); QPainter_setClipRegion(ACanvas.Handle, DrawRgn); QRegion_destroy(DrawRgn); {$ENDIF} cxStylePainters[ABorder.Style].PaintRect(ACanvas, GetPaintRect, ABorder.Color, GetEdge); finally {$IFDEF VCL} if ClipRgnExists then SelectClipRgn(ACanvas.Handle, SaveRgn) else SelectClipRgn(ACanvas.Handle, 0); DeleteObject(SaveRgn); {$ELSE} QPainter_setClipRegion(ACanvas.Handle, SaveRgn); QRegion_destroy(SaveRgn); {$ENDIF} end; end; { TcxBottomBorderPainter } procedure TcxBottomBorderPainter.CalcTrapezium(OuterRect, InnerRect: TRect); begin FPoints[0] := Point(InnerRect.Left, InnerRect.Bottom); FPoints[1] := InnerRect.BottomRight; FPoints[2] := OuterRect.BottomRight; FPoints[3] := Point(OuterRect.Left, OuterRect.Bottom); end; function TcxBottomBorderPainter.GetEdge: TcxBorderEdge; begin Result := cxbeBottom; end; { TcxLeftBorderPainter } procedure TcxLeftBorderPainter.CalcTrapezium(OuterRect, InnerRect: TRect); begin FPoints[0] := OuterRect.TopLeft; FPoints[1] := InnerRect.TopLeft; FPoints[2] := Point(InnerRect.Left, InnerRect.Bottom); FPoints[3] := Point(OuterRect.Left, OuterRect.Bottom); end; function TcxLeftBorderPainter.GetEdge: TcxBorderEdge; begin Result := cxbeLeft; end; { TcxRightBorderPainter } procedure TcxRightBorderPainter.CalcTrapezium(OuterRect, InnerRect: TRect); begin FPoints[0] := Point(InnerRect.Right, InnerRect.Top); FPoints[1] := Point(OuterRect.Right, OuterRect.Top); FPoints[2] := OuterRect.BottomRight; FPoints[3] := InnerRect.BottomRight; end; function TcxRightBorderPainter.GetEdge: TcxBorderEdge; begin Result := cxbeRight; end; { TcxTopBorderPainter } procedure TcxTopBorderPainter.CalcTrapezium(OuterRect, InnerRect: TRect); begin FPoints[0] := OuterRect.TopLeft; FPoints[1] := Point(OuterRect.Right, OuterRect.Top); FPoints[2] := Point(InnerRect.Right, InnerRect.Top); FPoints[3] := InnerRect.TopLeft; end; function TcxTopBorderPainter.GetEdge: TcxBorderEdge; begin Result := cxbeTop; end; { TcxAbstractStylePainter } class function TcxAbstractStylePainter.GetFirstColor( AColor: TColor; TopLeft: Boolean): TColor; begin Result := AColor; end; class function TcxAbstractStylePainter.GetSecondColor( AColor: TColor; TopLeft: Boolean): TColor; begin Result := AColor; end; class function TcxAbstractStylePainter.GetWidth( const R: TRect; AEdge: TcxBorderEdge): Integer; begin if IsVertical(AEdge) then Result := R.Right - R.Left else Result := R.Bottom - R.Top; end; class function TcxAbstractStylePainter.IsTopLeft( AEdge: TcxBorderEdge): Boolean; begin Result := AEdge in [cxbeLeft, cxbeTop]; end; class function TcxAbstractStylePainter.IsVertical( AEdge: TcxBorderEdge): Boolean; begin Result := AEdge in [cxbeLeft, cxbeRight]; end; class procedure TcxAbstractStylePainter.PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); begin with ACanvas do begin Brush.Style := bsSolid; Brush.Color := GetFirstColor(ABaseColor, IsTopLeft(AEdge)); Pen.Style := psClear; end; end; { TcxSolidStylePainter } class procedure TcxSolidStylePainter.PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); begin inherited; ACanvas.FillRect(R); end; { TcxDottedStylePainter } class procedure TcxDottedStylePainter.PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); var Width: Integer; I, Count, Len: Integer; DeltaX, DeltaY: Single; begin inherited; DeltaX := 0; DeltaY := 0; Width := GetWidth(R, AEdge); if IsVertical(AEdge) then Len := R.Bottom - R.Top - Width else Len := R.Right - R.Left - Width; Count := Len div (Width * 2); if Count = 0 then Count := 1; if IsVertical(AEdge) then DeltaY := Len / Count else DeltaX := Len / Count; for I := 0 to Count do if Width > 2 then ACanvas.Ellipse(Bounds(R.Left + Trunc(DeltaX * I), R.Top + Trunc(DeltaY * I), Width + 1, Width + 1)) else ACanvas.FillRect(Bounds(R.Left + Trunc(DeltaX * I), R.Top + Trunc(DeltaY * I), Width, Width)); end; { TcxDashedStylePainter } class procedure TcxDashedStylePainter.PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); var Width: Integer; I, Count, Len: Integer; DeltaX, DeltaY: Single; begin inherited; DeltaX := 0; DeltaY := 0; Width := GetWidth(R, AEdge); if IsVertical(AEdge) then Len := R.Bottom - R.Top - Width * 2 else Len := R.Right - R.Left - Width * 2; Count := Len div (Width * 3); if Count = 0 then Count := 1; if IsVertical(AEdge) then DeltaY := Len / Count else DeltaX := Len / Count; for I := 0 to Count do ACanvas.FillRect(Bounds(R.Left + Trunc(DeltaX * I), R.Top + Trunc(DeltaY * I), Width * 2, Width * 2)); end; { TcxDoubleStylePainter } class procedure TcxDoubleStylePainter.PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); var Width: Integer; begin inherited; Width := GetWidth(R, AEdge); if IsVertical(AEdge) then begin ACanvas.FillRect(Bounds(R.Left, R.Top, (Width + 2) div 3, R.Bottom - R.Top)); ACanvas.FillRect(Rect(R.Right - (Width + 2) div 3, R.Top, R.Right, R.Bottom)); end else begin ACanvas.FillRect(Bounds(R.Left, R.Top, R.Right - R.Left, (Width + 2) div 3)); ACanvas.FillRect(Rect(R.Left, R.Bottom - (Width + 2) div 3, R.Right, R.Bottom)); end; end; { TcxGrooveStylePainter } class function TcxGrooveStylePainter.GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; begin Result := AColor end; class function TcxGrooveStylePainter.GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; begin Result := cxGetDarkDarkColor(AColor) end; class procedure TcxGrooveStylePainter.PaintRect(ACanvas: TCanvas; R: TRect; ABaseColor: TColor; AEdge: TcxBorderEdge); var Width: Integer; begin inherited; ACanvas.FillRect(R); ACanvas.Brush.Color := GetSecondColor(ABaseColor, IsTopLeft(AEdge)); Width := GetWidth(R, AEdge); if IsVertical(AEdge) then ACanvas.FillRect(Bounds(R.Left, R.Top, (Width + 1) div 2, R.Bottom - R.Top)) else ACanvas.FillRect(Bounds(R.Left, R.Top, R.Right - R.Left, (Width + 1) div 2)); end; { TcxRidgeStylePainter } class function TcxRidgeStylePainter.GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; begin Result := cxGetDarkColor(AColor) end; class function TcxRidgeStylePainter.GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; begin Result := cxGetShadowColor(AColor) end; { TcxInsetStylePainter } class function TcxInsetStylePainter.GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; begin if TopLeft then Result := cxGetDarkColor(AColor) else Result := AColor; end; class function TcxInsetStylePainter.GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; begin if TopLeft then Result := cxGetDarkDarkColor(AColor) else Result := cxGetShadowColor(AColor); end; { TcxOutsetStylePainter } class function TcxOutsetStylePainter.GetFirstColor(AColor: TColor; TopLeft: Boolean): TColor; begin Result := inherited GetFirstColor(AColor, not TopLeft); end; class function TcxOutsetStylePainter.GetSecondColor(AColor: TColor; TopLeft: Boolean): TColor; begin Result := inherited GetSecondColor(AColor, not TopLeft); end; procedure DrawBorderEdges(ACanvas: TCanvas; ABorders: TcxWebBorders; InRect, OutRect: TRect; AEdges: TcxBorderEdges); begin if (cxbeLeft in AEdges) and (InRect.Left <> OutRect.Left)then with TcxLeftBorderPainter.Create(OutRect, InRect) do try DrawBorderEdge(ACanvas, ABorders.Left); finally Free; end; if (cxbeTop in AEdges) and (InRect.Top <> OutRect.Top) then with TcxTopBorderPainter.Create(OutRect, InRect) do try DrawBorderEdge(ACanvas, ABorders.Top); finally Free; end; if (cxbeRight in AEdges) and (InRect.Right <> OutRect.Right) then with TcxRightBorderPainter.Create(OutRect, InRect) do try DrawBorderEdge(ACanvas, ABorders.Right); finally Free; end; if (cxbeBottom in AEdges) and (InRect.Bottom <> OutRect.Bottom) then with TcxBottomBorderPainter.Create(OutRect, InRect) do try DrawBorderEdge(ACanvas, ABorders.Bottom); finally Free; end; end; procedure DrawStylishBorder(ACanvas: TCanvas; AStyleBorders: TcxWebBorders; var R: TRect); function GetBorderWidth(ABorder: TcxWebBorder): Integer; begin if (wbavStyle in ABorder.AssignedValues) and (ABorder.Style <> wbsNone) and (wbavWidth in ABorder.AssignedValues) then Result := ABorder.Width else Result := 0; end; var NewRect: TRect; begin if AStyleBorders <> nil then begin StoreCanvas(ACanvas); try NewRect := Rect(R.Left + GetBorderWidth(AStyleBorders.Left), R.Top + GetBorderWidth(AStyleBorders.Top), R.Right - GetBorderWidth(AStyleBorders.Right), R.Bottom - GetBorderWidth(AStyleBorders.Bottom)); DrawBorderEdges(ACanvas, AStyleBorders, NewRect, R, [cxbeLeft, cxbeTop, cxbeRight, cxbeBottom]); R := NewRect; finally RestoreCanvas(ACanvas); end; end; end; procedure DrawStylishText(ACanvas: TCanvas; R: TRect; AStyle: TcxWebStyle; const AText: string; AHorzAlignment: TcxTextHAlignment = thaNone; AVertAlignment: TcxTextVAlignment = tvaNone; AFill: Boolean = True); begin StoreCanvas(ACanvas); try with ACanvas do if AStyle <> nil then begin WebFontToFont(AStyle.Font, Font); if AFill and (wsavColor in AStyle.Shading.AssignedValues) then begin Brush.Style := bsSolid; Brush.Color := AStyle.Shading.Color; FillRect(R); end else Brush.Style := bsClear; end else begin Brush.Style := bsClear; Font.Color := clBlack; Font.Style := []; end; DoTextRect(ACanvas, R, R.Left, R.Top, AText, AHorzAlignment, AVertAlignment); finally RestoreCanvas(ACanvas); end; end; function GetDrawTextFlagByAlignment(AHorzAlignment: TcxWebHorzAlignment): Integer; const {$IFDEF VCL} Formats: Array[TcxWebHorzAlignment] of Integer = (DT_LEFT, DT_CENTER, DT_RIGHT, DT_CENTER, DT_CENTER); {$ELSE} Formats: Array[TcxWebHorzAlignment] of AlignmentFlags = (AlignmentFlags_AlignLeft, AlignmentFlags_AlignHCenter, AlignmentFlags_AlignRight, AlignmentFlags_AlignHCenter, AlignmentFlags_AlignHCenter); {$ENDIF} begin Result := Integer(Formats[AHorzAlignment]); end; procedure FrameRect(const ACanvas: TCanvas; var ARect: TRect); {$IFDEF VCL} begin ACanvas.FrameRect(ARect); {$ELSE} var R: TRect; begin R := ARect; R.Right := R.Left + 1; ACanvas.FillRect(R); R := ARect; R.Bottom := R.Top + 1; ACanvas.FillRect(R); R := ARect; R.Left := R.Right - 1; ACanvas.FillRect(R); R := ARect; R.Top := R.Bottom - 1; ACanvas.FillRect(R); InflateRect(ARect, -1, -1); {$ENDIF} end; { TcxWebDesignControl } constructor TcxWebDesignControl.Create(AOwner: TComponent); begin FRefCount := 0; FIsBgPainting := False; inherited Create(AOwner); FBuffBitmap := TBitmap.Create; FDesignerControlHelper := TcxWebDesignerControlHelper.Create(self); ControlStyle := ControlStyle + [csOpaque]; {$IFNDEF VCL} ControlStyle := ControlStyle + [csNoFocus]; {$ENDIF} FDefaultWebStyle := TcxWebStyle.Create(nil); DefineDefaultWebStyle; FControlWebStyle := TcxWebStyle.Create(nil); end; destructor TcxWebDesignControl.Destroy; begin FRefCount := 0; if (WebControl <> nil) and not (csDestroying in WebControl.ComponentState) then (WebControl as IcxWebControl).DesignerControl := nil; FDesignerControlHelper.Free; FDefaultWebStyle.Free; FControlWebStyle.Free; FBuffBitmap.Free; inherited Destroy; end; function TcxWebDesignControl.GetInternalWebControl: TcxWebControl; var AComponent: TComponent; begin AComponent := GetComponentByInterface(FDesignerControlHelper.WebControl); if(AComponent <> nil) and (AComponent is TcxWebControl) then Result := TcxWebControl(AComponent) else Result := nil; end; procedure TcxWebDesignControl.SetOnUpdateConstrolPosition(Value: TUpdateConstrolPositionEvent); begin FOnUpdateConstrolPosition := Value; end; { IInterface } function TcxWebDesignControl._QueryInterface(const IID: TGUID; out Obj): HResult; begin Result := inherited QueryInterface(IID, Obj) end; function TcxWebDesignControl._AddRef: Integer; begin Inc(FRefCount); Result := FRefCount; end; function TcxWebDesignControl._Release: Integer; begin Dec(FRefCount); Result := FRefCount; if Result = 0 then Free; end; procedure TcxWebDesignControl.RepaintControl; begin if IsTransparent then Invalidate; end; procedure TcxWebDesignControl.DefineDefaultWebStyle; begin with DefaultWebStyle do begin Shading.AssignedValues := []; Numbering.AssignedValues := []; Borders.Color := clBlack; Borders.Width := 4; Borders.Style := wbsNone; Borders.Left.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Top.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Right.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Bottom.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; end; end; type TWinControlAccess = class(TWinControl); {$IFDEF VCL} procedure TcxWebDesignControl.CreateWnd; begin inherited CreateWnd; if HandleAllocated then EnableWindow(Handle, False); end; {$ELSE} function TcxWebDesignControl.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; begin if (Parent <> nil) and (QEvent_type(Event) in [QEventType_MouseButtonPress, QEventType_MouseButtonRelease, QEventType_MouseButtonDblClick, QEventType_MouseMove]) then begin QApplication_sendEvent(Parent.Handle, Event); Result := False; end else Result := inherited EventFilter(Sender, Event); end; {$ENDIF} {$IFNDEF VCL} function RectVisible(Handle: QPainterH; const R: TRect): Boolean; begin Result := not QPainter_hasClipping(Handle); if Result then Result := not IsRectEmpty(R) else Result := QRegion_contains(QPainter_clipRegion(Handle), PRect(@R)); end; {$ENDIF} procedure TcxWebDesignControl.Paint; begin if not RectVisible(Canvas.Handle, ClientRect) or FIsBgPainting then Exit; DrawBackground; DrawFace; FDesignerControlHelper.DrawSelectionMarks; end; procedure TcxWebDesignControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); var ARect: TRect; AUpdate: Boolean; begin SetRect(ARect, ALeft, ATop, ALeft + AWidth, ATop + AHeight); if (FDesignerControlHelper.WebControl <> nil) and not EqualRect(ARect, FDesignerControlHelper.WebControl.BoundsRect) then FDesignerControlHelper.WebControl.BoundsRect := ARect else begin inherited SetBounds(ALeft, ATop, AWidth, AHeight); if Assigned(FOnUpdateConstrolPosition) then begin AUpdate := True; FOnUpdateConstrolPosition(AUpdate); if AUpdate then WebControl.UpdateControlPosition; end; end; end; procedure TcxWebDesignControl.DrawBorder(var R: TRect); begin DrawStylishBorder(Canvas, ControlWebStyle.Borders, R); end; procedure TcxWebDesignControl.DrawBackground; begin if not IsTransparent then Exit; FIsBgPainting := True; try {$IFDEF VCL} TCustomControlAccess(Parent).PaintTo(Canvas.Handle, -Left, -Top); {$ELSE} //TODO: LINUX NOT IMPLEMENTED Canvas.Brush.Style := bsClear; Canvas.FillRect(ClientRect); {$ENDIF} finally FIsBgPainting := False; end; end; procedure TcxWebDesignControl.DrawFace; var R: TRect; begin R := ClientRect; if not IsTransparent then begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := WebColorToColor(ControlWebStyle.Shading.Color); Canvas.FillRect(R); end else Canvas.Brush.Style := bsClear; WebFontToFont(ControlWebStyle.Font, Canvas.Font); DrawBorder(R); DrawInterior(R); end; procedure TcxWebDesignControl.DrawInterior(var R: TRect); begin end; {$IFDEF VCL} procedure TcxWebDesignControl.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin DefaultHandler(Message); end; {$ENDIF} function TcxWebDesignControl.GetControlWebStyle: TcxWebStyle; begin if GetMainControlStyles.Default <> nil then begin FControlWebStyle.Assign(GetMainControlStyles.Default.Style); FControlWebStyle.Merge(FDefaultWebStyle); end else FControlWebStyle.Assign(FDefaultWebStyle); Result := FControlWebStyle; end; function TcxWebDesignControl.IsTransparent: Boolean; begin Result := not (wsavColor in ControlWebStyle.Shading.AssignedValues); end; function TcxWebDesignControl.GetDrawStyle(AStyleItem: TcxWebStyleItem; ADefStyle: TcxWebStyle): TcxWebStyle; begin Result := TcxWebStyle.Create(nil); if AStyleItem <> nil then begin Result.Assign(AStyleItem.Style); Result.Merge(ADefStyle); end else Result.Assign(ADefStyle); end; function TcxWebDesignControl.GetMainControlStyles: TcxWebStyles; begin Result := WebControl.Styles; end; { TcxWebDesignCustomControl } procedure TcxWebDesignCustomControl.DrawInterior(var R: TRect); begin inherited; with Canvas do begin Brush.Color := clBtnShadow; Brush.Style := bsBDiagonal; Pen.Color := clBtnShadow; Pen.Style := psSolid; Pen.Width := 1; Rectangle(R); DoTextRect(Canvas, R, R.Left, R.Top, WebControl.Name, thaCenter, tvaCenter); end; end; function TcxWebDesignCustomControl.GetInternalWebControl: TcxWebCustomControl; begin Result := inherited GetInternalWebControl as TcxWebCustomControl; end; { TcxWebDesignLabel } procedure TcxWebDesignLabel.DrawInterior(var R: TRect); var Alignment: TcxTextHAlignment; begin inherited; if (WebLabel is TcxWebURLLabel) and (TcxWebURLLabel(WebLabel).URL.Href <> '') then Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; case WebLabel.Alignment of whalCenter: Alignment := thaCenter; whalLeft: Alignment := thaLeft; whalRight: Alignment := thaRight; else Alignment := thaNone; end; DoTextRect(Canvas, R, R.Left, R.Top, WebLabel.Caption, Alignment, tvaNone, WebLabel.WordWrap); end; function TcxWebDesignLabel.GetInternalWebControl: TcxCustomWebLabel; begin Result := inherited GetInternalWebControl as TcxCustomWebLabel; end; { TcxWebDesignButton } procedure TcxWebDesignButton.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Color := clWebButtonHighlight; Borders.Width := 2; Borders.Style := wbsOutset; Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; Font.Name := 'MS Sans Serif'; Font.Size.Value := 10; end; end; procedure TcxWebDesignButton.DrawInterior(var R: TRect); begin inherited; DoTextRect(Canvas, R, R.Left, R.Top, WebButton.Caption, thaCenter, tvaCenter); end; function TcxWebDesignButton.GetInternalWebControl: TcxWebButton; begin Result := inherited GetInternalWebControl as TcxWebButton; end; { TcxWebDesignEditControl } procedure TcxWebDesignEditControl.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Color := clWebButtonHighlight; Borders.Style := wbsInset; Borders.Width := 2; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; Font.Name := 'MS Sans Serif'; Font.Size.Value := 10; end; end; function TcxWebDesignEditControl.GetControlText: string; begin Result := ''; end; { TcxWebDesignScrollControl } constructor TcxWebDesignScrollControl.Create(AOwner: TComponent); begin inherited; FScrollBar := TScrollBar.Create(Self); FScrollBar.ControlStyle := FScrollBar.ControlStyle - [csFramed]; {$IFNDEF VCL} FScrollBar.ParentColor := False; {$ENDIF} FScrollBar.Visible := False; FScrollBar.Kind := sbVertical; FScrollBar.Parent := Self; FScrollBar.SetParams(0, 0, 1); FPrevRect := Bounds(0, 0, 0, 0); end; procedure TcxWebDesignScrollControl.DrawInterior(var R: TRect); begin if not EqualRect(R, FPrevRect) then begin UpdateScrollBar(R); FPrevRect := R; end; if FScrollBar.Visible then R.Right := R.Right - FScrollBar.Width; inherited; end; function TcxWebDesignScrollControl.ShowScrollBar: Boolean; begin Result := WebControl <> nil; end; procedure TcxWebDesignScrollControl.UpdateScrollBar(R: TRect); begin if FScrollBar = nil then Exit; if ShowScrollBar then begin FScrollBar.SetBounds(R.Right - FScrollBar.Width, R.Top, FScrollBar.Width, R.Bottom - R.Top); FScrollBar.Visible := True; end else FScrollBar.Visible := False; end; { TcxWebDesignEdit } procedure TcxWebDesignEdit.DrawInterior(var R: TRect); begin inherited; DoTextRect(Canvas, R, R.Left + 2, R.Top, GetControlText, thaLeft, tvaCenter); end; function TcxWebDesignEdit.GetControlText: string; var I: Integer; begin if WebEdit.Password then begin SetLength(Result, Length(WebEdit.Text)); for I := 1 to Length(Result) do Result[I] := '*'; end else Result := WebEdit.Text; end; function TcxWebDesignEdit.GetInternalWebControl: TcxCustomWebEdit; begin Result := inherited GetInternalWebControl as TcxCustomWebEdit; end; { TcxWebDesignMemo } procedure TcxWebDesignMemo.DefineDefaultWebStyle; begin inherited; DefaultWebStyle.Font.Name := 'Courier New'; end; procedure TcxWebDesignMemo.DrawInterior(var R: TRect); begin inherited; DoTextRect(Canvas, R, R.Left + 2, R.Top + 2, WebMemo.Text, thaNone, tvaNone, WebMemo.WordWrap); end; function TcxWebDesignMemo.GetInternalWebControl: TcxCustomWebMemo; begin Result := inherited GetInternalWebControl as TcxCustomWebMemo; end; { TcxWebDesignListBox } procedure TcxWebDesignListBox.DrawInterior(var R: TRect); var DrawRect: TRect; I: Integer; FontColor, BrushColor: TColor; begin inherited; DrawRect := R; if WebListBox.ItemHeight <> 0 then DrawRect.Bottom := DrawRect.Top + WebListBox.ItemHeight else DrawRect.Bottom := DrawRect.Top + 16; FontColor := Canvas.Font.Color; BrushColor := Canvas.Brush.Color; for I := 0 to WebListBox.Items.Count - 1 do begin if WebListBox.Items[I].Selected then begin Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText; Canvas.FillRect(DrawRect); end; DoTextRect(Canvas, DrawRect, DrawRect.Left + 2, DrawRect.Top, WebListBox.Items[I].Text, thaLeft, tvaCenter); Canvas.Brush.Color := BrushColor; Canvas.Font.Color := FontColor; if WebListBox.ItemHeight <> 0 then OffsetRect(DrawRect, 0, WebListBox.ItemHeight) else OffsetRect(DrawRect, 0, 16); if DrawRect.Bottom > R.Bottom then break; end; end; function TcxWebDesignListBox.ShowScrollBar: Boolean; begin Result := inherited ShowScrollBar and (WebListBox.Items.Count > WebListBox.Size); end; function TcxWebDesignListBox.GetInternalWebControl: TcxCustomWebListBox; begin Result := inherited GetInternalWebControl as TcxCustomWebListBox; end; { TcxWebDesignComboBox } procedure TcxWebDesignComboBox.DrawInterior(var R: TRect); var DrawRect: TRect; ButtonWidth: Integer; {$IFNDEF VCL} ArrowRect: TRect; ScrollSize: TSize; {$ENDIF} begin inherited; DrawRect := R; {$IFDEF VCL} ButtonWidth := GetSystemMetrics(SM_CXVSCROLL); {$ELSE} QStyle_scrollBarExtent(QWidget_style(Handle), @ScrollSize); ButtonWidth := ScrollSize.cx; {$ENDIF} DrawRect.Left := DrawRect.Right - ButtonWidth; {$IFDEF VCL} DrawFrameControl(Canvas.Handle, DrawRect, DFC_SCROLL, DFCS_SCROLLDOWN); {$ELSE} TCanvasAccess(Canvas).Changing; Canvas.Start(False); try QStyle_drawButton(QWidget_style(Handle), Canvas.Handle, DrawRect.Left, DrawRect.Top, ButtonWidth, DrawRect.Bottom - DrawRect.Top, QWidget_colorGroup(Handle), False, nil); QStyle_buttonRect(QWidget_style(Handle), @ArrowRect, DrawRect.Left, DrawRect.Top, ButtonWidth, DrawRect.Bottom - DrawRect.Top); QStyle_drawArrow(QWidget_style(Handle), Canvas.Handle, ArrowType_DownArrow, False, ArrowRect.Left, ArrowRect.Top, ArrowRect.Right - ArrowRect.Left, ArrowRect.Bottom - ArrowRect.Top, QWidget_colorGroup(Handle), True, nil); finally Canvas.Stop; end; TCanvasAccess(Canvas).Changed; {$ENDIF} Dec(R.Right, ButtonWidth); DoTextRect(Canvas, R, R.Left + 2, R.Top, GetControlText, thaLeft, tvaCenter); end; function TcxWebDesignComboBox.GetControlText: string; begin Result := WebComboBox.Text; end; function TcxWebDesignComboBox.GetInternalWebControl: TcxCustomWebComboBox; begin Result := inherited GetInternalWebControl as TcxCustomWebComboBox; end; { TcxWebDesignCheckBox } procedure TcxWebDesignCheckBox.DrawInterior(var R: TRect); {$IFDEF VCL} const CheckState: array[Boolean] of UINT = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED); {$ENDIF} var CheckRect: TRect; begin inherited; if Assigned(cxWebMetricsUtils) then CheckRect := Bounds(R.Left + 4, R.Top + ((R.Bottom - R.Top) - cxWebMetricsUtils.CheckHeight) div 2, cxWebMetricsUtils.CheckWidth, cxWebMetricsUtils.CheckHeight) else CheckRect := Bounds(R.Left + 4, R.Top + ((R.Bottom - R.Top) - 12) div 2, 12, 12); R.Left := CheckRect.Right + 3; {$IFDEF VCL} DrawFrameControl(Canvas.Handle, CheckRect, DFC_BUTTON, CheckState[WebCheckBox.Checked]); {$ELSE} TCanvasAccess(Canvas).Changing; Canvas.Start(False); try Palette.BaseColor := Canvas.Brush.Color; QStyle_drawIndicator(QWidget_style(Handle), Canvas.Handle, CheckRect.Left, CheckRect.Top, CheckRect.Right - CheckRect.Left, CheckRect.Bottom - CheckRect.Top, Palette.ColorGroup(cgActive), Integer(WebCheckBox.Checked), False, True); finally Canvas.Stop; end; TCanvasAccess(Canvas).Changed; {$ENDIF} DoTextRect(Canvas, R, R.Left, R.Top, WebCheckBox.Caption, thaLeft, tvaCenter); end; function TcxWebDesignCheckBox.GetInternalWebControl: TcxCustomWebCheckBox; begin Result := inherited GetInternalWebControl as TcxCustomWebCheckBox; end; { TcxWebDesignRadioGroup } procedure TcxWebDesignRadioGroup.DrawInterior(var R: TRect); const RestSpace = 5; {$IFDEF VCL} State: array[Boolean] of UINT = (DFCS_BUTTONRADIO, DFCS_BUTTONRADIO or DFCS_CHECKED); {$ENDIF} var CR, TR: TRect; I: Integer; begin inherited; if WebRadioGroup.Items.Count = 0 then with Canvas do begin Brush.Style := bsClear; Pen.Color := clBtnShadow; Pen.Style := psSolid; Pen.Width := 1; Rectangle(R); Canvas.Font.Color := clBtnShadow; Canvas.Font.Style := []; Canvas.Font.Size := 10; DoTextRect(Canvas, R, R.Left, R.Top, '(no items)', thaCenter, tvaCenter); Exit; end; if Assigned(cxWebMetricsUtils) then CR := Bounds(R.Left, R.Top, cxWebMetricsUtils.CheckWidth, WebRadioGroup.ItemHeight) else CR := Bounds(R.Left, R.Top, 12, 16); Offsetrect(CR, RestSpace, 0); TR := Rect(CR.Right + RestSpace, CR.Top, R.Right, CR.Bottom); if Assigned(cxWebMetricsUtils) then InflateRect(CR, 0, -(WebRadioGroup.ItemHeight - cxWebMetricsUtils.CheckHeight) div 2) else InflateRect(CR, 0, -(16 - 12) div 2); for I := 0 to WebRadioGroup.Items.Count - 1 do begin {$IFDEF VCL} DrawFrameControl(Canvas.Handle, CR, DFC_BUTTON, State[WebRadioGroup.ItemIndex = I]); {$ELSE} TCanvasAccess(Canvas).Changing; Canvas.Start(False); QPainter_save(Canvas.Handle); try Palette.BaseColor := Canvas.Brush.Color; QStyle_drawExclusiveIndicator(QWidget_style(Handle), Canvas.Handle, CR.Left, CR.Top, CR.Right - CR.Left, CR.Bottom - CR.Top, Palette.ColorGroup(cgActive), WebRadioGroup.ItemIndex = I, False, True); finally QPainter_restore(Canvas.Handle); Canvas.Stop; end; TCanvasAccess(Canvas).Changed; {$ENDIF} DoTextRect(Canvas, TR, TR.Left, TR.Top, WebRadioGroup.Items[I], thaLeft, tvaCenter); if WebRadioGroup.ItemHeight <> 0 then begin OffsetRect(TR, 0, WebRadioGroup.ItemHeight); OffsetRect(CR, 0, WebRadioGroup.ItemHeight); end else begin OffsetRect(TR, 0, 16); OffsetRect(CR, 0, 16); end; if TR.Bottom > R.Bottom then break; end; end; function TcxWebDesignRadioGroup.GetInternalWebControl: TcxCustomWebRadioGroup; begin Result := inherited GetInternalWebControl as TcxCustomWebRadioGroup; end; { TcxWebDesignImage } type TcxWebImageUtilsAcess = class(TcxWebImageUtils); procedure TcxWebDesignImage.DrawInterior(var R: TRect); var S: string; VA: TcxTextVAlignment; begin if (WebImage.DesignPicture = nil) or WebImage.DesignPicture.IsEmpty then begin with Canvas do begin Pen.Style := psSolid; Pen.Color := clBtnShadow; Pen.Width := 1; Brush.Style := bsClear; Rectangle(R); end; inherited; S := WebImage.DesignPicture.GetErrMessage; if S <> '' then begin Canvas.Font.Color := clRed; VA := tvaNone; end else begin S := WebImage.AltText; if S = '' then S := '(no image)'; Canvas.Font.Color := clBtnShadow; VA := tvaCenter; end; Canvas.Font.Style := []; Canvas.Font.Size := 10; DoTextRect(Canvas, R, R.Left, R.Top, S, thaCenter, VA, True); end else Canvas.StretchDraw(R, TcxWebImageUtilsAcess(WebImage.DesignPicture).GetGraphic); //TODO: Image vert and horiz space end; function TcxWebDesignImage.GetInternalWebControl: TcxCustomWebImage; begin Result := inherited GetInternalWebControl as TcxCustomWebImage; end; procedure DrawRectBorder(Canvas: TCanvas; R: TRect; BorderWidth: Integer; BorderColor: TColor); begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := BorderColor; while BorderWidth > 0 do begin FrameRect(Canvas, R); Dec(BorderWidth); end; end; procedure Draw3DButton(Canvas: TCanvas; R: TRect); begin // Canvas.Brush.Color := clBtnFace; Canvas.FillRect(R); Canvas.Pen.Color := clWhite; Canvas.MoveTo(R.Right - 1, R.Top); Canvas.LineTo(R.Left, R.Top); Canvas.LineTo(R.Left, R.Bottom - 1); Canvas.Pen.Color := clBlack; Canvas.LineTo(R.Right - 1, R.Bottom - 1); Canvas.LineTo(R.Right - 1, R.Top - 1); end; { TcxWebDesignGrid } type TcxCustomWebGridAccess = class(TcxCustomWebGrid); constructor TcxWebDesignCustomGrid.Create(AOwner: TComponent); begin FGroupDefStyle := TcxWebStyle.Create(nil); FHeaderDefStyle := TcxWebStyle.Create(nil); FIndDefStyle := TcxWebStyle.Create(nil); FStatusDefStyle := TcxWebStyle.Create(nil); FGroupNodeDefStyle := TcxWebStyle.Create(nil); FItemsDefStyle := TcxWebStyle.Create(nil); inherited Create(AOwner); LoadBitmaps; end; destructor TcxWebDesignCustomGrid.Destroy; begin FreeBitmaps; FItemsDefStyle.Free; FGroupDefStyle.Free; FHeaderDefStyle.Free; FIndDefStyle.Free; FStatusDefStyle.Free; FGroupNodeDefStyle.Free; inherited Destroy; end; procedure TcxWebDesignCustomGrid.FreeBitmaps; var I: TcxWebGridButtons; begin for I := Low(TcxWebGridButtons) to High(TcxWebGridButtons) do FBitmaps[I].Free; end; procedure TcxWebDesignCustomGrid.LoadBitmaps; const cxImgsResName: array[TcxWebGridButtons] of string = ('CXWEBGRID_NODE', 'CXWEBGRID_DELETE', 'CXWEBGRID_INSERT', 'CXWEBGRID_POST', 'CXWEBGRID_CANCEL', 'CXWEBGRID_CURSOR', 'CXWEBGRID_EXPAND', 'CXWEBGRID_COLLAPSE'); var I: TcxWebGridButtons; begin for I := Low(TcxWebGridButtons) to High(TcxWebGridButtons) do begin FBitmaps[I] := TBitmap.Create; FBitmaps[I].LoadFromResourceName(HInstance, cxImgsResName[I]); FBitmaps[I].Transparent := True; end; end; procedure TcxWebDesignCustomGrid.DrawCell(var R: TRect; ARowIndex, AColIndex: Integer); var DrawRect: TRect; AStyle: TcxWebStyle; Text: string; HAlignment: TcxTextHAlignment; VAlignment: TcxTextVAlignment; begin if (ARowIndex < 0) and (ARowIndex >= WebGrid.RowCount) then Exit; if not WebGrid.Columns[AColIndex].Visible then Exit; DrawRect := R; DrawRect.Right := DrawRect.Left + WebGrid.Columns[AColIndex].Width; R.Left := DrawRect.Right; if Odd(ARowIndex) and (WebGrid.Columns[AColIndex].AlternatingStyles.Default <> nil) then AStyle := GetDrawStyle(WebGrid.Columns[AColIndex].AlternatingStyles.Default, FItemsDefStyle) else if WebGrid.Columns[AColIndex].Styles.Default <> nil then AStyle := GetDrawStyle(WebGrid.Columns[AColIndex].Styles.Default, FItemsDefStyle) else AStyle := GetDrawStyle(WebGrid.Styles.Default, FItemsDefStyle); if not WebGrid.ShowGrid then AStyle.Borders.Style := wbsNone; if ARowIndex = WebGrid.FocusedRow then begin AStyle.Shading.Color := WebGrid.SelectedColor; AStyle.Font.Color := WebGrid.SelectedFontColor; end; case WebGrid.Columns[AColIndex].Alignment of whalCenter: HAlignment := thaCenter; whalLeft: HAlignment := thaLeft; whalRight: HAlignment := thaRight; else HAlignment := thaNone; end; case WebGrid.Columns[AColIndex].VAlignment of wvalCenter: VAlignment := tvaCenter; wvalTop: VAlignment := tvaTop; wvalBottom: VAlignment := tvaBottom; else VAlignment := tvaNone; end; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); Text := WebGrid.Columns[AColIndex].GetCellText(ARowIndex); DrawStylishText(Canvas, DrawRect, AStyle, Text, HAlignment, VAlignment); AStyle.Free; end; procedure TcxWebDesignCustomGrid.DrawGroupNode(R: TRect; ARowIndex: Integer); var OffX, OffY, ColIndex: Integer; DrawRect: TRect; AStyle: TcxWebStyle; Image: TBitmap; Text: string; begin ColIndex := WebGrid.GetGroupingItemIndex(WebGrid.GetRowLevel(ARowIndex)); if (ARowIndex < 0) or (ARowIndex >= WebGrid.RowCount) then Exit; DrawRect := R; if WebGrid.GroupNodesStyles.Default = nil then AStyle := GetDrawStyle(WebGrid.Styles.Default, FGroupNodeDefStyle) else AStyle := GetDrawStyle(WebGrid.GroupNodesStyles.Default, FGroupNodeDefStyle); DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if wsavColor in AStyle.Shading.AssignedValues then with Canvas do begin Brush.Color := WebColorToColor(AStyle.Shading.Color); Brush.Style := bsSolid; FillRect(DrawRect); end; Image := FBitmaps[gbExpand]; //TODO: collapse OffX := DrawRect.Left + 3; OffY := DrawRect.Top + (DrawRect.Bottom - DrawRect.Top - Image.Height) div 2; with Canvas do begin Pen.Style := psSolid; Pen.Width := 1; Pen.Color := WebColorToColor(clWebThreeDHighlight); MoveTo(OffX - 1, OffY - 1); LineTo(OffX + Image.Width, OffY - 1); Pen.Color := WebColorToColor(clWebThreeDDarkShadow); LineTo(OffX + Image.Width, OffY + Image.Height); LineTo(OffX - 1, OffY + Image.Height); Pen.Color := WebColorToColor(clWebThreeDHighlight); LineTo(OffX - 1, OffY - 1); end; Canvas.Draw(OffX, OffY, Image); Inc(DrawRect.Left, Image.Width + 6); Text := WebGrid.Columns[ColIndex].Title + ': ' + WebGrid.Columns[ColIndex].GetCellText(ARowIndex); DrawStylishText(Canvas, DrawRect, AStyle, Text, thaLeft, tvaCenter, False); AStyle.Free; end; procedure TcxWebDesignCustomGrid.DrawHeaderCell(var R: TRect; AIndex, AMargin: Integer); var AStyle: TcxWebStyle; DrawRect: TRect; ColWidth: Integer; begin if (AIndex = -1) or (WebGrid.ColumnCount <= AIndex) or not WebGrid.Columns[AIndex].Visible then Exit; ColWidth := WebGrid.Columns[AIndex].Width; if (AIndex = TcxCustomWebGridAccess(WebGrid).FirstVisibleColumnIndex) and (WebGrid.GetGroupingItemCount > 0) then Inc(ColWidth, WebGrid.IndicatorWidth); DrawRect := Bounds(R.Left + AMargin, R.Top + AMargin, ColWidth, WebGrid.HeaderHeight); R.Left := DrawRect.Right; R.Top := R.Top + AMargin; if WebGrid.HeaderStyles.Default = nil then AStyle := GetDrawStyle(WebGrid.Styles.Default, FHeaderDefStyle) else AStyle := GetDrawStyle(WebGrid.HeaderStyles.Default, FHeaderDefStyle); DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); DrawStylishText(Canvas, DrawRect, AStyle, WebGrid.Columns[AIndex].Title, thaCenter, tvaCenter); AStyle.Free; end; procedure TcxWebDesignCustomGrid.DrawIndicator(var R: TRect; ABtn1, ABtn2: TcxWebGridButtons); var AStyle: TcxWebStyle; DrawRect: TRect; Image: TBitmap; OffX, OffY: Integer; begin if not WebGrid.ShowIndicator then Exit; if WebGrid.IndicatorStyles.Default = nil then AStyle := GetDrawStyle(WebGrid.Styles.Default, FIndDefStyle) else AStyle := GetDrawStyle(WebGrid.IndicatorStyles.Default, FIndDefStyle); DrawRect := Bounds(R.Left, R.Top, WebGrid.IndicatorWidth, R.Bottom - R.Top); R.Left := DrawRect.Right; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if wsavColor in AStyle.Shading.AssignedValues then with Canvas do begin Brush.Color := WebColorToColor(AStyle.Shading.Color); Brush.Style := bsSolid; FillRect(DrawRect); end; if WebGrid.IndicatorType = itDataOp then Image := FBitmaps[ABtn1] else Image := FBitmaps[ABtn2]; OffX := DrawRect.Left + (WebGrid.IndicatorWidth - Image.Width) div 2; OffY := DrawRect.Top + (DrawRect.Bottom - DrawRect.Top - Image.Height) div 2; Canvas.Draw(OffX, OffY, Image); AStyle.Free; end; procedure TcxWebDesignCustomGrid.DrawHeader(var R: TRect); var DrawRect: TRect; I: Integer; begin if not WebGrid.ShowHeader or (WebGrid.ColumnCount = 0) then Exit; DrawRect := Bounds(R.Left, R.Top, R.Right - R.Left, WebGrid.HeaderHeight); R.Top := DrawRect.Bottom; DrawIndicator(DrawRect, gbInsert, gbNode); for I := 0 to WebGrid.ColumnCount - 1 do DrawHeaderCell(DrawRect, I, 0); end; procedure TcxWebDesignCustomGrid.DrawGroupPanel(var R: TRect); const Margin = 10; var DrawRect: TRect; AStyle: TcxWebStyle; PHeight, I: Integer; Text: string; begin if not WebGrid.ShowGroupPanel then exit; if WebGrid.GroupPanelStyles.Default = nil then AStyle := GetDrawStyle(WebGrid.Styles.Default, FGroupDefStyle) else AStyle := GetDrawStyle(WebGrid.GroupPanelStyles.Default, FGroupDefStyle); if WebGrid.GroupPanelStyles.Default = nil then with AStyle.Borders do begin Style := wbsSolid; Color := WebGrid.BorderColor; Width := WebGrid.BorderWidth; Left.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Top.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Right.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Bottom.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; end; if WebGrid.GetGroupingItemCount > 0 then PHeight := (WebGrid.GetGroupingItemCount + 1) * Margin + WebGrid.HeaderHeight else PHeight := 0; if WebGrid.GroupPanelHeight > PHeight then PHeight := WebGrid.GroupPanelHeight; Inc(PHeight, AStyle.Borders.VertBordersSize); DrawRect := Bounds(R.Left, R.Top, R.Right - R.Left, PHeight); R.Top := DrawRect.Bottom; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if WebGrid.GetGroupingItemCount = 0 then Text := ' Drag a column header here to group by that column' else Text := ''; DrawStylishText(Canvas, DrawRect, AStyle, Text, thaLeft, tvaCenter, True); for I := 0 to WebGrid.GetGroupingItemCount - 1 do DrawHeaderCell(DrawRect, WebGrid.GetGroupingItemIndex(I), Margin); AStyle.Free; end; procedure TcxWebDesignCustomGrid.DrawRow(AIndex: Integer; var R: TRect); var DrawRect: TRect; I: Integer; begin if (AIndex < 0) or (AIndex >= WebGrid.RowCount) then Exit; DrawRect := Bounds(R.Left, R.Top, R.Right - R.Left, WebGrid.RowHeight); R.Top := DrawRect.Bottom; if WebGrid.GetRowLevel(AIndex) < WebGrid.GetGroupingItemCount then begin DrawIndicator(DrawRect, gbNode, gbNode); DrawGroupNode(DrawRect, AIndex); end else begin if WebGrid.FocusedRow = AIndex then DrawIndicator(DrawRect, gbDelete, gbCursor) else DrawIndicator(DrawRect, gbDelete, gbNode); for I := 0 to WebGrid.ColumnCount - 1 do DrawCell(DrawRect, AIndex, I); end; end; procedure TcxWebDesignCustomGrid.DrawStatusPanel(var R: TRect); var DrawRect: TRect; AStyle: TcxWebStyle; AHeight: Integer; begin if not WebGrid.ShowStatusPanel then exit; if WebGrid.StatusPanelStyles.Default = nil then AStyle := GetDrawStyle(WebGrid.Styles.Default, FStatusDefStyle) else AStyle := GetDrawStyle(WebGrid.StatusPanelStyles.Default, FStatusDefStyle); if WebGrid.StatusPanelStyles.Default = nil then with AStyle.Borders do begin Style := wbsSolid; Color := WebGrid.BorderColor; Width := WebGrid.BorderWidth; Left.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Top.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Right.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Bottom.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; end; AHeight := Max(CalcStylishTextExtent(Canvas, AStyle, 'Wq').cy, WebGrid.StatusPanelHeight) + AStyle.Borders.VertBordersSize; DrawRect := Rect(R.Left, R.Bottom - AHeight, R.Right, R.Bottom); R.Bottom := DrawRect.Top; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); DrawStylishText(Canvas, DrawRect, AStyle, ' ' + WebGrid.StatusPanelText, thaLeft, tvaCenter); AStyle.Free; end; procedure TcxWebDesignCustomGrid.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; end; with FItemsDefStyle do begin Borders.Style := wbsSolid; Borders.Left.Style := wbsNone; Borders.Top.Style := wbsNone; Borders.Bottom.Color := clWebBlack; Borders.Right.Color := clWebBlack; Borders.Width := 1; end; with FGroupDefStyle do begin Shading.Color := clWebButtonShadow; Shading.AssignedValues := [wsavColor]; Font.Color := clWebButtonFace; end; with FHeaderDefStyle do begin Borders.Left.Color := clWebThreeDHighlight; Borders.Top.Color := clWebThreeDHighlight; Borders.Bottom.Color := clWebThreeDDarkShadow; Borders.Right.Color := clWebThreeDDarkShadow; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; end; with FIndDefStyle do begin Borders.Left.Color := clWebThreeDHighlight; Borders.Top.Color := clWebThreeDHighlight; Borders.Bottom.Color := clWebThreeDDarkShadow; Borders.Right.Color := clWebThreeDDarkShadow; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; end; with FStatusDefStyle do begin Borders.Width := 1; Borders.Color := clWebBlack; Borders.Style := wbsSolid; Shading.Color := clWebButtonShadow; Shading.AssignedValues := [wsavColor]; Font.Color := clWebButtonFace; end; with FGroupNodeDefStyle do begin Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; end; end; procedure TcxWebDesignCustomGrid.DrawBorder(var R: TRect); begin // no standard border end; procedure TcxWebDesignCustomGrid.DrawInterior(var R: TRect); var I: Integer; DrawRect: TRect; begin DrawGroupPanel(R); DrawStatusPanel(R); with Canvas do begin Brush.Color := WebColorToColor(WebGrid.BorderColor); Brush.Style := bsSolid; DrawRect := Bounds(R.Left, R.Top, WebGrid.BorderWidth, R.Bottom - R.Top); FillRect(DrawRect); DrawRect := Bounds(R.Right - WebGrid.BorderWidth, R.Top, WebGrid.BorderWidth, R.Bottom - R.Top); FillRect(DrawRect); if not WebGrid.ShowGroupPanel then begin DrawRect := Bounds(R.Left, R.Top, R.Right - R.Left, WebGrid.BorderWidth); FillRect(DrawRect); Inc(R.Top, WebGrid.BorderWidth); end; if not WebGrid.ShowStatusPanel then begin DrawRect := Bounds(R.Left, R.Bottom - WebGrid.BorderWidth, R.Right - R.Left, WebGrid.BorderWidth); FillRect(DrawRect); Dec(R.Bottom, WebGrid.BorderWidth); end; end; InflateRect(R, -WebGrid.BorderWidth, 0); DrawHeader(R); with WebGrid do for I := 0 to PageSize - 1 do DrawRow(FirstVisibleRow + I, R); end; function TcxWebDesignCustomGrid.GetInternalWebControl: TcxCustomWebGrid; begin Result := inherited GetInternalWebControl as TcxCustomWebGrid; end; { TcxWebDesignGridNavigator } constructor TcxWebDesignDataNavigator.Create(AOwner: TComponent); begin FEdStyle := TcxWebStyle.Create(nil); inherited Create(AOwner); LoadBitmaps; end; destructor TcxWebDesignDataNavigator.Destroy; begin FreeBitmaps; FEdStyle.Free; inherited Destroy; end; procedure TcxWebDesignDataNavigator.LoadBitmaps; const cxImgsResName: array[TcxWebNavigatorButtonType] of string = ('CXWEBNAV_FIRST', 'CXWEBNAV_PRIORPAGE', 'CXWEBNAV_PRIOR', 'CXWEBNAV_PAGESIZE', 'CXWEBNAV_APPLYPAGESIZE', 'CXWEBNAV_NEXT', 'CXWEBNAV_NEXTPAGE', 'CXWEBNAV_LAST', 'CXWEBNAV_INSERT', 'CXWEBNAV_EDIT', 'CXWEBNAV_DELETE', 'CXWEBNAV_POST', 'CXWEBNAV_CANCEL', 'CXWEBNAV_REFRESH', 'CXWEBNAV_PAGESIZE'); var I: TcxWebNavigatorButtonType; begin for I := Low(TcxWebNavigatorButtonType) to High(TcxWebNavigatorButtonType) do begin FBitmaps[I] := TBitmap.Create; FBitmaps[I].LoadFromResourceName(HInstance, cxImgsResName[I]); FBitmaps[I].Transparent := True; end; end; procedure TcxWebDesignDataNavigator.FreeBitmaps; var I: TcxWebNavigatorButtonType; begin for I := Low(TcxWebNavigatorButtonType) to High(TcxWebNavigatorButtonType) do FBitmaps[I].Free; end; procedure TcxWebDesignDataNavigator.DrawButton(var XPos, YPos: Integer; Index: Integer); var R: TRect; OffX, OffY: Integer; Image: TBitmap; begin R := Bounds(XPos, YPos, WebDataNavigator.ButtonWidth, WebDataNavigator.Height); DrawStylishBorder(Canvas, ControlWebStyle.Borders, R); with Canvas do begin Brush.Style := bsSolid; Brush.Color := WebColorToColor(ControlWebStyle.Shading.Color); FillRect(R); end; if WebDataNavigator.Buttons.Items[Index].ButtonType <> nbCustom then begin Image := FBitmaps[WebDataNavigator.Buttons.Items[Index].ButtonType]; OffX := R.Left + (WebDataNavigator.ButtonWidth - Image.Width) div 2; OffY := R.Top + (WebDataNavigator.Height - Image.Height) div 2; Canvas.Draw(OffX, OffY, Image); end; Inc(XPos, WebDataNavigator.ButtonWidth); end; procedure TcxWebDesignDataNavigator.DrawEdit(var XPos, YPos: Integer; Text: string); var R: TRect; AStyle: TcxWebStyle; begin if GetMainControlStyles.Default <> nil then AStyle := GetMainControlStyles.Default.Style else AStyle := FEdStyle; R := Bounds(XPos, YPos, WebDataNavigator.ButtonWidth * 2, WebDataNavigator.Height); XPos := R.Right; DrawStylishBorder(Canvas, AStyle.Borders, R); DrawStylishText(Canvas, R, AStyle, Text, thaLeft, tvaCenter); end; procedure TcxWebDesignDataNavigator.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Left.Color := clWebWhite; Borders.Top.Color := clWebWhite; Borders.Right.Color := clWebBlack; Borders.Bottom.Color := clWebBlack; Borders.Width := 1; Borders.Style := wbsSolid; Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; end; with FEdStyle do begin Borders.Color := clWebButtonHighlight; Borders.Style := wbsInset; Borders.Width := 2; Borders.Left.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Top.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Right.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Bottom.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; Font.Name := 'MS Sans Serif'; Font.Size.Value := 10; end; end; procedure TcxWebDesignDataNavigator.DrawFace; var R: TRect; begin R := ClientRect; DrawInterior(R); end; procedure TcxWebDesignDataNavigator.DrawInterior(var R: TRect); var I, XPos, YPos: Integer; begin XPos := 0; YPos := 0; for I := 0 to WebDataNavigator.Buttons.Count - 1 do begin if WebDataNavigator.Buttons.Items[I].Visible then if WebDataNavigator.Buttons.Items[I].ButtonType = nbPageSize then DrawEdit(XPos, YPos, IntToStr(WebDataNavigator.PageSize)) else DrawButton(XPos, YPos, I); end; end; function TcxWebDesignDataNavigator.GetInternalWebControl: TcxCustomWebDataNavigator; begin Result := inherited GetInternalWebControl as TcxCustomWebDataNavigator; end; { TcxWebDesignTreeView } procedure TcxWebDesignTreeView.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Width := 1; Borders.Style := wbsSolid; end; end; procedure TcxWebDesignTreeView.DrawBorder(var R: TRect); begin if WebTreeView.Items.Count > 0 then inherited; end; procedure TcxWebDesignTreeView.DrawInterior(var R: TRect); begin inherited; if WebTreeView.Items.Count = 0 then with Canvas do begin Brush.Style := bsClear; Pen.Color := clBtnShadow; Pen.Style := psSolid; Pen.Width := 1; Rectangle(R); Canvas.Font.Color := clBtnShadow; Canvas.Font.Style := []; Canvas.Font.Size := 10; DoTextRect(Canvas, R, R.Left, R.Top, '(no items)', thaCenter, tvaCenter); end else DrawItems(R, WebTreeView.Items); end; procedure TcxWebDesignTreeView.DrawItems(var R: TRect; AItem: TcxWebTreeItem); procedure DrawExpandButton(const Rect: TRect; Expanded: Boolean); const BtnSize = 9; var BtnRect: TRect; begin StoreCanvas(Canvas); BtnRect := Bounds(Rect.Left - BtnSize - 2, Rect.Top + (Rect.Bottom - Rect.Top - BtnSize) div 2, BtnSize, BtnSize); Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := clBtnShadow; FrameRect(Canvas, BtnRect); Canvas.Pen.Color := clWindowText; Canvas.Pen.Style := psSolid; Canvas.MoveTo(BtnRect.Left + 2, BtnRect.Top + BtnSize div 2); Canvas.LineTo(BtnRect.Right - 2, BtnRect.Top + BtnSize div 2); if not Expanded then begin Canvas.MoveTo(BtnRect.Left + BtnSize div 2, BtnRect.Top + 2); Canvas.LineTo(BtnRect.Left + BtnSize div 2, BtnRect.Bottom - 2); end; RestoreCanvas(Canvas); end; var I: Integer; ItemRect: TRect; begin if AItem.Level >= 0 then begin ItemRect := R; ItemRect.Left := R.Left + WebTreeView.Indent * (AItem.Level + 1); ItemRect.Bottom := R.Top + Canvas.TextHeight(AItem.Text); if WebTreeView.ShowButtons and AItem.HasChildren then DrawExpandButton(ItemRect, AItem.Expanded); DoTextRect(Canvas, ItemRect, ItemRect.Left, ItemRect.Top, AItem.Text); R.Top := ItemRect.Bottom; end; if AItem.Expanded then for I := 0 to AItem.Count - 1 do DrawItems(R, AItem.Items[I]); end; function TcxWebDesignTreeView.GetInternalWebControl: TcxWebTreeView; begin Result := inherited GetInternalWebControl as TcxWebTreeView; end; { TcxWebDesignPanel } constructor TcxWebDesignPanel.Create(AOwner: TComponent); begin inherited Create(Owner); ControlStyle := ControlStyle + [csAcceptsControls]; end; procedure TcxWebDesignPanel.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Color := clBlack; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; end; end; procedure TcxWebDesignPanel.DrawBorder(var R: TRect); begin //do not delete end; procedure TcxWebDesignPanel.DrawInterior(var R: TRect); var BR: TRect; Text: string; begin inherited; if Panel.Caption <> '' then Text := Format(' %s ', [Panel.Caption]) else Text := ''; BR := R; R := Bounds(R.Left + 10, R.Top, Canvas.TextWidth(Text), Canvas.TextHeight(Text)); Inc(BR.Top, (R.Bottom - R.Top) div 2); inherited DrawBorder(BR); DrawStylishText(Canvas, R, ControlWebStyle, Text, thaLeft, tvaCenter); end; function TcxWebDesignPanel.GetInternalWebControl: TcxWebPanel; begin Result := inherited GetInternalWebControl as TcxWebPanel; end; { TcxWebDesignMainMenu } procedure TcxWebDesignMainMenu.DrawEmptyMenu(R: TRect); begin with Canvas do begin Brush.Style := bsClear; Pen.Color := clBtnShadow; Pen.Style := psSolid; Pen.Width := 1; Rectangle(R); Canvas.Font.Color := clBtnShadow; Canvas.Font.Style := []; Canvas.Font.Size := 10; DoTextRect(Canvas, R, R.Left, R.Top, '(no items)', thaCenter, tvaCenter); end; end; procedure TcxWebDesignMainMenu.DrawMenuItem(R: TRect; AItem: TcxWebMenuItem); var Alignment: TcxTextHAlignment; begin case AItem.Align of maCenter: Alignment := thaCenter; maLeft: Alignment := thaLeft; maRight: Alignment := thaRight; else Alignment := thaNone; end; DoTextRect(Canvas, R, R.Left, R.Top, AItem.Caption, Alignment, tvaCenter); end; procedure TcxWebDesignMainMenu.DrawInterior(var R: TRect); var I: Integer; begin if WebMainMenu.Items.Count = 0 then DrawEmptyMenu(R) else for I := 0 to WebMainMenu.Items.Count - 1 do if WebMainMenu.Items[I].Visible then begin if WebMainMenu.Items[I].Break = mbBreak then begin if WebMainMenu.Horizontal then R.Right := R.Left + WebMainMenu.SeparatorWidth else R.Bottom := R.Top + WebMainMenu.SeparatorWidth; StoreCanvas(Canvas); try Canvas.Brush.Color := WebColorToColor(WebMainMenu.SeparatorColor); Canvas.Brush.Style := bsSolid; Canvas.FillRect(R); finally RestoreCanvas(Canvas); end; end else begin if WebMainMenu.Horizontal then R.Right := R.Left + WebMainMenu.Items[I].Width else R.Bottom := R.Top + WebMainMenu.ItemHeight; DrawMenuItem(R, WebMainMenu.Items[I]); end; if WebMainMenu.Horizontal then R.Left := R.Right else R.Top := R.Bottom; end; end; function TcxWebDesignMainMenu.GetInternalWebControl: TcxWebMainMenu; begin Result := inherited GetInternalWebControl as TcxWebMainMenu; end; procedure TcxWebDesignMainMenu.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Color := clWebBlack; Borders.Width := 1; Borders.Style := wbsSolid; Shading.Color := clWebLightGrey; Shading.AssignedValues := [wsavColor]; end; end; procedure TcxWebDesignMainMenu.DrawBorder(var R: TRect); begin if WebMainMenu.Items.Count > 0 then inherited; end; { TcxWebDesignCalendar } type TcxCalendarSheetAccess = class(TcxCalendarSheet); constructor TcxWebDesignCalendar.Create(AOwner: TComponent); begin FDayHeaderDefStyle := TcxWebStyle.Create(nil); FOtherMonthDayDefStyle := TcxWebStyle.Create(nil); FSelectedDefStyle := TcxWebStyle.Create(nil); FTitleDefStyle := TcxWebStyle.Create(nil); FTodayPanelDefStyle := TcxWebStyle.Create(nil); inherited; end; destructor TcxWebDesignCalendar.Destroy; begin FDayHeaderDefStyle.Free; FOtherMonthDayDefStyle.Free; FSelectedDefStyle.Free; FTitleDefStyle.Free; FTodayPanelDefStyle.Free; inherited; end; procedure TcxWebDesignCalendar.DrawTitle(var R: TRect); var TxtSize: TSize; DrawRect: TRect; AStyle: TcxWebStyle; Txt: string; begin DrawRect := R; AStyle := GetDrawStyle(WebCalendar.TitleStyle.Default, FTitleDefStyle); TxtSize := CalcStylishTextExtent(Canvas, AStyle, 'Wg'); //todo: prev, next images DrawRect.Bottom := DrawRect.Top + TxtSize.cy; Inc(DrawRect.Bottom, AStyle.Borders.VertBordersSize); R.Top := DrawRect.Bottom; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); DrawStylishText(Canvas, DrawRect, AStyle, WebCalendar.PrevMonthText, thaLeft); Txt := WebCalendar.MonthNames[WebCalendar.CalendarSheet.Month]; if WebCalendar.ShowYear then Txt := Txt + ' ' + IntToStr(WebCalendar.CalendarSheet.Year); DrawStylishText(Canvas, DrawRect, AStyle, Txt, thaCenter, tvaNone, False); DrawStylishText(Canvas, DrawRect, AStyle, WebCalendar.NextMonthText, thaRight, tvaNone, False); AStyle.Free; end; procedure TcxWebDesignCalendar.DrawHeader(var R: TRect); var TxtSize: TSize; DrawRect: TRect; AStyle: TcxWebStyle; I, Off, Idx: Integer; begin DrawRect := R; AStyle := GetDrawStyle(WebCalendar.DayHeaderStyle.Default, FDayHeaderDefStyle); TxtSize := CalcStylishTextExtent(Canvas, AStyle, 'Wg'); DrawRect.Bottom := DrawRect.Top + TxtSize.cy; Off := WebCalendar.CellPadding + WebCalendar.CellSpacing; Inc(DrawRect.Bottom, Off * 2); Inc(DrawRect.Bottom, AStyle.Borders.VertBordersSize); R.Top := DrawRect.Bottom; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if wsavColor in AStyle.Shading.AssignedValues then begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := AStyle.Shading.Color; Canvas.FillRect(DrawRect); end; DrawRect.Right := (DrawRect.Right - DrawRect.Left) div 7 + DrawRect.Left; InflateRect(DrawRect, -Off, -Off); Idx := WebCalendar.CalendarSheet.StartOfWeek + 1; for I := 1 to 7 do begin DrawStylishText(Canvas, DrawRect, AStyle, WebCalendar.DaysOfWeekNames[Idx], thaCenter, tvaCenter, False); OffsetRect(DrawRect, Off * 2 + (DrawRect.Right - DrawRect.Left), 0); Inc(Idx); if Idx > 7 then Dec(Idx, 7); end; AStyle.Free; end; procedure TcxWebDesignCalendar.DrawSheet(var R: TRect); var TxtSize: TSize; DrawRect, FirstCell, SaveRect: TRect; ASelStyle, AOtherStyle: TcxWebStyle; RowCnt, I, J, Off: Integer; begin DrawRect := R; ASelStyle := GetDrawStyle(WebCalendar.SelectedStyle.Default, FSelectedDefStyle); AOtherStyle := GetDrawStyle(WebCalendar.OtherMonthDayStyle.Default, FOtherMonthDayDefStyle); TxtSize := CalcStylishTextExtent(Canvas, ControlWebStyle, 'Wg'); if wsavColor in ControlWebStyle.Shading.AssignedValues then begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := ControlWebStyle.Shading.Color; Canvas.FillRect(DrawRect); end; DrawRect.Right := (DrawRect.Right - DrawRect.Left) div 7 + DrawRect.Left; RowCnt := WebCalendar.CalendarSheet.DayCount div 7; if WebCalendar.CalendarSheet.DayCount mod 7 > 0 then Inc(RowCnt); DrawRect.Bottom := (DrawRect.Bottom - DrawRect.Top) div RowCnt + DrawRect.Top; Off := WebCalendar.CellPadding + WebCalendar.CellSpacing; InflateRect(DrawRect, -Off, -Off); FirstCell := DrawRect; for I := 0 to RowCnt - 1 do begin for J := 0 to 6 do begin if TcxCalendarSheetAccess(WebCalendar.CalendarSheet).IsSelectedDay(I*7 + J) then begin SaveRect := DrawRect; DrawStylishBorder(Canvas, ASelStyle.Borders, SaveRect); DrawStylishText(Canvas, SaveRect, ASelStyle, IntToStr(DayOf(WebCalendar.CalendarSheet.Dates[I*7 + J])), thaCenter, tvaCenter); end else if TcxCalendarSheetAccess(WebCalendar.CalendarSheet).IsOtherMonthDay(I*7 + J) then begin SaveRect := DrawRect; DrawStylishBorder(Canvas, AOtherStyle.Borders, SaveRect); DrawStylishText(Canvas, SaveRect, AOtherStyle, IntToStr(DayOf(WebCalendar.CalendarSheet.Dates[I*7 + J])), thaCenter, tvaCenter); end else DrawStylishText(Canvas, DrawRect, ControlWebStyle, IntToStr(DayOf(WebCalendar.CalendarSheet.Dates[I*7 + J])), thaCenter, tvaCenter, False); OffsetRect(DrawRect, Off * 2 + (DrawRect.Right - DrawRect.Left), 0); end; OffsetRect(DrawRect, 0, Off * 2 + (DrawRect.Bottom - DrawRect.Top)); DrawRect.Left := FirstCell.Left; DrawRect.Right := FirstCell.Right; end; ASelStyle.Free; AOtherStyle.Free; end; procedure TcxWebDesignCalendar.DrawFooter(var R: TRect); var TxtSize: TSize; DrawRect: TRect; AStyle: TcxWebStyle; begin DrawRect := R; AStyle := GetDrawStyle(WebCalendar.TodayPanelStyle.Default, FTodayPanelDefStyle); TxtSize := CalcStylishTextExtent(Canvas, AStyle, 'Wg'); DrawRect.Top := DrawRect.Bottom - TxtSize.cy; Dec(DrawRect.Top, AStyle.Borders.VertBordersSize); R.Bottom := DrawRect.Top; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); DrawStylishText(Canvas, DrawRect, AStyle, 'Today', thaCenter); AStyle.Free; end; procedure TcxWebDesignCalendar.DrawInterior(var R: TRect); begin DrawTitle(R); DrawHeader(R); if WebCalendar.ShowTodayLink then DrawFooter(R); DrawSheet(R); end; function TcxWebDesignCalendar.GetInternalWebControl: TcxCustomWebCalendar; begin Result := inherited GetInternalWebControl as TcxCustomWebCalendar; end; procedure TcxWebDesignCalendar.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Color := clWebBlack; Borders.Width := 1; Borders.Style := wbsSolid; Shading.Color := clWebWhite; Shading.AssignedValues := [wsavColor]; end; with FDayHeaderDefStyle do begin Shading.Color := clWebGray; Shading.AssignedValues := [wsavColor]; end; with FOtherMonthDayDefStyle do begin Shading.AssignedValues := []; end; with FSelectedDefStyle do begin Borders.Color := clWebRed; Borders.Width := 1; Borders.Style := wbsSolid; Shading.Color := clWebLightGrey; Shading.AssignedValues := [wsavColor]; end; with FTitleDefStyle do begin Shading.Color := TcxWebColor($EEEEEE); Shading.AssignedValues := [wsavColor]; end; with FTodayPanelDefStyle do begin Shading.Color := TcxWebColor($EEEEEE); Shading.AssignedValues := [wsavColor]; end; end; { TcxWebDesignDateEdit } constructor TcxWebDesignDateEdit.Create(AOwner: TComponent); begin FButtonDefStyle := TcxWebStyle.Create(nil); inherited; FButtonImage := TBitmap.Create; FButtonImage.LoadFromResourceName(HInstance, 'CXWEBDATEEDIT'); FButtonImage.Transparent := True; end; procedure TcxWebDesignDateEdit.DefineDefaultWebStyle; begin inherited; with FButtonDefStyle do begin Borders.Color := clWebButtonHighlight; Borders.Width := 2; Borders.Style := wbsOutset; Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; Borders.Left.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Top.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Right.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Bottom.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; end; end; destructor TcxWebDesignDateEdit.Destroy; begin FButtonDefStyle.Free; FButtonImage.Free; inherited; end; procedure TcxWebDesignDateEdit.DrawButton(var R: TRect); var DrawRect: TRect; AStyle: TcxWebStyle; OffX, OffY: Integer; begin DrawRect := R; Dec(R.Right, WebDateEdit.ButtonWidth); DrawRect.Left := R.Right; AStyle := GetDrawStyle(WebDateEdit.ButtonStyles.Default, FButtonDefStyle); with Canvas do begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := WebColorToColor(AStyle.Shading.Color); FillRect(DrawRect); end; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); OffX := (DrawRect.Right - DrawRect.Left - FButtonImage.Width) div 2; OffY := (DrawRect.Bottom - DrawRect.Top - FButtonImage.Height) div 2; Canvas.Draw(DrawRect.Left + OffX, Drawrect.Top + OffY, FButtonImage); AStyle.Free; end; procedure TcxWebDesignDateEdit.DrawFace; var R: TRect; begin R := ClientRect; DrawButton(R); DrawBorder(R); DrawStylishText(Canvas, R, ControlWebStyle, GetControlText, thaLeft, tvaCenter); end; function TcxWebDesignDateEdit.GetControlText: string; begin Result := DateToStr(WebDateEdit.SelectedDate); end; function TcxWebDesignDateEdit.GetInternalWebControl: TcxCustomWebDateEdit; begin Result := inherited GetInternalWebControl as TcxCustomWebDateEdit; end; function TcxWebDesignDateEdit.GetMainControlStyles: TcxWebStyles; begin Result := WebDateEdit.EditorStyles; end; {TcxWebDesignCustomTable} constructor TcxWebDesignCustomTable.Create(AOwner: TComponent); begin FPagingDefStyle := TcxWebStyle.Create(nil); FPagingNumDefStyle := TcxWebStyle.Create(nil); FItemsDefStyle := TcxWebStyle.Create(nil); FHeaderDefStyle := TcxWebStyle.Create(nil); inherited; end; destructor TcxWebDesignCustomTable.Destroy; begin FHeaderDefStyle.Free; FPagingDefStyle.Free; FPagingNumDefStyle.Free; FItemsDefStyle.Free; inherited; end; procedure TcxWebDesignCustomTable.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Left.Color := clWebThreeDHighlight; Borders.Top.Color := clWebThreeDHighlight; Borders.Right.Color := clWebThreeDShadow; Borders.Bottom.Color := clWebThreeDShadow; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; end; with FHeaderDefStyle do begin Borders.Right.Color := clWebThreeDHighlight; Borders.Bottom.Color := clWebThreeDHighlight; Borders.Left.Color := clWebThreeDShadow; Borders.Top.Color := clWebThreeDShadow; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; end; with FPagingDefStyle do begin Borders.Right.Color := clWebThreeDHighlight; Borders.Bottom.Color := clWebThreeDHighlight; Borders.Left.Color := clWebThreeDShadow; Borders.Top.Color := clWebThreeDShadow; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; end; with FPagingNumDefStyle do begin Borders.Width := 0; Borders.Left.AssignedValues := [wbavWidth]; Borders.Top.AssignedValues := [wbavWidth]; Borders.Right.AssignedValues := [wbavWidth]; Borders.Bottom.AssignedValues := [wbavWidth]; Shading.AssignedValues := []; end; with FItemsDefStyle do begin Borders.Right.Color := clWebThreeDHighlight; Borders.Bottom.Color := clWebThreeDHighlight; Borders.Left.Color := clWebThreeDShadow; Borders.Top.Color := clWebThreeDShadow; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebWindow; Shading.AssignedValues := [wsavColor]; end; end; function TcxWebDesignCustomTable.GetInternalWebControl: TcxAccessWebTable; begin Result := TcxAccessWebTable(inherited GetInternalWebControl as TcxCustomWebTable); end; function TcxWebDesignCustomTable.GetColumnWidth(AColumn: TcxCustomWebTableColumn): Integer; var I, FixedWidth, FixedCount: Integer; MaxWidth: Integer; begin Result := AColumn.Width; if Result = 0 then begin FixedWidth := 0; FixedCount := 0; for I := 0 to Table.Columns.Count - 1 do if Table.Columns[I].Width > 0 then begin Inc(FixedWidth, Table.Columns[I].Width); Inc(FixedCount); end; MaxWidth := Table.Width - ControlWebStyle.Borders.HorzBordersSize - Table.CellSpacing * (2 + Table.Columns.Count - 1); Result := (MaxWidth - FixedWidth) div (Table.Columns.Count - FixedCount); end; end; procedure TcxWebDesignCustomTable.DrawInterior(var R: TRect); begin DrawPagings(R); if Table.ShowHeaders then DrawHeader(R); DrawItems(R); end; procedure TcxWebDesignCustomTable.DrawPagings(var ARect: TRect); var AHeight: Integer; DrawRect: TRect; AStyle: TcxWebStyle; begin if (Table.Paging.PagingType = tptNone) or (Table.Paging.MaxPageIndex = 0) then exit; DrawRect := ARect; if Table.Styles.Default <> nil then AStyle := GetDrawStyle(Table.PagingStyles.Default, ControlWebStyle) else AStyle := GetDrawStyle(Table.PagingStyles.Default, FPagingDefStyle); AHeight := CalcStylishTextExtent(Canvas, AStyle, 'Wg').cy; if Table.Paging.PagingType in [tptTop, tptBoth] then begin DrawRect.Bottom := ARect.Top + AHeight; Inc(DrawRect.Bottom, (Table.CellPadding + Table.CellSpacing) * 2); Inc(DrawRect.Bottom, AStyle.Borders.VertBordersSize); ARect.Top := DrawRect.Bottom; InflateRect(DrawRect, -Table.CellSpacing, -Table.CellSpacing); DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if wsavColor in AStyle.Shading.AssignedValues then begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := AStyle.Shading.Color; Canvas.FillRect(DrawRect); end; InflateRect(DrawRect, -Table.CellPadding, -Table.CellPadding); DrawPaging(DrawRect); end; DrawRect := ARect; if Table.Paging.PagingType in [tptBottom, tptBoth] then begin DrawRect.Top := ARect.Bottom - AHeight; Dec(DrawRect.Top, (Table.CellPadding + Table.CellSpacing) * 2); Dec(DrawRect.Top, AStyle.Borders.VertBordersSize); ARect.Bottom := DrawRect.Top; InflateRect(DrawRect, -Table.CellSpacing, -Table.CellSpacing); DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if wsavColor in AStyle.Shading.AssignedValues then begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := AStyle.Shading.Color; Canvas.FillRect(DrawRect); end; InflateRect(DrawRect, -Table.CellPadding, -Table.CellPadding); DrawPaging(DrawRect); end; AStyle.Free; end; procedure TcxWebDesignCustomTable.DrawPaging(ARect: TRect); var Str: string; I, StrWidth: Integer; AStyle: TcxWebStyle; AParentStyleItem: TcxWebStyleItem; DrawRect: TRect; begin // TODO: each element should be drawn separately // TODO: SelectingPagingNumbersStyles support if Table.GetPageIndex = Table.Paging.StartPageIndex then Str := '<' else Str := '<<'; for I := Table.Paging.StartPageIndex to Table.Paging.EndPageIndex - 1 do begin Str := Str + ' ' + IntToStr(I + 1) + ' '; end; if Table.Paging.EndPageIndex = Table.Paging.MaxPageIndex then Str := Str + '>' else Str := Str + '>>'; AParentStyleItem := Table.PagingStyles.Default; if AParentStyleItem = nil then AParentStyleItem := Table.Styles.Default; AStyle := GetDrawStyle(Table.PagingNumbersStyles.Default, FPagingNumDefStyle); if AParentStyleItem <> nil then begin AStyle.Merge(AParentStyleItem.Style); if Table.PagingNumbersStyles.Default = nil then AStyle.Font.Assign(AParentStyleItem.Style.Font); end; StrWidth := CalcStylishTextExtent(Canvas, AStyle, Str).cx + AStyle.Borders.HorzBordersSize; case Table.Paging.Alignment of whalCenter: DrawRect := Bounds(ARect.Left + (ARect.Right - ARect.Left - StrWidth) div 2, ARect.Top, StrWidth, ARect.Bottom - ARect.Top); whalRight: DrawRect := Bounds(ARect.Right - StrWidth, ARect.Top, StrWidth, ARect.Bottom - ARect.Top); else DrawRect := Bounds(ARect.Left, ARect.Top, StrWidth, ARect.Bottom - ARect.Top); end; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); DrawStylishText(Canvas, DrawRect, AStyle, Str); AStyle.Free; end; procedure TcxWebDesignCustomTable.DrawHeader(var ARect: TRect); var AHeight, I: Integer; DrawRect: TRect; AStyle: TcxWebStyle; begin if Table.Columns.Count = 0 then Exit; DrawRect := ARect; if Table.Styles.Default <> nil then AStyle := GetDrawStyle(Table.HeaderStyles.Default, ControlWebStyle) else AStyle := GetDrawStyle(Table.HeaderStyles.Default, FHeaderDefStyle); AHeight := CalcStylishTextExtent(Canvas, AStyle, 'Wg').cy; DrawRect.Bottom := ARect.Top + AHeight; Inc(DrawRect.Bottom, Table.CellPadding * 2 + Table.CellSpacing); Inc(DrawRect.Bottom, AStyle.Borders.VertBordersSize); ARect.Top := DrawRect.Bottom; InflateRect(DrawRect, -Table.CellSpacing, 0); Dec(DrawRect.Bottom, Table.CellSpacing); for I := 0 to Table.Columns.Count - 1 do DrawCell(I, AStyle, Table.Columns[I].TitleAlignment, Table.Columns[I].Title, DrawRect); AStyle.Free; end; procedure TcxWebDesignCustomTable.DrawCell(Index: Integer; AStyle: TcxWebStyle; AAlignment: TcxWebHorzAlignment; Text: string; var ARect: TRect); var DrawRect: TRect; Alignment: TcxTextHAlignment; begin DrawRect := ARect; if Index <> Table.Columns.Count - 1 then begin DrawRect.Right := DrawRect.Left + GetColumnWidth(Table.Columns[Index]); ARect.Left := DrawRect.Right + Table.CellSpacing; end else DrawRect.Right := ARect.Right; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); if wsavColor in AStyle.Shading.AssignedValues then begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := AStyle.Shading.Color; Canvas.FillRect(DrawRect); end; case AAlignment of whalCenter: Alignment := thaCenter; whalLeft: Alignment := thaLeft; whalRight: Alignment := thaRight; else Alignment := thaNone; end; InflateRect(DrawRect, -Table.CellPadding, -Table.CellPadding); DrawStylishText(Canvas, DrawRect, AStyle, Text, Alignment, tvaCenter, False); end; procedure TcxWebDesignCustomTable.DrawItems(var ARect: TRect); var I: Integer; begin if Table.GetEndRowIndex < Table.GetStartRowIndex then Exit; for I := Table.GetStartRowIndex to Table.GetEndRowIndex do DrawRow(I, ARect); end; procedure TcxWebDesignCustomTable.DrawRow(AIndex: Integer; var ARect: TRect); var ARowStyle, ACellStyle: TcxWebStyle; AHeight: Integer; I: Integer; DrawRect: TRect; begin if ARect.Bottom < ARect.Top then Exit; DrawRect := ARect; if Table.Styles.Default <> nil then ARowStyle := GetDrawStyle(Table.ItemsStyles.Default, ControlWebStyle) else ARowStyle := GetDrawStyle(Table.ItemsStyles.Default, FItemsDefStyle); if (Table.AlternatingItemsStyles.Default <> nil) and Odd(AIndex - Table.GetStartRowIndex) then begin ARowStyle.Free; if Table.Styles.Default <> nil then ARowStyle := GetDrawStyle(Table.AlternatingItemsStyles.Default, ControlWebStyle) else ARowStyle := GetDrawStyle(Table.AlternatingItemsStyles.Default, FItemsDefStyle); end; AHeight := CalcStylishTextExtent(Canvas, ARowStyle, 'Wg').cy; DrawRect.Bottom := ARect.Top + AHeight; Inc(DrawRect.Bottom, Table.CellPadding * 2 + Table.CellSpacing); Inc(DrawRect.Bottom, ARowStyle.Borders.VertBordersSize); ARect.Top := DrawRect.Bottom; InflateRect(DrawRect, -Table.CellSpacing, 0); Dec(DrawRect.Bottom, Table.CellSpacing); if DrawRect.Bottom > ARect.Bottom then begin DrawRect.Bottom := ARect.Bottom; with Canvas do begin Brush.Style := bsSolid; Brush.Color := clWhite; Pen.Style := psSolid; Pen.Width := 1; Pen.Color := clRed; Rectangle(DrawRect); PenPos := DrawRect.TopLeft; LineTo(DrawRect.Right - 1, DrawRect.Bottom - 1); MoveTo(DrawRect.Right - 1, DrawRect.Top); LineTo(DrawRect.Left, DrawRect.Bottom - 1); end; Exit; end; for I := 0 to Table.Columns.Count - 1 do begin ACellStyle := GetDrawStyle(Table.Columns[I].Styles.Default, ARowStyle); DrawCell(I, ACellStyle, Table.Columns[I].Alignment, Table.GetDisplayText(Table.Columns[I], AIndex), DrawRect); ACellStyle.Free; end; ARowStyle.Free; end; { TcxWebDesignExtDBLookup } constructor TcxWebDesignExtDBLookup.Create(AOwner: TComponent); begin FButtonDefStyle := TcxWebStyle.Create(nil); inherited; FButtonImage := TBitmap.Create; FButtonImage.LoadFromResourceName(HInstance, 'CXWEBDATEEDIT'); FButtonImage.Transparent := True; end; procedure TcxWebDesignExtDBLookup.DefineDefaultWebStyle; begin inherited; with FButtonDefStyle do begin Borders.Color := clWebButtonHighlight; Borders.Width := 2; Borders.Style := wbsOutset; Shading.Color := clWebButtonFace; Shading.AssignedValues := [wsavColor]; Borders.Left.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Top.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Right.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; Borders.Bottom.AssignedValues := [wbavColor, wbavStyle, wbavWidth]; end; end; destructor TcxWebDesignExtDBLookup.Destroy; begin FButtonDefStyle.Free; FButtonImage.Free; inherited; end; procedure TcxWebDesignExtDBLookup.DrawButton(var R: TRect); var DrawRect: TRect; AStyle: TcxWebStyle; OffX, OffY: Integer; begin DrawRect := R; Dec(R.Right, WebExtDBLookup.ButtonWidth); DrawRect.Left := R.Right; AStyle := GetDrawStyle(WebExtDBLookup.ButtonStyles.Default, FButtonDefStyle); with Canvas do begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := WebColorToColor(AStyle.Shading.Color); FillRect(DrawRect); end; DrawStylishBorder(Canvas, AStyle.Borders, DrawRect); OffX := (DrawRect.Right - DrawRect.Left - FButtonImage.Width) div 2; OffY := (DrawRect.Bottom - DrawRect.Top - FButtonImage.Height) div 2; Canvas.Draw(DrawRect.Left + OffX, Drawrect.Top + OffY, FButtonImage); AStyle.Free; end; procedure TcxWebDesignExtDBLookup.DrawFace; var R: TRect; begin R := ClientRect; DrawButton(R); DrawBorder(R); DrawStylishText(Canvas, R, ControlWebStyle, GetControlText, thaLeft, tvaCenter); end; function TcxWebDesignExtDBLookup.GetControlText: string; begin Result := WebExtDBLookup.Text; end; function TcxWebDesignExtDBLookup.GetInternalWebControl: TcxWebExtDBLookup; begin Result := inherited GetInternalWebControl as TcxWebExtDBLookup; end; function TcxWebDesignExtDBLookup.GetMainControlStyles: TcxWebStyles; begin Result := WebExtDBLookup.EditorStyles; end; { TcxWebDesignNavBar } constructor TcxWebDesignNavBar.Create(AOwner: TComponent); begin FHeaderDefStyle := TcxWebStyle.Create(nil); FColHeaderDefStyle := TcxWebStyle.Create(nil); inherited; FLeftColImage := TBitmap.Create; FLeftColImage.LoadFromResourceName(HInstance, 'CXWEBNB_LEFTCOL'); FLeftColImage.Transparent := True; FLeftExpImage := TBitmap.Create; FLeftExpImage.LoadFromResourceName(HInstance, 'CXWEBNB_LEFTEXP'); FLeftExpImage.Transparent := True; FRightColImage := TBitmap.Create; FRightColImage.LoadFromResourceName(HInstance, 'CXWEBNB_RIGHTCOL'); FRightColImage.Transparent := True; FRightExpImage := TBitmap.Create; FRightExpImage.LoadFromResourceName(HInstance, 'CXWEBNB_RIGHTEXP'); FRightExpImage.Transparent := True; end; destructor TcxWebDesignNavBar.Destroy; begin FHeaderDefStyle.Free; FColHeaderDefStyle.Free; FLeftColImage.Free; FLeftExpImage.Free; FRightColImage.Free; FRightExpImage.Free; inherited; end; procedure TcxWebDesignNavBar.DrawGroup(Index: Integer; var XPos, YPos: Integer); begin DrawGroupHeader(Index, XPos, YPos); if WebNavBar.Groups[Index].Expanded then DrawGroupBody(Index, XPos, YPos); Inc(YPos, 2); end; procedure TcxWebDesignNavBar.DrawGroupHeader(Index: Integer; var XPos, YPos: Integer); var R: TRect; AStyle: TcxWebStyle; H: Integer; ALeftImage, ARightImage: TBitmap; begin if WebNavBar.Groups[Index].Expanded then begin AStyle := GetDrawStyle(WebNavBar.HeaderStyles.Default, FHeaderDefStyle); H := Max(FLeftExpImage.Height, FRightExpImage.Height); ALeftImage := FLeftExpImage; ARightImage := FRightExpImage; end else begin AStyle := GetDrawStyle(WebNavBar.HeaderCollapsedStyles.Default, FColHeaderDefStyle); H := Max(FLeftColImage.Height, FRightColImage.Height); ALeftImage := FLeftColImage; ARightImage := FRightColImage; end; H := Max(H, CalcStylishTextExtent(Canvas, AStyle, 'Wq').cx); R := Bounds(XPos, YPos, WebNavBar.Width - 1, H); with Canvas do begin Brush.Style := bsSolid; Brush.Color := WebColorToColor(AStyle.Shading.Color); Pen.Style := psSolid; Pen.Width := 1; // AStyle.Borders.Width; Pen.Color := WebColorToColor(AStyle.Borders.Color); Polygon([Point(R.Left + 2, R.Top), Point(R.Right - 2, R.Top), Point(R.Right, R.Top + 2), Point(R.Right, R.Bottom), Point(R.Left, R.Bottom), Point(R.Left, R.Top + 2)]); Draw(R.Left + 2, R.Top + (R.Bottom - R.Top - ALeftImage.Height) div 2, ALeftImage); end; Inc(R.Left, ALeftImage.Width + 3); DrawStylishText(Canvas, R, AStyle, WebNavBar.Groups[Index].Text, thaLeft, tvaCenter, False); Canvas.Draw(R.Right - ARightImage.Width - 2, R.Top + (R.Bottom - R.Top - ARightImage.Height) div 2, ARightImage); XPos := 0; YPos := R.Bottom + 1; AStyle.Free; end; procedure TcxWebDesignNavBar.DrawGroupBody(Index: Integer; var XPos, YPos: Integer); var I, ItemCount: Integer; R, ARect: TRect; H: Integer; begin H := CalcStylishTextExtent(Canvas, ControlWebStyle, 'Wq').cx + WebNavBar.SeparatorWidth; ItemCount := WebNavBar.Groups[Index].Items.Count; with Canvas do begin R := Bounds(XPos, YPos, WebNavBar.Width, H * ItemCount); Brush.Style := bsSolid; Brush.Color := WebColorToColor(ControlWebStyle.Shading.Color); FillRect(R); Pen.Style := psSolid; Pen.Width := 1; // ControlWebStyle.Borders.Width Pen.Color := WebColorToColor(ControlWebStyle.Borders.Color); MoveTo(R.Left, R.Top); LineTo(R.Left, R.Bottom); LineTo(R.Right - 1, R.Bottom); LineTo(R.Right - 1, R.Top - 1); end; for I := 0 to ItemCount - 1 do begin R := Bounds(XPos + 26, YPos, WebNavBar.Width - 1, H); Canvas.Brush.Color := WebColorToColor(ControlWebStyle.Font.Color); Canvas.Pen.Color := WebColorToColor(ControlWebStyle.Font.Color); ARect := Bounds(R.Left, R.Top + H div 2 - 3, 5, 5); Canvas.Ellipse(ARect); Inc(R.Left, 26); DrawStylishText(Canvas, R, ControlWebStyle, WebNavBar.Groups[Index].Items[I].Text, thaLeft, tvaCenter, False); XPos := 0; YPos := R.Bottom; end; end; procedure TcxWebDesignNavBar.DrawInterior(var R: TRect); var I, XPos, YPos: Integer; begin if WebNavBar.Groups.Count = 0 then with Canvas do begin Brush.Style := bsClear; Pen.Color := clBtnShadow; Pen.Style := psSolid; Pen.Width := 1; Rectangle(R); Canvas.Font.Color := clBtnShadow; Canvas.Font.Style := []; Canvas.Font.Size := 10; DoTextRect(Canvas, R, R.Left, R.Top, '(no items)', thaCenter, tvaCenter); Exit; end; XPos := 0; YPos := 0; for I := 0 to WebNavBar.Groups.Count - 1 do DrawGroup(I, XPos, YPos); end; procedure TcxWebDesignNavBar.DrawFace; var R: TRect; begin R := ClientRect; Canvas.Brush.Style := bsClear; WebFontToFont(ControlWebStyle.Font, Canvas.Font); DrawInterior(R); end; procedure TcxWebDesignNavBar.DefineDefaultWebStyle; begin inherited; with DefaultWebStyle do begin Borders.Color := clWebSteelBlue; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebWhite; Shading.AssignedValues := [wsavColor]; Font.Color := clWebDarkSlateGray; end; with FHeaderDefStyle do begin Borders.Color := clWebSteelBlue; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebSteelBlue; Shading.AssignedValues := [wsavColor]; Font.Color := clWebWhite; end; with FColHeaderDefStyle do begin Borders.Color := clWebDarkGray; Borders.Style := wbsSolid; Borders.Width := 1; Shading.Color := clWebSilver; Shading.AssignedValues := [wsavColor]; Font.Color := clWebDarkBlue; end; end; function TcxWebDesignNavBar.GetInternalWebControl: TcxWebNavBar; begin Result := inherited GetInternalWebControl as TcxWebNavBar; end; { registration helpers } procedure RegisterDesignControls; begin with WebDesignControlsFactory do begin RegisterDesignControl(TcxWebControl, TcxWebDesignControl); RegisterDesignControl(TcxWebCustomControl, TcxWebDesignCustomControl); RegisterDesignControl(TcxCustomWebLabel, TcxWebDesignLabel); RegisterDesignControl(TcxWebButton, TcxWebDesignButton); RegisterDesignControl(TcxCustomWebEdit, TcxWebDesignEdit); RegisterDesignControl(TcxCustomWebMemo, TcxWebDesignMemo); RegisterDesignControl(TcxCustomWebListBox, TcxWebDesignListBox); RegisterDesignControl(TcxCustomWebComboBox, TcxWebDesignComboBox); RegisterDesignControl(TcxCustomWebCheckBox, TcxWebDesignCheckBox); RegisterDesignControl(TcxCustomWebRadioGroup, TcxWebDesignRadioGroup); RegisterDesignControl(TcxCustomWebImage, TcxWebDesignImage); RegisterDesignControl(TcxCustomWebGrid, TcxWebDesignCustomGrid); RegisterDesignControl(TcxCustomWebDataNavigator, TcxWebDesignDataNavigator); RegisterDesignControl(TcxWebTreeView, TcxWebDesignTreeView); RegisterDesignControl(TcxWebPanel, TcxWebDesignPanel); RegisterDesignControl(TcxWebMainMenu, TcxWebDesignMainMenu); RegisterDesignControl(TcxCustomWebCalendar, TcxWebDesignCalendar); RegisterDesignControl(TcxCustomWebDateEdit, TcxWebDesignDateEdit); RegisterDesignControl(TcxCustomWebTable, TcxWebDesignCustomTable); RegisterDesignControl(TcxWebExtDBLookup, TcxWebDesignExtDBLookup); RegisterDesignControl(TcxWebNavBar, TcxWebDesignNavBar); end; end; procedure UnregisterDesignControls; begin with WebDesignControlsFactory do begin UnregisterDesignControl(TcxWebDesignNavBar); UnregisterDesignControl(TcxWebDesignExtDBLookup); UnregisterDesignControl(TcxWebDesignCustomTable); UnregisterDesignControl(TcxWebDesignDateEdit); UnregisterDesignControl(TcxWebDesignCalendar); UnregisterDesignControl(TcxWebDesignMainMenu); UnregisterDesignControl(TcxWebDesignPanel); UnregisterDesignControl(TcxWebDesignTreeView); UnregisterDesignControl(TcxWebDesignDataNavigator); UnregisterDesignControl(TcxWebDesignCustomGrid); UnregisterDesignControl(TcxWebDesignImage); UnregisterDesignControl(TcxWebDesignRadioGroup); UnregisterDesignControl(TcxWebDesignCheckBox); UnregisterDesignControl(TcxWebDesignComboBox); UnregisterDesignControl(TcxWebDesignListBox); UnregisterDesignControl(TcxWebDesignMemo); UnregisterDesignControl(TcxWebDesignEdit); UnregisterDesignControl(TcxWebDesignButton); UnregisterDesignControl(TcxWebDesignLabel); UnregisterDesignControl(TcxWebDesignCustomControl); UnregisterDesignControl(TcxWebDesignControl); end; end; initialization RegisterDesignControls; FCanvasBrush := TBrush.Create; FCanvasFont := TFont.Create; FCanvasPen := TPen.Create; finalization UnregisterDesignControls; FCanvasBrush.Free; FCanvasFont.Free; FCanvasPen.Free; end.