{*******************************************************************} { } { Developer Express Visual Component Library } { ExpressPrinting System(tm) COMPONENT SUITE } { } { Copyright (C) 1998-2008 Developer Express Inc. } { ALL RIGHTS RESERVED } { } { The entire contents of this file is protected by U.S. and } { International Copyright Laws. Unauthorized reproduction, } { reverse-engineering, and distribution of all or any portion of } { the code contained in this file is strictly prohibited and may } { result in severe civil and criminal penalties and will be } { prosecuted to the maximum extent possible under the law. } { } { RESTRICTIONS } { } { THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES } { (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE } { SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS } { LICENSED TO DISTRIBUTE THE EXPRESSPRINTINGSYSTEM AND } { ALL ACCOMPANYING VCL CONTROLS AS PART OF AN } { EXECUTABLE PROGRAM ONLY. } { } { THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED } { FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE } { COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE } { AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT } { AND PERMISSION FROM DEVELOPER EXPRESS INC. } { } { CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON } { ADDITIONAL RESTRICTIONS. } { } {*******************************************************************} unit dxPSShapes; interface {$I cxVer.inc} uses Classes, Windows, Graphics, dxBase, dxPSCore, dxPSFillPatterns; type TdxReportCellShapeClass = class of TCustomdxReportCellShape; TdxPSShapeFactory = class(TdxCustomClassFactory) private function GetItem(Index: Integer): TdxReportCellShapeClass; public class function Instance: TdxPSShapeFactory; reintroduce; overload; procedure GetList(const AStrings: TStrings); property Items[Index: Integer]: TdxReportCellShapeClass read GetItem; default; end; TCustomdxReportCellShape = class(TAbstractdxReportCellData) private FContentBkColor: TColor; FContentPattern: TdxPSFillPatternClass; FShapeBorderColor: TColor; FShapeBorderThickness: Integer; FShapeColor: TColor; function GetShapeTransparent: Boolean; procedure SetShapeBorderThickness(Value: Integer); procedure SetShapeTransparent(Value: Boolean); protected function GetContentBkColor: TColor; override; function GetContentPattern: TdxPSFillPatternClass; override; procedure SetContentBkColor(Value: TColor); override; procedure SetContentPattern(Value: TdxPSFillPatternClass); override; procedure ReadData(AReader: TdxPSDataReader); override; procedure WriteData(AWriter: TdxPSDataWriter); override; function GetShapeCenter: TPoint; virtual; function GetShapeHeight: Integer; virtual; function GetShapeRect: TRect; virtual; function GetShapeWidth: Integer; virtual; public constructor Create(AParent: TdxReportCell); override; procedure Assign(Source: TPersistent); override; class function Name: string; virtual; class procedure RegisterShape; virtual; class procedure UnregisterShape; virtual; property ShapeBorderColor: TColor read FShapeBorderColor write FShapeBorderColor; property ShapeBorderThickness: Integer read FShapeBorderThickness write SetShapeBorderThickness; property ShapeCenter: TPoint read GetShapeCenter; property ShapeColor: TColor read FShapeColor write FShapeColor; property ShapeHeight: Integer read GetShapeHeight; property ShapeRect: TRect read GetShapeRect; property ShapeTransparent: Boolean read GetShapeTransparent write SetShapeTransparent; property ShapeWidth: Integer read GetShapeWidth; end; TCustomdxReportCellEllipseShape = class(TCustomdxReportCellShape) private function GetRadiusHorz: Integer; function GetRadiusVert: Integer; protected property RadiusHorz: Integer read GetRadiusHorz; property RadiusVert: Integer read GetRadiusVert; public procedure DrawContent(DC: HDC; AStage: TdxPSRenderStages); override; end; TdxReportCellEllipse = class(TCustomdxReportCellEllipseShape) public class function Name: string; override; property RadiusHorz; property RadiusVert; end; TdxReportCellCircle = class(TCustomdxReportCellEllipseShape) private function GetRadius: Integer; protected function GetShapeHeight: Integer; override; function GetShapeWidth: Integer; override; public class function Name: string; override; property Radius: Integer read GetRadius; end; TCustomdxReportCellRectangle = class(TCustomdxReportCellShape) protected function GetShapeRect: TRect; override; public procedure DrawContent(DC: HDC; AStage: TdxPSRenderStages); override; end; TdxReportCellRectangle = class(TCustomdxReportCellRectangle) public class function Name: string; override; end; TdxReportCellSquare = class(TCustomdxReportCellRectangle) protected function GetShapeHeight: Integer; override; function GetShapeWidth: Integer; override; public class function Name: string; override; end; TdxReportCellRoundRect = class(TCustomdxReportCellRectangle) private FEllipseHeight: Integer; FEllipseWidth: Integer; procedure SetEllipseHeight(Value: Integer); procedure SetEllipseWidth(Value: Integer); protected procedure ConvertCoords(APixelsNumerator, APixelsDenominator: Integer); override; public constructor Create(AParent: TdxReportCell); override; procedure Assign(Source: TPersistent); override; procedure DrawContent(DC: HDC; AStage: TdxPSRenderStages); override; class function Name: string; override; property EllipseHeight: Integer read FEllipseHeight write SetEllipseHeight; property EllipseWidth: Integer read FEllipseWidth write SetEllipseWidth; end; TdxReportCellRoundSquare = class(TdxReportCellRoundRect) protected function GetShapeHeight: Integer; override; function GetShapeWidth: Integer; override; public class function Name: string; override; end; implementation uses cxClasses, dxPSGlbl, dxPSRes, dxPSUtl; { TdxPSShapeFactory } function dxPSShapeFactory: TdxPSShapeFactory; begin Result := TdxPSShapeFactory.Instance; end; class function TdxPSShapeFactory.Instance: TdxPSShapeFactory; begin Result := inherited Instance as TdxPSShapeFactory; end; procedure TdxPSShapeFactory.GetList(const AStrings: TStrings); var I: Integer; Shape: TdxReportCellShapeClass; begin AStrings.BeginUpdate; try for I := 0 to Count - 1 do begin Shape := Items[I]; AStrings.AddObject(Shape.Name, TObject(Shape)); end; finally AStrings.EndUpdate; end; end; function TdxPSShapeFactory.GetItem(Index: Integer): TdxReportCellShapeClass; begin Result := TdxReportCellShapeClass(inherited Items[Index]); end; { TCustomdxReportCellShape } constructor TCustomdxReportCellShape.Create(AParent: TdxReportCell); begin inherited; FShapeBorderColor := clBlack; FShapeBorderThickness := 1; end; procedure TCustomdxReportCellShape.Assign(Source: TPersistent); begin inherited; if Source is TCustomdxReportCellShape then with TCustomdxReportCellShape(Source) do begin Self.ShapeBorderColor := ShapeBorderColor; Self.ShapeBorderThickness := ShapeBorderThickness; Self.ShapeColor := ShapeColor; end; end; class function TCustomdxReportCellShape.Name: string; begin Result := ''; end; class procedure TCustomdxReportCellShape.RegisterShape; begin dxPSShapeFactory.Register(Self); end; class procedure TCustomdxReportCellShape.UnregisterShape; begin dxPSShapeFactory.Unregister(Self); end; function TCustomdxReportCellShape.GetContentBkColor: TColor; begin Result := FContentBkColor; end; function TCustomdxReportCellShape.GetContentPattern: TdxPSFillPatternClass; begin Result := FContentPattern; end; procedure TCustomdxReportCellShape.SetContentBkColor(Value: TColor); begin FContentBkColor := Value; end; procedure TCustomdxReportCellShape.SetContentPattern(Value: TdxPSFillPatternClass); begin FContentPattern := Value; end; procedure TCustomdxReportCellShape.ReadData(AReader: TdxPSDataReader); begin inherited; ShapeBorderColor := AReader.ReadInteger; ShapeBorderThickness := AReader.ReadInteger; ShapeColor := AReader.ReadInteger; end; procedure TCustomdxReportCellShape.WriteData(AWriter: TdxPSDataWriter); begin inherited; AWriter.WriteInteger(ShapeBorderColor); AWriter.WriteInteger(ShapeBorderThickness); AWriter.WriteInteger(ShapeColor); end; function TCustomdxReportCellShape.GetShapeCenter: TPoint; begin Result.X := Left + Width div 2; Result.Y := Top + Height div 2; end; function TCustomdxReportCellShape.GetShapeHeight: Integer; begin Result := Height; end; function TCustomdxReportCellShape.GetShapeRect: TRect; var SW, SH: Integer; begin SH := ShapeHeight; SW := ShapeWidth; with ShapeCenter do Result := MakeBounds(X - SW div 2, Y - SH div 2, SW, SH); end; function TCustomdxReportCellShape.GetShapeWidth: Integer; begin Result := Width; end; function TCustomdxReportCellShape.GetShapeTransparent: Boolean; begin Result := GetFormatBit(dxFormatShapeTransparent); end; procedure TCustomdxReportCellShape.SetShapeBorderThickness(Value: Integer); begin if Value < 0 then Value := 0; FShapeBorderThickness := Value; end; procedure TCustomdxReportCellShape.SetShapeTransparent(Value: Boolean); begin SetFormatBit(dxFormatShapeTransparent, Value); end; { TCustomdxReportCellEllipseShape } procedure TCustomdxReportCellEllipseShape.DrawContent(DC: HDC; AStage: TdxPSRenderStages); begin Renderer.DrawEllipse(DC, ShapeRect, ShapeColor, ContentBkColor, ContentPattern, ShapeBorderColor, ShapeBorderThickness); end; function TCustomdxReportCellEllipseShape.GetRadiusHorz: Integer; begin Result := ShapeWidth div 2; end; function TCustomdxReportCellEllipseShape.GetRadiusVert: Integer; begin Result := ShapeHeight div 2; end; { TdxReportCellEllipse } class function TdxReportCellEllipse.Name: string; begin Result := cxGetResourcestring(@sdxEllipse); end; { TdxReportCellCircle } class function TdxReportCellCircle.Name: string; begin Result := cxGetResourcestring(@sdxCircle); end; function TdxReportCellCircle.GetShapeHeight: Integer; begin if Width > Height then Result := inherited GetShapeHeight else Result := ShapeWidth; end; function TdxReportCellCircle.GetShapeWidth: Integer; begin if Width > Height then Result := ShapeHeight else Result := inherited GetShapeWidth; end; function TdxReportCellCircle.GetRadius: Integer; begin Result := RadiusHorz; end; { TCustomdxReportCellRectangle } procedure TCustomdxReportCellRectangle.DrawContent(DC: HDC; AStage: TdxPSRenderStages); begin Renderer.DrawRectangle(DC, ShapeRect, ShapeColor, ContentBkColor, ContentPattern, ShapeBorderColor, ShapeBorderThickness); end; function TCustomdxReportCellRectangle.GetShapeRect: TRect; var SH, SW: Integer; begin SH := ShapeHeight; SW := ShapeWidth; with ShapeCenter do Result := MakeBounds(X - SW div 2, Y - SH div 2, SW, SH); end; { TdxReportCellRectangle } class function TdxReportCellRectangle.Name: string; begin Result := cxGetResourcestring(@sdxRectangle); end; { TdxReportCellSquare } class function TdxReportCellSquare.Name: string; begin Result := cxGetResourcestring(@sdxSquare); end; function TdxReportCellSquare.GetShapeHeight: Integer; begin if Width > Height then Result := inherited GetShapeHeight else Result := ShapeWidth; end; function TdxReportCellSquare.GetShapeWidth: Integer; begin if Width > Height then Result := ShapeHeight else Result := inherited GetShapeWidth; end; { TdxReportCellRoundRect } constructor TdxReportCellRoundRect.Create(AParent: TdxReportCell); begin inherited; FEllipseHeight := 2; FEllipseWidth := 2; end; procedure TdxReportCellRoundRect.Assign(Source: TPersistent); begin inherited; if Source is TdxReportCellRoundRect then with TdxReportCellRoundRect(Source) do begin Self.EllipseHeight := EllipseHeight; Self.EllipseWidth := EllipseWidth; end; end; procedure TdxReportCellRoundRect.DrawContent(DC: HDC; AStage: TdxPSRenderStages); begin Renderer.DrawRoundRect(DC, ShapeRect, EllipseWidth, EllipseHeight, ShapeColor, ContentBkColor, ContentPattern, ShapeBorderColor, ShapeBorderThickness); end; class function TdxReportCellRoundRect.Name: string; begin Result := cxGetResourcestring(@sdxRoundRect); end; procedure TdxReportCellRoundRect.ConvertCoords(APixelsNumerator, APixelsDenominator: Integer); begin inherited; FEllipseHeight := MulDiv(FEllipseHeight, APixelsNumerator, APixelsDenominator); FEllipseWidth := MulDiv(FEllipseWidth, APixelsNumerator, APixelsDenominator); end; procedure TdxReportCellRoundRect.SetEllipseHeight(Value: Integer); begin if Value < 0 then Value := 0; FEllipseHeight := Value; end; procedure TdxReportCellRoundRect.SetEllipseWidth(Value: Integer); begin if Value < 0 then Value := 0; FEllipseWidth := Value; end; { TdxReportCellRoundSquare } class function TdxReportCellRoundSquare.Name: string; begin Result := cxGetResourcestring(@sdxRoundSquare); end; function TdxReportCellRoundSquare.GetShapeHeight: Integer; begin if Width > Height then Result := inherited GetShapeHeight else Result := ShapeWidth; end; function TdxReportCellRoundSquare.GetShapeWidth: Integer; begin if Width > Height then Result := ShapeHeight else Result := inherited GetShapeWidth; end; procedure RegisterItems; begin TdxReportCellEllipse.Register; TdxReportCellCircle.Register; TdxReportCellRectangle.Register; TdxReportCellSquare.Register; TdxReportCellRoundRect.Register; TdxReportCellRoundSquare.Register; end; procedure RegisterShapes; begin TdxReportCellEllipse.RegisterShape; TdxReportCellCircle.RegisterShape; TdxReportCellRectangle.RegisterShape; TdxReportCellSquare.RegisterShape; TdxReportCellRoundRect.RegisterShape; TdxReportCellRoundSquare.RegisterShape; end; procedure UnregisterItems; begin TdxReportCellRoundSquare.Unregister; TdxReportCellRoundRect.Unregister; TdxReportCellSquare.Unregister; TdxReportCellRectangle.Unregister; TdxReportCellCircle.Unregister; TdxReportCellEllipse.Unregister; end; initialization RegisterItems; RegisterShapes; finalization UnregisterItems; end.