drawingobjchart2.pas

一个经典的读写Excel的控件

unit DrawingObjChart2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$B-}

interface

uses Classes, SysUtils, BIFFRecsII2, DrawingObjAnchor2, Escher2, XLSFonts2,
     RecordStorageChart2, FormulaHandler2, XLSUtils2, EscherTypes2, Contnrs,
     XLSStream2;

type TChartLineStyle = (clsSolid,clsDash,clsDot,clsDashDot,clsDashDotDot,
     clsNone,clsDarkGray,clsMediumGray,clsLightGray);
{$ifdef ver130}
type TChartLineWeight = (clwNarrow,clwMedium,clwWide,clwHairline);
{$else}
type TChartLineWeight = (clwNarrow,clwMedium,clwWide,clwHairline = $FFFF);
{$endif}
type TChartMarkerStyle = (cmsNone,cmsSquare,cmsDiamond,cmsTriangle,cmsX,cmsStar,
     cmsDowJones,cmsStandardDeviation,cmsCircle,cmsPlus);
type TChartDataLabel = (cdlValue,cdlValuePercent,cdlSmoothedLine,cdlCategory,
     cdlBubbleSize);
     TChartDataLabels = set of TChartDataLabel;
{$ifdef ver130}
type TChartLabelType = (cltNA1,cltTitle,cltYAxis,cltXAxis,cltDataPoint,cltNA2,cltNA3,cltZAxis);
{$else}
type TChartLabelType = (cltTitle = 1,cltYAxis = 2,cltXAxis = 3,cltDataPoint = 4,cltZAxis = 7);
{$endif}
type TChartSheetOption = (csoOnlyVisibleCells,csoDoNotSize);
     TChartSheetOptions = set of TChartSheetOption;
type TChartEmptyCells = (cecNotPlotted,cecZero,cecInterpolated);
type TTickType = (ttInvisible,ttInside,ttOutside,ttCrossAxis);
type TTickLablePos = (tlpInvisible,tlpLowEnd,tlpHighEnd,tlpNextToAxis);
type TCatSerAxisScalingOption = (csasoCrossesMidCategory,csasoValueCrossesRight,csasoReverseCategories);
type TCatSerAxisScalingOptions = set of TCatSerAxisScalingOption;
type TValueAxisScalingOption = (vasoLogScale,vasoReverse,vasoCategoryAxisCrossing);
type TValueAxisScalingOptions = set of TValueAxisScalingOption;
type TChart3DOption = (c3doPerspectiveTrans,c3doClusterdCols,c3doAutoScaling,c3do2dWalls);
     TChart3DOptions = set of TChart3DOption;
type TChartLegendType = (cltBottom,cltCorner,cltTop,cltRight,cltLeft,cltNotDocked);
type TChartLegendSpacing = (clsClose,clsMedium,clsOpen);
type TSerieItemGeomtery = (sigDefault,sigCylinder,sigPyramid,sigChoppedPyramid,sigCone,sigChoppedCone,sigLast);
type TGradientFillStyle = (gfsHorizontal,gfsVertical,gfsDiagonalUp,gfsDiagonalDown,gfsFromCorner,gfsFromCenter);

type TBmpFileHeader = packed record
     ID: array[0..2] of char;
     Size: longword;
     Unknown1: array[0..2] of byte;
     Unknown2: word;
     Unknown3: word;
     end;

type TXLSChartType = (xctNone,xctArea,xctBubble,xctColumn,xctLine,xctPie,xctRadar,xctScatter,xctSurface);

type TRecordObject = class(TObject)
private
     FRecord: TChartRecord;

     function GetValid: boolean;
protected
     procedure Check; overload;
     procedure Check(Index: integer); overload;
     procedure Assign(Rec: TChartRecord); virtual;
public
     property Valid: boolean read GetValid;
     end;


{     
type TFontBasis = class(TObject)
private
}

type
//: Object that stores settings for how texts are shown in the chart.
    TChartText = class(TRecordObject)
