cxexportvglink.pas

delphi的的三方控件

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressVerticalGrid                                          }
{                                                                    }
{       Copyright (c) 1998-2007 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSVERTICALGRID 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 cxExportVGLink;

{$I cxVer.inc}

interface

uses
  cxVGrid;

procedure cxExportVGToHTML(const AFileName: string;
  AVerticalGrid: TcxCustomVerticalGrid; AExpand: Boolean = True;
  ARecordPerBand: Integer = 8; const AFileExt: string = 'html');
procedure cxExportVGToXML(const AFileName: string;
  AVerticalGrid: TcxCustomVerticalGrid; AExpand: Boolean = True;
  ARecordPerBand: Integer = 8; const AFileExt: string = 'xml');
procedure cxExportVGToExcel(const AFileName: string;
  AVerticalGrid: TcxCustomVerticalGrid; AExpand: Boolean = True;
  AUseNativeFormat: Boolean = True;
  ARecordPerBand: Integer = 8; const AFileExt: string = 'xls');
procedure cxExportVGToText(const AFileName: string;
  AVerticalGrid: TcxCustomVerticalGrid; AExpand: Boolean = True;
  const ASeparator: string = ''; const ABeginString: string = '';
  const AEndString: string = ''; ARecordPerBand: Integer = 8;
  const AFileExt: string = 'txt');
procedure cxExportVGToFile(AFileName: string;
  AVerticalGrid: TcxCustomVerticalGrid; AExportType: Integer;
  AExpand, AUseNativeFormat: Boolean; const ASeparators: array of string;
  ARecordPerBand: Integer; const AFileExt: string);

implementation

uses
{$IFDEF VCL}
  Windows, 
{$ENDIF}
  Graphics, cxGeometry,
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  cxEdit, cxCalendar, cxCurrencyEdit, cxSpinEdit, cxCalc, cxTimeEdit,
  SysUtils, Classes, cxClasses, cxGraphics, cxStyles, cxInplaceContainer,
  cxDataUtils, cxExport, cxXLSExport, cxHtmlXmlTxtExport, cxVGridViewInfo,
  cxVGridConsts, cxVGridUtils;

type
  TcxVerticalGridAccess = class(TcxCustomVerticalGrid);
  TcxControllerAccess = class(TcxvgController);
  TcxScrollerAccess = class(TcxvgScroller);
  TcxViewInfoAccess = class(TcxvgCustomViewInfo);
  TcxStylesAccess = class(TcxVerticalGridStyles);
  TcxPropertiesAccess = class(TcxCustomEditProperties);
  TcxRowHeaderAccess = class(TcxCustomRowHeaderInfo);
  TcxCustomEditorRowAccess = class(TcxCustomEditorRow);
  TcxCustomEditorRowPropertiesAccess = class(TcxCustomEditorRowProperties);
  TcxCustomMultiEditorRowAccess = class(TcxCustomMultiEditorRow);
  TcxCustomRowAccess = class(TcxCustomRow);

  TcxVerticalGridExportHelper = class;
  TcxColumnsMap = class;

  TcxRowIndentData = record
    StyleIndex: Integer;
    IsCategory: Boolean;
    Column: Integer;
    Width: Integer;
  end;
  PcxRowIndentData = ^TcxRowIndentData;

  { TcxRowIndentsInfo }

  TcxRowIndentsInfo = class
  private
    FGridLineColor: TColor;
    FGridLines: TcxvgGridLines;
    FHeaderColumnsMap: TcxColumnsMap;
    FHeaderInfo: TcxRowHeaderAccess;
    FIsCategory: Boolean;
    FList: TList;
    FPaintStyle: TcxvgPaintStyle;
    FProvider: IcxExportProvider;
    FRow: TcxCustomRow;
    function GetCount: Integer;
    function GetIndent(Index: Integer): TcxRowIndentData;
  protected
    procedure AddFirstIndent;
    procedure AddParentIndents;
    procedure Calculate(AHeaderColumnsMap: TcxColumnsMap; AProvider: IcxExportProvider);
    property Row: TcxCustomRow read FRow;
    property GridLineColor: TColor read FGridLineColor;
    property GridLines: TcxvgGridLines read FGridLines;
    property HeaderColumnsMap: TcxColumnsMap read FHeaderColumnsMap;
    property HeaderInfo: TcxRowHeaderAccess read FHeaderInfo;
    property IsCategory: Boolean read FIsCategory;
    property PaintStyle: TcxvgPaintStyle read FPaintStyle;
    property Provider: IcxExportProvider read FProvider;
  public
    constructor Create(ARow: TcxCustomRow);
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Indents[Index: Integer]: TcxRowIndentData read GetIndent;
  end;

  { TcxColumnsMap }

  TElementInfo = record
    Pos: Integer;
    ColumnStart: Integer;
    ColumnEnd: Integer;
    Width: Integer;
    IsLevel: Boolean;
    case Boolean of
      False: (
        Row: TcxCustomRow;
        CellIndex: Integer
      );
      True: (
        Level: Integer
      );
  end;
  PElementInfo = ^TElementInfo;

  TcxColumnsMap = class
  private
    FElements: TList;
    FColumnWidths: array of Integer;
  protected
    NeedWidth: Integer;
    MaxColumnIndex: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddRowCell(APos: Integer; ARow: TcxCustomRow; ACellIndex, AWidth: Integer);
    procedure AddLevel(ALevel, APos, AWidth: Integer);
    procedure Build;
    procedure CheckNeedWidth(APos: Integer);
    function FindColumnForPos(APos: Integer): Integer;
    procedure GetColumnInfoFromRowCell(ARow: TcxCustomRow; ACellIndex: Integer;
      var AStart, AEnd: Integer);
    procedure GetColumnInfoFromLevel(ALevel: Integer; var AStart, AEnd: Integer);
    function GetColumnWidth(AIndex: Integer): Integer;
  end;

  { TcxRowsIndents }

  TcxRowsIndents = class(TList)
  private
    function GetIndent(Index: Integer): TcxRowIndentsInfo;
  public
    procedure Clear; override;
    property Indents[Index: Integer]: TcxRowIndentsInfo read GetIndent; default;
  end;

  { TcxRowCellsInfo }

  TRowCaptionCellInfo = record
    Caption: string;
    Column: Integer;
    Width: Integer;
    StyleIndex: Integer;
  end;
  PRowCaptionCellInfo = ^TRowCaptionCellInfo;

  TcxRowCellsInfo = class(TList)
  private
    function GetItem(Index: Integer): TRowCaptionCellInfo;
  public
    function AddCaption(AColumn: Integer; AWidth: Integer; AStyleIndex: Integer; const ACaption: string): Integer; overload;
    procedure Clear; override;
    property Items[Index: Integer]: TRowCaptionCellInfo read GetItem; default;
  end;

  { TcxRowsCaptions }

  TcxRowsCaptions = class(TList)
  private
    function GetCaption(Index: Integer): TcxRowCellsInfo;
  public
    function AddCaption: TcxRowCellsInfo;
    procedure Clear; override;
    property Captions[Index: Integer]: TcxRowCellsInfo read GetCaption;
  end;

  { TcxVerticalGridMapInfo }

  TcxVerticalGridMapsInfo = class
  private
    FBandCount: Integer;
    FFirstValuesColumn: Integer;
    FGridLineColor: TColor;
    FGridLines: TcxvgGridLines;
    FHeaderColumnsMap: TcxColumnsMap;
    FIsEmpty: Boolean;
    FLastBandRecords: Integer;
    FLevelIndents: array of Integer;
    FMaxHeaderWidth: Integer;
    FMaxLevel: Integer;
    FMaxValueWidth: Integer;
    FMinHeaderWidth: Integer;
    FMinValueWidth: Integer;
    FOwner: TcxVerticalGridExportHelper;
    FPaintStyle: TcxvgPaintStyle;
    FRecordCount: Integer;
    FRecordsPerBand: Integer;
    FRowCount: Integer;
    FRows: TList;
    FRowsCaptions: TcxRowsCaptions;
    FRowsIndents: TcxRowsIndents;
    FSize: TSize;
    FValueColumnsMap: TcxColumnsMap;
    FVerticalGrid: TcxVerticalGridAccess;
    FViewInfo: TcxViewInfoAccess;
    function GetLevelIndent(Index: Integer): Integer;
    function GetProvider: IcxExportProvider;
    function GetRow(Index: Integer): TcxCustomRow;
  protected
    TotalWidth: Integer;
    Position: Integer;
    procedure AddMultiEditorRowCells(ARow: TcxCustomRow);
    procedure AddMapRightSide(AMap: TcxColumnsMap; ARight, AMinCellWidth: Integer; ACalcIndent: Boolean);
    procedure AlignCategories;
    procedure CalculateHeader;
    procedure CalculateRowsCaptions;
    procedure CalculateRowsIndents;
    procedure CalculateSize;
    procedure CalculateValuesMap;
    procedure DoCalculate; virtual;
    procedure DoWrite; virtual;
    function GetDisplayText(ARecordIndex: Integer; ARow: TcxCustomEditorRowProperties): string;
    function GetDisplayValue(ARecordIndex: Integer; ARow: TcxCustomEditorRowProperties): Variant;
    function GetMultiEditorRowProperties(ARow: TcxCustomRow): TcxMultiEditorRowProperties;
    function IsIncludeRow(ARow: TcxCustomRow): Boolean; virtual;
    function IsNativeFormatProperties(AProperties: TcxCustomEditProperties): Boolean;
    procedure SetCellStyle(ACol, ARow, W, AStyleIndex: Integer); overload;
    procedure SetCellStyle(ACol, ARow, W: Integer; const AStyle: TcxCacheCellStyle); overload;
    procedure WriteColumnWidths;
    procedure WriteHeaders(ARowIndex: Integer); virtual;
    procedure WriteRecord(ACol, ARowIndex, ARecordIndex: Integer); virtual;
    procedure WriteRowCaptions(ARowIndex: Integer; ACaptions: TcxRowCellsInfo);
    procedure WriteRowHeader(ARowIndex: Integer; AIndents: TcxRowIndentsInfo; ACaptions: TcxRowCellsInfo);
    procedure WriteValue(ACol, ARow, ARecordIndex: Integer;
      AProperties: TcxCustomEditorRowProperties);
    procedure WriteValues;

    property FirstValuesColumn: Integer read FFirstValuesColumn;
    property GridLineColor: TColor read FGridLineColor;
    property GridLines: TcxvgGridLines read FGridLines;
    property HeaderColumnsMap: TcxColumnsMap read FHeaderColumnsMap;
    property IsEmpty: Boolean read FIsEmpty;
    property LastBandRecords: Integer read FLastBandRecords;
    property LevelIndents[Index: Integer]: Integer read GetLevelIndent;
    property MaxHeaderWidth: Integer read FMaxHeaderWidth;
    property MaxValueWidth: Integer read FMaxValueWidth;
    property MinHeaderWidth: Integer read FMinHeaderWidth;
    property MinValueWidth: Integer read FMinHeaderWidth;
    property Owner: TcxVerticalGridExportHelper read FOwner;
    property PaintStyle: TcxvgPaintStyle read FPaintStyle;
    property Provider: IcxExportProvider read GetProvider;
    property RecordCount: Integer read FRecordCount;
    property RecordsPerBand: Integer read FRecordsPerBand;
    property ValueColumnsMap: TcxColumnsMap read FValueColumnsMap;
    property ViewInfo: TcxViewInfoAccess read FViewInfo;
  public
    constructor Create(AOwner: TcxVerticalGridExportHelper); virtual;
    destructor Destroy; override;
    property MaxLevel: Integer read FMaxLevel;
    property RowCount: Integer read FRowCount;
    property Rows[Index: Integer]: TcxCustomRow read GetRow;
    property RowsCaptions: TcxRowsCaptions read FRowsCaptions;
    property RowsIndents: TcxRowsIndents read FRowsIndents;
    property Size: TSize read FSize;
    property VerticalGrid: TcxVerticalGridAccess read FVerticalGrid;
  end;

  TcxVerticalGridMapsInfoClass = class of TcxVerticalGridMapsInfo;

  { TcxVerticalGridExportHelper }

  TcxVerticalGridExportHelper = class
  private
    FProvider: IcxExportProvider;
    FRecordsPerBand: Integer;
    FExpand: Boolean;
    FIsNativeFormat: Boolean;
    FVerticalGrid: TcxVerticalGridAccess;
  protected
    MapsInfo: TcxVerticalGridMapsInfo;
    procedure DoCalculateTableMap; virtual;
    procedure DoWriteCells; virtual;
    function GetMapsInfoClass: TcxVerticalGridMapsInfoClass; virtual;
  public
    constructor Create(AVerticalGrid: TcxCustomVerticalGrid;
      AExportType: Integer; const AFileName: string); virtual;
    destructor Destroy; override;
    property RecordsPerBand: Integer read FRecordsPerBand write FRecordsPerBand;
    property Expand: Boolean read FExpand write FExpand;
    property IsNativeFormat: Boolean read FIsNativeFormat;
    property Provider: IcxExportProvider read FProvider;
    property VerticalGrid: TcxVerticalGridAccess read FVerticalGrid;
  end;

const
  cxInvalidIndex       = -1;
  cxIndentFontName     = 'Tahoma';
  cxCellBorders: array[Boolean] of TcxBorders = ([], cxBordersAll);
  cxIndentStyle: TcxCacheCellStyle =
  ( AlignText: catCenter;
    FontStyle: [];
    FontColor: 0;
    FontSize: 12;
    FontCharset: 0;
    BrushStyle: cbsSolid);

// todo: need move to cxExport for Delphi 4
  AlignToCxAlign: array[TAlignment] of TcxAlignText =
    (catLeft, catRight, catCenter);
  cxUsedBorder: TcxCellBorders = (IsDefault: False; Width: 1);
  cxEmptyBorder: TcxCellBorders = (IsDefault: True; Width: 0);

function cxSetBorder(var ABorder: TcxCellBorders; NeedSet: Boolean; Color: Integer): Boolean;
begin
  Result := NeedSet;
  if NeedSet then
  begin
    ABorder := cxUsedBorder;
    ABorder.Color := Color;
  end
  else
    ABorder := cxEmptyBorder;
end;

procedure cxCheckBorders(var AStyle: TcxCacheCellStyle;
  const ABorders: TcxBorders; AColor: TColor; AGridLines: TcxvgGridLines);
begin
  cxSetBorder(AStyle.Borders[0],
    (bLeft in ABorders) and (AGridLines in [vglVertical, vglBoth]), AColor);
  cxSetBorder(AStyle.Borders[1],
    (bTop in ABorders) and (AGridLines in [vglHorizontal, vglBoth]), AColor);
  cxSetBorder(AStyle.Borders[2],
    (bRight in ABorders) and (AGridLines in [vglVertical, vglBoth]), AColor);
  cxSetBorder(AStyle.Borders[3],
    (bBottom in ABorders) and (AGridLines in [vglHorizontal, vglBoth]), AColor);
end;

procedure cxViewParamsToCacheStyle(
  AViewParams: TcxViewParams; var ACacheStyle: TcxCacheCellStyle);
begin
  ACacheStyle := DefaultCellStyle;
  with ACacheStyle do
  begin
    StrPCopy(FontName, AViewParams.Font.Name);
    FontStyle := TcxFontStyles(AViewParams.Font.Style);
    FontColor := ColorToRgb(AViewParams.TextColor);
    FontSize := AViewParams.Font.Size;
    FontCharset := AViewParams.Font.Charset;
    BrushStyle := cbsSolid;
    BrushBkColor := ColorToRgb(AViewParams.Color);
    BrushFgColor := BrushBkColor;
  end;
end;

function GetHeaderViewParams(ARow: TcxCustomRow): TcxViewParams;
begin
  with TcxRowHeaderAccess(ARow.ViewInfo.HeaderInfo) do
  begin
    CalcViewParams(False);
    Result := IndentViewParams;
  end;
end;

{ TcxRowIndentsInfo }

constructor TcxRowIndentsInfo.Create(ARow: TcxCustomRow);
begin
  FRow := ARow;
  FList := TList.Create;
end;

destructor TcxRowIndentsInfo.Destroy;
var
  I: Integer;
begin
  FProvider := nil;
  for I := 0 to FList.Count - 1 do
    Dispose(PcxRowIndentData(FList[I]));
  FList.Free;
  inherited Destroy;
end;

procedure TcxRowIndentsInfo.AddFirstIndent;
var
  AEnd: Integer;
  Info: PcxRowIndentData;
  AStyle: TcxCacheCellStyle;
  ABorders: TcxBorders;
begin
  New(Info);
  FIsCategory := FRow is TcxCategoryRow;
  Info.IsCategory := IsCategory;
  HeaderColumnsMap.GetColumnInfoFromLevel(FRow.Level, Info.Column, AEnd);
  Info.Width := AEnd - Info.Column;
  cxViewParamsToCacheStyle(GetHeaderViewParams(FRow), AStyle);
  AStyle.AlignText := catCenter;
  ABorders := [bTop, bBottom];