private
     FFont: TXFont;

     function GetColor: TExcelColor;
     procedure SetColor(const Value: TExcelColor);
protected
     procedure Assign(Rec: TChartRecord); override;
public
published
     //: The text color. Please note that the Color property of the Font is
     //: not used for this.
     property Color: TExcelColor read GetColor write SetColor;
     //: The font used for the text.
     property Font: TXFont read FFont;
     end;

type
//: Options for lines in the chart.
    TLineFormat = class(TRecordObject)
private
     function  GetAutomatic: boolean;
     function  GetLineColor: TExcelColor;
     function  GetLineStyle: TChartLineStyle;
     function  GetLineWeight: TChartLineWeight;
     procedure SetAutomatic(const Value: boolean);
     procedure SetLineColor(const Value: TExcelColor);
     procedure SetLineStyle(const Value: TChartLineStyle);
     procedure SetLineWeight(const Value: TChartLineWeight);
protected
     procedure SetDefault;
public
published
     //: Color of the line.
     property LineColor: TExcelColor read GetLineColor write SetLineColor;
     //: Style of the line.
     property LineStyle: TChartLineStyle read GetLineStyle write SetLineStyle;
     //: Width of of the line.
     property LineWeight: TChartLineWeight read GetLineWeight write SetLineWeight;
     //: True if the line is automatic.
     property Automatic: boolean read GetAutomatic write SetAutomatic;
     end;

type
//: Options for areas that are filled with colors and
//: optionally a pattern. The border line is given by @link(TLineFormat).
    TAreaFormat = class(TRecordObject)
private
     function  GetBackgroundColor: TExcelColor;
     function  GetForegroundColor: TExcelColor;
     function  GetPattern: TExcelFillPattern;
     function  GetSwapColorWhenNeg: boolean;
     procedure SetBackgroundColor(const Value: TExcelColor);
     procedure SetForegroundColor(const Value: TExcelColor);
     procedure SetPattern(const Value: TExcelFillPattern);
     procedure SetSwapColorWhenNeg(const Value: boolean);
     function  GetAutomatic: boolean;
     procedure SetAutomatic(const Value: boolean);
protected
     procedure SetDefault;
public
published
     //: Fill pattern style.
     property Pattern: TExcelFillPattern read GetPattern write SetPattern;
     //: Foreground color for the fill pattern. If no fill pattern is used, this
     //: is the color of the area.
     property ForegroundColor: TExcelColor read GetForegroundColor write SetForegroundColor;
     //: Background color for the fill pattern. Only used with fill patterns,
     //: or if SwapColorWhenNeg is True.
     property BackgroundColor: TExcelColor read GetBackgroundColor write SetBackgroundColor;
     //: Set to true if foreground and background colors shall be swaped if
     //: the value that the area correspnds to is negativ.
     property SwapColorWhenNeg: boolean read GetSwapColorWhenNeg write SetSwapColorWhenNeg;
     //: True if the area is automatic.
     property Automatic: boolean read GetAutomatic write SetAutomatic;
     end;

type
//: Options for line markers on line and scatter charts.
    TMarkerFormat = class(TRecordObject)
private
     function  GetAutomatic: boolean;
     function  GetBackgroundColor: TExcelColor;
     function  GetForegroundColor: TExcelColor;
     function  GetMarkerStyle: TChartMarkerStyle;
     function  GetSize: integer;
     procedure SetAutomatic(const Value: boolean);
     procedure SetBackgroundColor(const Value: TExcelColor);
     procedure SetForegroundColor(const Value: TExcelColor);
     procedure SetMarkerStyle(const Value: TChartMarkerStyle);
     procedure SetSize(const Value: integer);
published
     //: Style of the marker, see @link(TChartMarkerStyle).
     property MarkerStyle: TChartMarkerStyle read GetMarkerStyle write SetMarkerStyle;
     //: Foreground color of the marker.
     property ForegroundColor: TExcelColor read GetForegroundColor write SetForegroundColor;
     //: Background color of the marker.
     property BackgroundColor: TExcelColor read GetBackgroundColor write SetBackgroundColor;
     //: True if the colors automatic.
     property Automatic: boolean read GetAutomatic write SetAutomatic;
     //: Size of the markers in units of 1/20th of a point.
     property Size: integer read GetSize write SetSize;
     end;


type
//: A TGelFrame contains optional settings for filling effects on areas in the
//: chart, such as plot area legend, etc. The TGelFrame is not used to just
//: define the colors of an area. See also @link(TPaintFrame).
    TGelFrame = class(TRecordObject)
private
     FOPT: TOPT;

     procedure InsertPICRec;
     procedure RemovePICRec;
     function  GetPictureType: TMSOBlipType;
protected
     procedure Assign(Rec: TChartRecord); override;
     procedure SetDefault;
     procedure UpdateRecord(Sender: TObject);
     // Loads a picture from a TStream. @link(PictType) is the type of picture.
     procedure LoadPictFromStream(Stream: TStream; PictType: TMSOBlipType);
     // Loads a picture from a file.
     procedure LoadPictFromFile(Filename: WideString);
public
     constructor Create;
     destructor Destroy; override;
     //: Saves the picture to a TStream. This assumes that the filling effect
     //: is a picture.
     procedure SavePictToStream(Stream: TStream);
     //: Saves the picture to a file. This assumes that the filling effect
     //: is a picture. If AutoExt is True, the extension of the filename is
     //: then added automatically, depending of the type of picture
     //: (bmp, jpg, etc). The Filename shall then only contain the name and
     //: path, without a dot.
     procedure SavePictToFile(Filename: WideString; AutoExt: boolean);
     //: Loads a picture as fill effect from Stream. @link(PictType) is the type of picture.
     procedure FillEffectPicture(Stream: TStream; PictType: TMSOBlipType); overload;
     //: Loads a picture in a file as fill effect. Acceppted file formats are:
     //: BMP, JPG, PNG, WMF, EMF, PICT.
     procedure FillEffectPicture(Filename: WideString); overload;
     //: Loads a picture as fill effect from Stream. @link(PictType) is the type of picture.
     procedure FillEffectTexture(Stream: TStream; PictType: TMSOBlipType); overload;
     //: Loads a texture as fill effect from Stream. @link(PictType) is the type of picture.
     //: A texture is the same as a picture, but textures are tiled, whithout
     //: changing the scale, while pictures are scaled to fit the area.
     procedure FillEffectTexture(Filename: WideString); overload;
     //: Sets the fill effect to a gradient from Color1 and Color2.
     //: GradientFillStyle is the style, see @link(TGradientFillStyle).
     procedure FillEffectGradient(Color1,Color2: TExcelColor; GradientStyle: TGradientFillStyle);
published
     property PictureType: TMSOBlipType read GetPictureType;
     end;

type
//: Paint settings for areas.
    TPaintFrame = class(TRecordObject)
private
     FLineFormat: TLineFormat;
     FAreaFormat: TAreaFormat;
     FGelFrame: TGelFrame;

     function  GetHasFillEffects: boolean;
     procedure SetHasFillEffects(const Value: boolean);
protected
     procedure Assign(Rec: TChartRecord); override;
     procedure SetDefault(Parent: TChartRecord);
public
     constructor Create;
     destructor Destroy; override;
published
     //: Settings for the border line.
     property LineFormat: TLineFormat read FLineFormat write FLineFormat;
     //: Settings for the area.
     property AreaFormat: TAreaFormat read FAreaFormat write FAreaFormat;
     //: Settings for optional fill effects. If there are no fill effects,
     //: @link(HasFillEffects) must be set to True.
     property FillEffects: TGelFrame read FGelFrame write FGelFrame;
     //: True if the frame has fill effects. In order to add fill effects,
     //: HasFillEffects must be set to True. If set to False, any fill effects
     //: will be removed.
     property HasFillEffects: boolean read GetHasFillEffects write SetHasFillEffects;
     end;

type
//: Not used.
    TTextFrame = class(TRecordObject)
private
     FLineFormat: TLineFormat;
     FAreaFormat: TAreaFormat;

     function  GetAutoPosition: boolean;
     function  GetShadow: boolean;
     procedure SetAutoPosition(const Value: boolean);
     procedure SetShadow(const Value: boolean);
     function  GetAutoSize: boolean;
     procedure SetAutoSize(const Value: boolean);
protected
     procedure Assign(Rec: TChartRecord); override;
public
     constructor Create;
     destructor Destroy; override;

     property LineFormat: TLineFormat read FLineFormat write FLineFormat;
     property AreaFormat: TAreaFormat read FAreaFormat write FAreaFormat;
     property Shadow: boolean read GetShadow write SetShadow;
     property AutoSize: boolean read GetAutoSize write SetAutoSize;
     property AutoPosition: boolean read GetAutoPosition write SetAutoPosition;
     end;

type
//: Optional text lables displayed in the chart.
    TChartLabel = class(TCollectionItem)
private
     FRecord: TChartRecord;
     FRecPOS: TChartRecord;
     FRecAI: TChartRecord;
     FRecOBJECTLINK: TChartRecord;
     FRecSERIESTEXT: TChartRecord;

     function  GetDataPointIndex: integer;
     function  GetLabelType: TChartLabelType;
     function  GetSerieIndex: integer;
     function  GetText: WideString;
     function  GetXOffset: integer;
     function  GetYOffset: integer;
     procedure SetDataPointIndex(const Value: integer);
     procedure SetLabelType(const Value: TChartLabelType);
     procedure SetSerieIndex(const Value: integer);
     procedure SetText(const Value: WideString);
     procedure SetXOffset(const Value: integer);
     procedure SetYOffset(const Value: integer);
protected
     procedure AssignRecords(Rec: TChartRecord);
     procedure SetDefault;
public
     constructor Create(Collection: TCollection); override;
     destructor Destroy; override;

     //: What kind of data the the label belongs to. See @link(TChartLabelType).
     property LabelType: TChartLabelType read GetLabelType write SetLabelType;
     //: X offset for the text.
     property XOffset: integer read GetXOffset write SetXOffset;
     //: Y offset for the text.
     property YOffset: integer read GetYOffset write SetYOffset;
     //: Index for the serie that the label belongs to. Only used when linking
     //: to a serie value.
     property SerieIndex: integer read GetSerieIndex write SetSerieIndex;
     //: Which data point int the serie the lable belongs. Only used when
     //: linking to a serie value.
     property DataPointIndex: integer read GetDataPointIndex write SetDataPointIndex;
     //: The text for the lable.
     property Text: WideString read GetText write SetText;
     end;

type
//: List of TChartLables.
    TChartLabels = class(TCollection)
private
     FOwner: TPersistent;

     function  GetItems(Index: integer): TChartLabel;
protected
     function  GetOwner: TPersistent; override;
public
     constructor Create(AOwner: TPersistent);
     //: Add a new TChartLable.
     function  Add: TChartLabel;
     //: @exclude.
     function  AddFromFile: TChartLabel;
     procedure Delete(Index: integer);
     //: The TChartLable items in the list.
     property  Items[Index: integer]: TChartLabel read GetItems; default;
     end;

type TDataPoint = class(TObject)
private
     FRecord: TChartRecord;

     FLineFormat: TLineFormat;
     FAreaFormat: TAreaFormat;
     FMarkerFormat: TMarkerFormat;

     FRecPIEFORMAT: TChartRecord;
     FRecATTACHEDLABEL: TChartRecord;

     function  GetPointIndex: integer;
     function  GetDataLablel: TChartDataLabels;
     function  GetPieSliceDist: integer;
     procedure SetPointIndex(const Value: integer);
     procedure SetDataLablel(const Value: TChartDataLabels);
     procedure SetPieSliceDist(const Value: integer);
protected
     procedure AssignRecords(Rec: TChartRecord);