Componentes.Terceros.DevExp.../official/x.26/ExpressQuantumTreeList 4/Sources/cxExportTL4Link.pas
2007-09-09 11:27:27 +00:00

1685 lines
52 KiB
ObjectPascal

{********************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressQuantumTreeList }
{ }
{ 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 EXPRESSQUANTUMTREELIST 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 cxExportTL4Link;
{$I cxVer.inc}
interface
uses
Windows, Graphics, cxGeometry, {$IFDEF DELPHI6} Variants, {$ENDIF}
cxEdit, cxCalendar, cxCurrencyEdit, cxSpinEdit, cxCalc, cxTimeEdit, cxDataUtils,
SysUtils, Classes, cxClasses, cxGraphics, cxStyles, cxInplaceContainer,
cxTL, cxExport, cxXLSExport, cxHtmlXmlTxtExport, cxTLStrs;
procedure cxExportTL4ToHTML(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; const AFileExt: string = 'html');
procedure cxExportTL4ToXML(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; const AFileExt: string = 'xml');
procedure cxExportTL4ToExcel(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; AUseNativeFormat: Boolean = True;
const AFileExt: string = 'xls');
procedure cxExportTL4ToText(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; const ASeparator: string = '';
const ABeginString: string = ''; const AEndString: string = '';
const AFileExt: string = 'txt');
procedure cxExportTL4ToFile(AFileName: string; ATreeList: TcxCustomTreeListControl;
AExportType: Integer; AExpand, ASaveAll, AUseNativeFormat: Boolean; const ASeparators: array of string;
const AFileExt: string);
implementation
type
TcxBandAccess = class(TcxTreeListBand);
TcxBandViewInfoAccess = class(TcxTreeListBandViewInfo);
TcxColumnAccess = class(TcxTreeListColumn);
TcxNodeAccess = class(TcxTreeListNode);
TcxTreeListAccess = class(TcxCustomTreeListControl);
TcxViewInfoAccess = class(TcxTreeListViewInfo);
TcxStylesAccess = class(TcxTreeListStyles);
TcxPropertiesAccess = class(TcxCustomEditProperties);
{ TcxTreeListNodeItarationHandler }
TcxTreeListNodeItarationHandler = procedure(ANode: TcxTreeListNode) of object;
TcxTreeListExportHelper = class;
TcxTreeListMapsInfo = class;
TcxTreeListMapsInfoClass = class of TcxTreeListMapsInfo;
TcxMapInfoHelperList = class;
TcxInfoItemClass = class of TcxInfoItem;
{ TcxInfoItem }
TcxTreeListCellsMap = array of array of Integer;
TcxInfoItem = class
private
function GetProvider: IcxExportProvider;
protected
function GridLines: Boolean;
procedure RegisterStyles; virtual;
property Provider: IcxExportProvider read GetProvider;
public
AbsolutePosition: TRect;
Data: TObject;
Owner: TcxMapInfoHelperList;
Position: TRect;
constructor Create(AOwner: TcxMapInfoHelperList); virtual;
end;
{ TcxMapInfoHelperList }
TcxMapInfoHelperList = class
private
FOwner: TObject;
function GetItem(Index: Integer): TcxInfoItem;
function GetDimension: TSize;
protected
CellsMap: TcxTreeListCellsMap;
HorzList: TList;
ItemCapacity: Integer;
ItemCount: Integer;
ItemsList: PPointerList;
VertList: TList;
procedure CalculateCellsMap;
procedure Clear; virtual;
function CreateList(const AItems: array of Pointer; ACapacity: Integer = -1): TList;
function GetOwner: TObject; virtual;
function GetProvider: IcxExportProvider; virtual;
function GridLines: Boolean; virtual;
function UseItemForFillMap(AItem: TcxInfoItem): Boolean; virtual;
property Count: Integer read ItemCount;
property Items[Index: Integer]: TcxInfoItem read GetItem;
public
constructor Create(AOwner: TObject; AItemsCount: Integer); virtual;
destructor Destroy; override;
function AddItem(const AbsolutePosition: TRect;
Data: TObject; AItemClass: TcxInfoItemClass): TcxInfoItem;
procedure Calculate; virtual;
property Dimension: TSize read GetDimension;
end;
{ TcxTreeListMapInfoList }
TcxIndentInfoItem = class(TcxInfoItem)
private
function GetLevel: Integer;
public
property Level: Integer read GetLevel;
end;
{ TcxBandInfoItem }
TcxBandInfoItem = class(TcxInfoItem)
private
function GetBand: TcxBandAccess;
function GetBands: Boolean;
function GetHeaderText: string;
function GetTreeList: TcxTreeListAccess;
protected
procedure RegisterStyles; override;
public
CaptionStyleIndex: Integer;
HeaderStyleIndex: Integer;
property Band: TcxBandAccess read GetBand;
property Bands: Boolean read GetBands;
property HeaderText: string read GetHeaderText;
property TreeList: TcxTreeListAccess read GetTreeList;
end;
{ TcxColumnInfoItem }
TcxColumnInfoItem = class(TcxInfoItem)
private
function GetColumn: TcxColumnAccess;
function GetFooter: Boolean;
function GetFooterText: string;
function GetHeader: Boolean;
function GetHeaderText: string;
function GetTreeList: TcxTreeListAccess;
protected
procedure RegisterStyles; override;
public
HeaderStyleIndex: Integer;
FooterStyleIndex: Integer;
property Column: TcxColumnAccess read GetColumn;
property Footer: Boolean read GetFooter;
property FooterText: string read GetFooterText;
property Header: Boolean read GetHeader;
property HeaderText: string read GetHeaderText;
property TreeList: TcxTreeListAccess read GetTreeList;
end;
{ TcxTreeListMapInfoList }
TcxTreeListMapInfoList = class(TcxMapInfoHelperList)
private
FBandsList: TList;
FColumnsList: TList;
FIndentsList: TList;
function GetBandCount: Integer;
function GetBandInfo(Index: Integer): TcxBandInfoItem;
function GetColumnCount: Integer;
function GetColumnInfo(Index: Integer): TcxColumnInfoItem;
function GetIndentCount: Integer;
function GetIndentInfo(Index: Integer): TcxIndentInfoItem;
function GetInfoOwner: TcxTreeListMapsInfo;
protected
function UseItemForFillMap(AItem: TcxInfoItem): Boolean; override;
function GetProvider: IcxExportProvider; override;
function GridLines: Boolean; override;
property Owner: TcxTreeListMapsInfo read GetInfoOwner;
public
constructor Create(AOwner: TObject; AItemsCount: Integer); override;
destructor Destroy; override;
procedure Calculate; override;
function CloneMap: TcxTreeListCellsMap; virtual;
property BandCount: Integer read GetBandCount;
property Bands[Index: Integer]: TcxBandInfoItem read GetBandInfo;
property ColumnCount: Integer read GetColumnCount;
property Columns[Index: Integer]: TcxColumnInfoItem read GetColumnInfo;
property IndentCount: Integer read GetIndentCount;
property Indents[Index: Integer]: TcxIndentInfoItem read GetIndentInfo;
end;
{ TcxPreviewInfo }
TcxPreviewInfoItem = class
protected
Next: TcxPreviewInfoItem;
public
Alignment: TcxAlignText;
Node: TcxTreeListNode;
Level: Integer;
Value: Variant;
Height: Integer;
ViewParams: TcxViewParams;
constructor Create(var AFirst, ALast: TcxPreviewInfoItem); virtual;
procedure SetData(ANode: TcxTreeListNode; ALevel: Integer; AHeight: Integer;
const AValue: Variant; const AViewParams: TcxViewParams; AAlign: TcxAlignText);
end;
{ TcxTreeListMapInfo }
TcxTreeListMapsInfo = class
private
FSize: TSize;
FMaxLevel: Integer;
FOwner: TcxTreeListExportHelper;
function GetBandLineHeight: Integer;
function GetBands: Boolean;
function GetFooter: Boolean;
function GetFooters(AColumn: TcxTreeListColumn): Boolean;
function GetGridLines: Boolean;
function GetHeaderLineHeight: Integer;
function GetHeaders: Boolean;
function GetNodeCellsCount: Integer;
function GetPreview: Boolean;
function GetPreviewAutoHeight: Boolean;
function GetProvider: IcxExportProvider;
function GetTreeList: TcxTreeListAccess;
function GetVertInc: Integer;
procedure AddColumnsFromBand(var AOfs: Integer; ABand: TcxTreeListBand);
protected
ConentCellsRowCount: Integer;
MultiEditRowCount: Integer;
TotalWidth: Integer;
PreviewList,
CurPreviewInfo,
PreviewListLast,
GroupList,
CurGroupInfo,
GroupListLast: TcxPreviewInfoItem;
Position: Integer;
HeaderInfoList: TcxTreeListMapInfoList;
HeaderMap: TcxTreeListCellsMap;
FooterMap: TcxTreeListCellsMap;
function AddGroupInfo: TcxPreviewInfoItem;
function AddPreviewInfo: TcxPreviewInfoItem;
procedure CalculateSize;
procedure CheckNodeBeforeCalculate(ANode: TcxTreeListNode); virtual;
procedure ClearList(AList: TcxPreviewInfoItem);
procedure CloneMaps; virtual;
function CountItems(AList: TcxPreviewInfoItem): Integer;
procedure CreateHeaderInfo; virtual;
procedure DoCalculate; virtual;
procedure DoWrite; virtual;
procedure DoWriteColumnWidths; virtual;
procedure DoWriteContent; virtual;
procedure DoWriteFooter; virtual;
procedure DoWriteHeader; virtual;
procedure DoWriteItem(const APosition: TRect; AStyleIndex: Integer; const AText: string);
procedure DoWriteNode(ANode: TcxTreeListNode); virtual;
procedure DoWriteNodeGroup(ANode: TcxTreeListNode; AInfo: TcxPreviewInfoItem);
procedure DoWriteNodeIndents(ANode: TcxTreeListNode; AStartPos: Integer); virtual;
procedure DoWriteNodeMultiEdit(ANode: TcxTreeListNode); virtual;
procedure DoWriteNodePreview(ANode: TcxTreeListNode; AInfo: TcxPreviewInfoItem);
procedure DoWritePreviewInfo(AInfo: TcxPreviewInfoItem); virtual;
procedure DoWriteRect(ARect: TRect;
const AParams: TcxViewParams; ABorders: TcxBorders = cxBordersAll);
procedure DoWriteUnionRect(const ARect: TRect; const AParams: TcxViewParams;
Align: TcxAlignText; ABorders: TcxBorders = cxBordersAll);
function GetDisplayText(AIndex: Integer; ANode: TcxTreeListNode; AProperties: TcxCustomEditProperties): string;
function GetDisplayValue(AIndex: Integer; ANode: TcxTreeListNode; AProperties: TcxCustomEditProperties): Variant;
function GetIndentStyle(AColor: TColor; ABorders: TcxBorders): TcxCacheCellStyle;
function GetNodeItemDisplayValue(ANode: TcxTreeListNode; AColumn: TcxTreeListColumn; var Align: TcxAlignText): Variant;
function IsGroupNode(ANode: TcxTreeListNode; var AInfo: TcxPreviewInfoItem): Boolean;
function IsHasPreview(ANode: TcxTreeListNode; var AInfo: TcxPreviewInfoItem): Boolean;
function IsNativeFormatProperties(AProperties: TcxCustomEditProperties): Boolean;
procedure ValidateMaps; virtual;
property BandLineHeight: Integer read GetBandLineHeight;
property Bands: Boolean read GetBands;
property HeaderLineHeight: Integer read GetHeaderLineHeight;
property Headers: Boolean read GetHeaders;
property GridLines: Boolean read GetGridLines;
property Footer: Boolean read GetFooter;
property Footers[AColumn: TcxTreeListColumn]: Boolean read GetFooters;
property NodeCellsCount: Integer read GetNodeCellsCount;
property Owner: TcxTreeListExportHelper read FOwner;
property Preview: Boolean read GetPreview;
property PreviewAutoHeight: Boolean read GetPreviewAutoHeight;
property Provider: IcxExportProvider read GetProvider;
property Size: TSize read FSize;
property VertInc: Integer read GetVertInc;
public
constructor Create(AOwner: TcxTreeListExportHelper); virtual;
destructor Destroy; override;
property MaxLevel: Integer read FMaxLevel;
property TreeList: TcxTreeListAccess read GetTreeList;
end;
{ TcxTreeListExportHelper }
TcxTreeListExportHelper = class
private
FProvider: IcxExportProvider;
FExpand: Boolean;
FExportSelection: Boolean;
FIsNativeFormat: Boolean;
FSelectionList: TList;
FTreeList: TcxTreeListAccess;
function AddToSelection(ANode: TcxTreeListNode): Boolean;
procedure CreateSelectionList;
procedure SetExportSelection(Value: Boolean);
protected
MapsInfo: TcxTreeListMapsInfo;
procedure CallIterationProc(ANode: TcxTreeListNode;
AIndex: Integer; AProc: TcxTreeListNodeItarationHandler); virtual;
procedure DoCalculateTableMap; virtual;
procedure DoWriteCells; virtual;
procedure DoIterate(AProc: TcxTreeListNodeItarationHandler);
procedure DoIterateAllNodes(AProc: TcxTreeListNodeItarationHandler); virtual;
procedure DoIterateSelectionNodes(AProc: TcxTreeListNodeItarationHandler); virtual;
function GetMapsInfoClass: TcxTreeListMapsInfoClass; virtual;
public
constructor Create(ATreeList: TcxCustomTreeListControl;
AExportType: Integer; const AFileName: string); virtual;
destructor Destroy; override;
property Expand: Boolean read FExpand write FExpand;
property ExportSelection: Boolean read FExportSelection write SetExportSelection;
property IsNativeFormat: Boolean read FIsNativeFormat;
property Provider: IcxExportProvider read FProvider;
property TreeList: TcxTreeListAccess read FTreeList;
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);
// todo: need move to cxInplaceContainer for Delphi 4
function Supports(const Instance: IUnknown; const IID: TGUID; out Intf): Boolean; overload;
begin
Result := (Instance <> nil) and (Instance.QueryInterface(IID, Intf) = 0);
end;
function cxNodesCompare(AItem1, AItem2: Pointer): Integer;
begin
Result := TcxTreeListNode(AItem1).AbsoluteIndex -
TcxTreeListNode(AItem2).AbsoluteIndex;
end;
function cxCompareCoordinates(AItem1, AItem2: Pointer): Integer;
begin
Result := Integer(AItem1) - Integer(AItem2);
end;
function cxGetCellBorders(ACol, ARow: Integer; const Bounds: TRect): TcxBorders;
begin
Result := [];
if ACol = Bounds.Left then Include(Result, bLeft);
if ARow = Bounds.Top then Include(Result, bTop);
if ACol = Bounds.Right then Include(Result, bRight);
if ARow = Bounds.Bottom then Include(Result, bBottom);
end;
function cxCheckBorder(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;
function cxSetStyleBorders(const AStyle: TcxCacheCellStyle; ACol, ARow: Integer;
const ABounds: TRect; const AColor: Integer; HasBorders: TcxBorders = cxBordersAll): TcxCacheCellStyle;
begin
Result := AStyle;
with Result, ABounds do
begin
cxCheckBorder(Borders[0], (ACol = Left) and (bLeft in HasBorders), AColor);
cxCheckBorder(Borders[1], (ARow = Top) and (bTop in HasBorders), AColor);
cxCheckBorder(Borders[2], (ACol = Right) and (bRight in HasBorders), AColor);
cxCheckBorder(Borders[3], (ARow = Bottom) and (bBottom in HasBorders), AColor);
end;
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 cxRegisterViewParams(AViewParams: TcxViewParams;
Align: TcxAlignText; Provider: IcxExportProvider): Integer; overload;
var
AStyle: TcxCacheCellStyle;
begin
cxViewParamsToCacheStyle(AViewParams, AStyle);
AStyle.AlignText := Align;
Result := Provider.RegisterStyle(AStyle)
end;
function cxRegisterViewParams(AViewParams: TcxViewParams; Align: TcxAlignText;
Provider: IcxExportProvider; ABorders: TcxBorders): Integer; overload;
var
I: Integer;
AStyle: TcxCacheCellStyle;
begin
cxViewParamsToCacheStyle(AViewParams, AStyle);
AStyle.AlignText := Align;
for I := 0 to 3 do
cxCheckBorder(AStyle.Borders[I], TcxBorder(I) in ABorders, cxBtnShadowColor);
Result := Provider.RegisterStyle(AStyle)
end;
function cxCheckBorders(ACol, ARow: Integer;
const ARect: TRect; ABorders: TcxBorders): TcxBorders;
begin
Result := [];
with ARect do
begin
if (ACol = Left) and (bLeft in ABorders) then Include(Result, bLeft);
if (ARow = Top) and (bTop in ABorders) then Include(Result, bTop);
if (ACol = Right) and (bRight in ABorders) then Include(Result, bRight);
if (ARow = Bottom) and (bBottom in ABorders) then Include(Result, bBottom);
end;
end;
function cxRegisterStyleHeader(AViewInfo: TcxtreeListViewInfoItem;
AlignHorz: TAlignment; Provider: IcxExportProvider; ABorders: TcxBorders): Integer;
var
AStyle: TcxCacheCellStyle;
begin
cxViewParamsToCacheStyle(AViewInfo.ViewParams, AStyle);
if ABorders <> [] then
AStyle := cxSetStyleBorders(AStyle, 0, 0, cxNullRect, cxBtnShadowColor, ABorders);
AStyle.AlignText := AlignToCxAlign[AlignHorz];
Result := Provider.RegisterStyle(AStyle);
end;
procedure cxFillMapItem(AMap: TcxTreeListCellsMap; AInfo: TcxInfoItem;
ACheckValue: Boolean = False);
var
I, J: Integer;
begin
with AInfo.Position do
begin
for I := Left to Right - 1 do
for J := Top to Bottom - 1 do
if (AMap[I, J] = 0) or not ACheckValue then AMap[I, J] := Integer(AInfo);
end;
end;
function cxCreateMap(const ASize: TSize): TcxTreeListCellsMap;
begin
SetLength(Result, ASize.cx, ASize.cy);
end;
{ TcxInfoItem }
constructor TcxInfoItem.Create(AOwner: TcxMapInfoHelperList);
begin
Owner := AOwner;
end;
function TcxInfoItem.GridLines: Boolean;
begin
Result := Owner.GridLines;
end;
procedure TcxInfoItem.RegisterStyles;
begin
end;
function TcxInfoItem.GetProvider: IcxExportProvider;
begin
Result := Owner.GetProvider;
end;
{ TcxMapInfoHelperList }
constructor TcxMapInfoHelperList.Create(AOwner: TObject; AItemsCount: Integer);
begin
FOwner := AOwner;
HorzList := CreateList([nil], AItemsCount + 1);
VertList := CreateList([nil], AItemsCount + 1);
ItemCapacity := AItemsCount;
ItemsList := AllocMem(ItemCapacity * SizeOf(Pointer));
end;
destructor TcxMapInfoHelperList.Destroy;
begin
try
FreeAndNil(HorzList);
FreeAndNil(VertList);
Clear;
finally
inherited Destroy;
end;
end;
function TcxMapInfoHelperList.AddItem(const AbsolutePosition: TRect;
Data: TObject; AItemClass: TcxInfoItemClass): TcxInfoItem;
begin
Result := AItemClass.Create(Self);
Result.AbsolutePosition := AbsolutePosition;
Result.Data := Data;
ItemsList^[ItemCount] := Result;
Inc(ItemCount);
with AbsolutePosition do
begin
if HorzList.IndexOf(Pointer(Right)) = cxInvalidIndex then
HorzList.Add(Pointer(Right));
if VertList.IndexOf(Pointer(Bottom)) = cxInvalidIndex then
VertList.Add(Pointer(Bottom));
end;
end;
procedure TcxMapInfoHelperList.Calculate;
var
I: Integer;
function RealPosFromAbsPos(X1, Y1, X2, Y2: Integer): TRect;
begin
Result.Left := HorzList.IndexOf(Pointer(X1));
Result.Top := VertList.IndexOf(Pointer(Y1));
Result.Right := HorzList.IndexOf(Pointer(X2));
Result.Bottom := VertList.IndexOf(Pointer(Y2));
end;
begin
HorzList.Sort(cxCompareCoordinates);
VertList.Sort(cxCompareCoordinates);
for I := 0 to ItemCount - 1 do
with TcxInfoItem(ItemsList^[I]), AbsolutePosition do
Position := RealPosFromAbsPos(Left, Top, Right, Bottom);
CalculateCellsMap;
end;
procedure TcxMapInfoHelperList.Clear;
var
I: Integer;
begin
try
for I := 0 to ItemCount - 1 do
FreeAndNil(TcxInfoItem(ItemsList^[I]));
FreeMem(ItemsList);
finally
ItemCount := 0;
ItemsList := nil;
end;
end;
procedure TcxMapInfoHelperList.CalculateCellsMap;
var
I: Integer;
begin
CellsMap := cxCreateMap(Dimension);
for I := 0 to Count - 1 do
if UseItemForFillMap(Items[I]) then cxFillMapItem(CellsMap, Items[I]);
end;
function TcxMapInfoHelperList.CreateList(
const AItems: array of Pointer; ACapacity: Integer = -1): TList;
var
I: Integer;
begin
Result := TList.Create;
if ACapacity <> cxInvalidIndex then
Result.Capacity := ACapacity;
if Length(AItems) <> 0 then
for I := Low(AItems) to High(AItems) do Result.Add(AItems[I]);
end;
function TcxMapInfoHelperList.GetOwner: TObject;
begin
Result := FOwner;
end;
function TcxMapInfoHelperList.GetProvider: IcxExportProvider;
begin
Result := nil;
end;
function TcxMapInfoHelperList.GridLines: Boolean;
begin
Result := False;
end;
function TcxMapInfoHelperList.UseItemForFillMap(AItem: TcxInfoItem): Boolean;
begin
Result := True;
end;
function TcxMapInfoHelperList.GetItem(Index: Integer): TcxInfoItem;
begin
Result := TcxInfoItem(ItemsList^[Index])
end;
function TcxMapInfoHelperList.GetDimension: TSize;
begin
Result.cx := HorzList.Count - 1;
Result.cy := VertList.Count - 1;
end;
{ TcxTreeListMapInfoList }
function TcxIndentInfoItem.GetLevel: Integer;
begin
Result := Integer(Data);
end;
{ TcxBandInfoItem }
procedure TcxBandInfoItem.RegisterStyles;
begin
with Band, TcxBandViewInfoAccess(ViewInfo) do
begin
if Self.Bands then
CaptionStyleIndex := cxRegisterStyleHeader(BandHeader, Caption.AlignHorz,
Provider, cxCellBorders[Self.GridLines]);
if Self.TreeList.OptionsView.Headers and not IsOpaque then
HeaderStyleIndex := cxRegisterViewParams(ContainerViewParams, catLeft, Provider);
end;
end;
function TcxBandInfoItem.GetBand: TcxBandAccess;
begin
Result := TcxBandAccess(Data)
end;
function TcxBandInfoItem.GetBands: Boolean;
begin
Result := TreeList.OptionsView.Bands;
end;
function TcxBandInfoItem.GetHeaderText: string;
begin
Result := Band.ViewInfo.BandHeader.Text;
end;
function TcxBandInfoItem.GetTreeList: TcxTreeListAccess;
begin
Result := TcxTreeListAccess(Band.TreeList);
end;
{ TcxColumnInfoItem }
procedure TcxColumnInfoItem.RegisterStyles;
begin
with Column, ViewInfo do
begin
if Self.Header then
HeaderStyleIndex := cxRegisterStyleHeader(ColumnHeader, Caption.AlignHorz,
Provider, cxCellBorders[GridLines]);
if Self.Footer then
FooterStyleIndex := cxRegisterStyleHeader(ColumnFooter,
SummaryFooter.AlignHorz, Provider, cxCellBorders[GridLines]);
end;
end;
function TcxColumnInfoItem.GetColumn: TcxColumnAccess;
begin
Result := TcxColumnAccess(Data);
end;
function TcxColumnInfoItem.GetFooter: Boolean;
begin
Result := TreeList.OptionsView.Footer and Column.Options.Footer;
end;
function TcxColumnInfoItem.GetFooterText: string;
begin
Result := Column.ViewInfo.ColumnFooter.Text;
end;
function TcxColumnInfoItem.GetHeader: Boolean;
begin
Result := TreeList.OptionsView.Headers;
end;
function TcxColumnInfoItem.GetHeaderText: string;
begin
Result := Column.ViewInfo.ColumnHeader.Text;
end;
function TcxColumnInfoItem.GetTreeList: TcxTreeListAccess;
begin
Result := TcxTreeListAccess(Column.TreeList);
end;
{ TcxTreeListMapInfoList }
constructor TcxTreeListMapInfoList.Create(AOwner: TObject; AItemsCount: Integer);
begin
inherited Create(AOwner, AItemsCount);
FBandsList := TList.Create;
FColumnsList := TList.Create;
FIndentsList := TList.Create;
end;
destructor TcxTreeListMapInfoList.Destroy;
begin
FBandsList.Free;
FColumnsList.Free;
FIndentsList.Free;
inherited Destroy;
end;
procedure TcxTreeListMapInfoList.Calculate;
var
I: Integer;
begin
inherited Calculate;
for I := 0 to ItemCount - 1 do
begin
if TObject(ItemsList^[I]) is TcxIndentInfoItem then
FIndentsList.Add(ItemsList^[I])
else
if TObject(ItemsList^[I]) is TcxColumnInfoItem then
FColumnsList.Add(ItemsList^[I])
else
if TObject(ItemsList^[I]) is TcxBandInfoItem then
FBandsList.Add(ItemsList^[I])
end;
end;
function TcxTreeListMapInfoList.CloneMap: TcxTreeListCellsMap;
var
I: Integer;
begin
Result := cxCreateMap(Dimension);
with Dimension do
begin
for I := 0 to cx - 1 do
Move(CellsMap[I, 0], Result[I, 0], cy * SizeOf(Integer));
end;
end;
function TcxTreeListMapInfoList.UseItemForFillMap(AItem: TcxInfoItem): Boolean;
begin
Result := not (AItem is TcxIndentInfoItem);
end;
function TcxTreeListMapInfoList.GetProvider: IcxExportProvider;
begin
Result := Owner.Owner.FProvider;
end;
function TcxTreeListMapInfoList.GridLines: Boolean;
begin
Result := Owner.GetGridLines;
end;
function TcxTreeListMapInfoList.GetBandCount: Integer;
begin
Result := FBandsList.Count;
end;
function TcxTreeListMapInfoList.GetBandInfo(Index: Integer): TcxBandInfoItem;
begin
Result := TcxBandInfoItem(FBandsList.List^[Index]);
end;
function TcxTreeListMapInfoList.GetColumnCount: Integer;
begin
Result := FColumnsList.Count;
end;
function TcxTreeListMapInfoList.GetColumnInfo(Index: Integer): TcxColumnInfoItem;
begin
Result := TcxColumnInfoItem(FColumnsList.List^[Index]);
end;
function TcxTreeListMapInfoList.GetIndentCount: Integer;
begin
Result := FIndentsList.Count;
end;
function TcxTreeListMapInfoList.GetIndentInfo(Index: Integer): TcxIndentInfoItem;
begin
Result := TcxIndentInfoItem(FIndentsList.List^[Index]);
end;
function TcxTreeListMapInfoList.GetInfoOwner: TcxTreeListMapsInfo;
begin
Result := TcxTreeListMapsInfo(GetOwner);
end;
{ TcxPreviewInfoItem }
constructor TcxPreviewInfoItem.Create(var AFirst, ALast: TcxPreviewInfoItem);
begin
if AFirst = nil then
AFirst := Self
else
ALast.Next := Self;
ALast := Self;
end;
procedure TcxPreviewInfoItem.SetData(
ANode: TcxTreeListNode; ALevel: Integer; AHeight: Integer;
const AValue: Variant; const AViewParams: TcxViewParams; AAlign: TcxAlignText);
begin
Alignment := AAlign;
Node := ANode;
Level := ALevel;
Value := AValue;
Height := AHeight;
ViewParams := AViewParams;
end;
{ TcxTreeListMapInfo }
constructor TcxTreeListMapsInfo.Create(AOwner: TcxTreeListExportHelper);
begin
FOwner := AOwner;
FMaxLevel := 0;
end;
destructor TcxTreeListMapsInfo.Destroy;
begin
ClearList(GroupList);
ClearList(PreviewList);
HeaderInfoList.Free;
inherited Destroy;
end;
function TcxTreeListMapsInfo.AddGroupInfo: TcxPreviewInfoItem;
begin
Result := TcxPreviewInfoItem.Create(GroupList, GroupListLast)
end;
function TcxTreeListMapsInfo.AddPreviewInfo: TcxPreviewInfoItem;
begin
Result := TcxPreviewInfoItem.Create(PreviewList, PreviewListLast);
end;
procedure TcxTreeListMapsInfo.CalculateSize;
begin
with HeaderInfoList.Dimension do
begin
FSize.cx := cx;
FSize.cy := (cy - 1) * (Byte(Footer) + Byte(Headers) + MultiEditRowCount);
if Bands then Inc(FSize.cy);
end;
Inc(FSize.cy, ConentCellsRowCount);
end;
procedure TcxTreeListMapsInfo.CheckNodeBeforeCalculate(ANode: TcxTreeListNode);
var
AAlign: TcxAlignText;
AHeight, H, ALevel: Integer;
AColumn: TcxColumnAccess;
AValue: Variant;
AViewParams: TcxViewParams;
function CheckNodePreview: Boolean;
begin
Result := False;
if Preview then
begin
AColumn := TcxColumnAccess(TreeList.Preview.Column);
AValue := GetNodeItemDisplayValue(ANode, AColumn, AAlign);
if PreviewAutoHeight and (AValue = '') then Exit;
AViewParams := TreeList.Styles.GetPreviewParams(ANode);
AHeight := TcxViewInfoAccess(TreeList.ViewInfo).PreviewHeight;
if PreviewAutoHeight then
begin
H := TotalWidth - TreeList.GetLevelIndentsWidth(ALevel, False, ANode);
H := H - (TreeList.Preview.LeftIndent + TreeList.Preview.RightIndent);
if H < 0 then H := 0;
H := TcxColumnAccess(AColumn).GetCellHeight(ANode, H,
TreeList.Preview.MaxLineCount, AViewParams.Font, AValue)
end
else
H := AHeight;
if Assigned(TreeList.OnGetNodePreviewHeight) then
TreeList.OnGetNodePreviewHeight(TreeList, ANode, AValue, H);
with TreeList.Preview do
if (H > AHeight * MaxLineCount) or (MaxLineCount = 0) then
AHeight := AHeight * MaxLineCount;
if AHeight > 0 then
begin
Inc(AHeight, VertInc);
AddPreviewInfo.SetData(ANode, ALevel + Byte(TreeList.OptionsView.ShowRoot),
AHeight, AValue, AViewParams, AAlign);
Result := True;
end;
end;
end;
function CheckGroupNode: Boolean;
var
AAlign: TcxAlignText;
begin
Result := TreeList.DoIsGroupNode(ANode);
if not Result then Exit;
with TreeList do
begin
AColumn := TcxColumnAccess(OptionsView.GetCategorizedColumn);
TcxStylesAccess(Styles).DoGetContentParams(ANode, AColumn, AViewParams);
AValue := GetNodeItemDisplayValue(ANode, AColumn, AAlign);
AddGroupInfo.SetData(ANode, ALevel + Byte(TreeList.OptionsView.ShowRoot),
HeaderLineCount * ViewInfo.DefaultEditHeight + VertInc, AValue, AViewParams, AAlign);
end;
end;
begin
ALevel := ANode.Level;
if ALevel > FMaxLevel then FMaxLevel := ALevel;
if CheckNodePreview then
Inc(ConentCellsRowCount);
if CheckGroupNode then
Inc(ConentCellsRowCount)
else
Inc(MultiEditRowCount);
end;
procedure TcxTreeListMapsInfo.ClearList(AList: TcxPreviewInfoItem);
var
AItem: TcxPreviewInfoItem;
begin
while AList <> nil do
begin
AItem := AList;
AList := AList.Next;
AItem.Free;
end;
end;
procedure TcxTreeListMapsInfo.CloneMaps;
begin
HeaderMap := HeaderInfoList.CloneMap;
if Footer then FooterMap := cxCreateMap(Size);
ValidateMaps;
end;
function TcxTreeListMapsInfo.CountItems(AList: TcxPreviewInfoItem): Integer;
begin
Result := 0;
while (AList <> nil) and (AList.Node <> nil) do
begin
Inc(Result);
AList := AList.Next;
end;
end;
procedure TcxTreeListMapsInfo.CreateHeaderInfo;
var
I, AOfs, IndentWidth: Integer;
function GetIndentPosition(Index: Integer): TRect;
begin
Result := Rect(Index * IndentWidth, 1,
(Index + 1) * IndentWidth, 1 + TreeList.HeaderLineCount);
end;
begin
AOfs := 0;;
IndentWidth := TreeList.LevelIndentWidth;
AOfs := 0;;
for I := 0 to MaxLevel - 1 do
HeaderInfoList.AddItem(GetIndentPosition(I), TObject(I), TcxIndentInfoItem);
for I := 0 to TreeList.VisibleBandCount - 1 do
AddColumnsFromBand(AOfs, TreeList.VisibleBands[I]);
end;
procedure TcxTreeListMapsInfo.DoCalculate;
var
I: Integer;
begin
TotalWidth := 0;
for I := 0 to TreeList.VisibleBandCount - 1 do
with TreeList.VisibleBands[I] do
begin
Inc(TotalWidth, DisplayWidth);
if FixedKind <> tlbfNone then Inc(TotalWidth, 3);
end;
Owner.DoIterate(CheckNodeBeforeCalculate);
if HeaderInfoList <> nil then FreeAndNil(HeaderInfoList);
Inc(FMaxLevel, Byte(TreeList.OptionsView.ShowRoot));
HeaderInfoList := TcxTreeListMapInfoList.Create(Self,
TreeList.VisibleColumnCount + FMaxLevel + TreeList.VisibleBandCount);
CreateHeaderInfo;
HeaderInfoList.Calculate;
CalculateSize;
CloneMaps;
end;
procedure TcxTreeListMapsInfo.DoWrite;
begin
Provider.SetRange(Size.cx, Size.cy, False);
Position := 0;
DoWriteColumnWidths;
DoWriteHeader;
DoWriteContent;
DoWriteFooter;
end;
procedure TcxTreeListMapsInfo.DoWriteColumnWidths;
var
AList: TList;
ALeft, ARight, I, J: Integer;
begin
AList := HeaderInfoList.HorzList;
ALeft := 0;
J := 0;
for I := 0 to AList.Count - 1 do
begin
ARight := Integer(AList.List^[I]);
if ARight = ALeft then
begin
Inc(J);
Continue;
end;
Provider.SetColumnWidth(I - J, ARight - ALeft);
ALeft := ARight;
end;
end;
procedure TcxTreeListMapsInfo.DoWriteContent;
begin
Owner.DoIterate(DoWriteNode);
end;
procedure TcxTreeListMapsInfo.DoWriteFooter;
var
I: Integer;
begin
if Footer then
begin
Dec(Position);
with HeaderInfoList.Dimension do
DoWriteRect(Rect(0, 1, cx, cy), TreeList.Styles.GetFooterParams);
for I := 0 to HeaderInfoList.ColumnCount - 1 do
with HeaderInfoList.Columns[I] do
if Footer then DoWriteItem(Position, FooterStyleIndex, FooterText);
end;
end;
procedure TcxTreeListMapsInfo.DoWriteHeader;
var
I, J, DH: Integer;
begin
DH := 0;
if Bands then
begin
for I := 0 to HeaderInfoList.BandCount - 1 do
with HeaderInfoList.Bands[I] do
DoWriteItem(Position, CaptionStyleIndex, HeaderText);
end
else
begin
Dec(Position);
DH := 1;
end;
if Headers then
begin
for I := 0 to HeaderInfoList.ColumnCount - 1 do
with HeaderInfoList.Columns[I] do
DoWriteItem(Position, HeaderStyleIndex, HeaderText);
for I := 0 to HeaderInfoList.Dimension.cx - 1 do
for J := 0 to HeaderInfoList.Dimension.cy - 1 do
if HeaderInfoList.CellsMap[I, J] = 0 then
Provider.SetCellStyle(I, J - DH, TcxBandInfoItem(HeaderMap[I, J]).HeaderStyleIndex);
Inc(Position, HeaderInfoList.Dimension.cy - 1);
end;
Inc(Position, 1);
end;
procedure TcxTreeListMapsInfo.DoWriteItem(
const APosition: TRect; AStyleIndex: Integer; const AText: string);
begin
with APosition do
begin
Provider.SetCellStyleEx(Left, Top + Position,
Bottom - Top, Right - Left, AStyleIndex);
if Length(AText) > 0 then
Provider.SetCellValue(Left, Top + Position, AText);
end;
end;
procedure TcxTreeListMapsInfo.DoWriteNode(ANode: TcxTreeListNode);
var
AInfo: TcxPreviewInfoItem;
AStartPos: Integer;
begin
AStartPos := Position;
if Preview and (TreeList.Preview.Place = tlppTop) and IsHasPreview(ANode, AInfo) then
DoWriteNodePreview(ANode, AInfo);
if IsGroupNode(ANode, AInfo) then
DoWriteNodeGroup(ANode, AInfo)
else
DoWriteNodeMultiEdit(ANode);
if Preview and (TreeList.Preview.Place = tlppBottom) and IsHasPreview(ANode, AInfo) then
DoWriteNodePreview(ANode, AInfo);
DoWriteNodeIndents(ANode, AStartPos);
end;
procedure TcxTreeListMapsInfo.DoWriteNodeGroup(
ANode: TcxTreeListNode; AInfo: TcxPreviewInfoItem);
begin
DoWritePreviewInfo(AInfo);
end;
procedure TcxTreeListMapsInfo.DoWriteNodeIndents(
ANode: TcxTreeListNode; AStartPos: Integer);
var
I, ALevel, AStyle: Integer;
const
ExpandText: array[Boolean] of Char = ('+', '-');
begin
ALevel := ANode.Level - Byte(not TreeList.OptionsView.ShowRoot);
for I := 0 to ALevel do
begin
with TreeList.Styles.GetIndentParams(ANode, I) do
AStyle := Provider.RegisterStyle(GetIndentStyle(Color, cxCellBorders[GridLines]));
if (I = ALevel) and ANode.HasChildren then
Provider.SetCellDataString(I, AStartPos, ExpandText[ANode.Expanded]);
Provider.SetCellStyleEx(I, AStartPos, Position - AStartPos, 1, AStyle);
end;
end;
procedure TcxTreeListMapsInfo.DoWriteNodeMultiEdit(ANode: TcxTreeListNode);
var
I, J: Integer;
AParams: TcxViewParams;
ALeft: Integer;
procedure WriteCell(AInfo: TcxColumnInfoItem);
var
R: TRect;
AValue: Variant;
AAlign: TcxAlignText;
begin
R := cxRectOffset(AInfo.Position, 0, Position);
if R.Left = 0 then R.Left := ALeft;
TcxStylesAccess(TreeList.Styles).DoGetContentParams(ANode, AInfo.Column, AParams);
AValue := GetNodeItemDisplayValue(ANode, AInfo.Column, AAlign);
Provider.SetCellValue(R.Left, R.Top, AValue);
DoWriteUnionRect(R, AParams, AAlign, cxCellBorders[GridLines]);
end;
procedure WriteUnusedSpace(I, J: Integer; ABand: TcxBandAccess);
begin
TcxStylesAccess(TreeList.Styles).DoGetBandContentParams(ANode, ABand, AParams);
Provider.SetCellStyle(I, J, cxRegisterViewParams(AParams, catLeft, Provider, []));
end;
begin
Dec(Position);
try
ALeft := ANode.Level + Byte(TreeList.OptionsView.ShowRoot);
for J := 1 to HeaderInfoList.Dimension.cy - 1 do
Provider.SetRowHeight(Position + J, TreeList.DefaultRowHeight);
for I := 0 to HeaderInfoList.Dimension.cx - 1 do
for J := 1 to HeaderInfoList.Dimension.cy - 1 do
if (I > ALeft) and (HeaderInfoList.CellsMap[I, J] = 0) then
WriteUnusedSpace(I, J + Position, TcxBandInfoItem(HeaderMap[I, J]).Band);
for I := 0 to HeaderInfoList.ColumnCount - 1 do
WriteCell(HeaderInfoList.Columns[I]);
finally
Inc(Position, NodeCellsCount + 1);
end;
end;
procedure TcxTreeListMapsInfo.DoWritePreviewInfo(AInfo: TcxPreviewInfoItem);
var
R: TRect;
begin
with AInfo do
begin
with HeaderInfoList.Dimension do
R := Rect(Level, Position, cx, Position + 1);
Provider.SetCellValue(R.Left, R.Top, Value);
Provider.SetRowHeight(Position, Height);
DoWriteUnionRect(R, ViewParams, Alignment, cxCellBorders[GridLines]);
Inc(Position);
end;
end;
procedure TcxTreeListMapsInfo.DoWriteNodePreview(
ANode: TcxTreeListNode; AInfo: TcxPreviewInfoItem);
begin
DoWritePreviewInfo(AInfo)
end;
procedure TcxTreeListMapsInfo.DoWriteRect(ARect: TRect;
const AParams: TcxViewParams; ABorders: TcxBorders = cxBordersAll);
var
ACellBorders: TcxBorders;
AStyleIndex, AIndex, I, J: Integer;
begin
AStyleIndex := cxRegisterViewParams(AParams, catLeft, Provider, []);
OffsetRect(ARect, 0, Position);
for I := ARect.Left to ARect.Right - 1 do
for J := ARect.Top to ARect.Bottom - 1 do
begin
AIndex := AStyleIndex;
ACellBorders := cxCheckBorders(I, J, ARect, ABorders);
if ACellBorders <> [] then
AIndex := cxRegisterViewParams(AParams, catLeft, Provider, ACellBorders);
Provider.SetCellStyle(I, J, AIndex);
end;
end;
procedure TcxTreeListMapsInfo.DoWriteUnionRect(const ARect: TRect;
const AParams: TcxViewParams; Align: TcxAlignText; ABorders: TcxBorders = cxBordersAll);
var
AStyle: Integer;
begin
AStyle := cxRegisterViewParams(AParams, Align, Provider, ABorders);
with ARect do
Provider.SetCellStyleEx(Left, Top, Bottom - Top, Right - Left, AStyle);
end;
function TcxTreeListMapsInfo.GetDisplayText(
AIndex: Integer; ANode: TcxTreeListNode; AProperties: TcxCustomEditProperties): string;
begin
with AProperties do
begin
if GetEditValueSource(False) = evsValue then
Result := GetDisplayText(ANode.Values[AIndex], True)
else
Result := {GetDisplayText(}ANode.Texts[AIndex]{, True)};
end;
end;
function TcxTreeListMapsInfo.GetDisplayValue(
AIndex: Integer; ANode: TcxTreeListNode; AProperties: TcxCustomEditProperties): Variant;
begin
if IsNativeFormatProperties(AProperties) then
Result := ANode.Values[AIndex]
else
Result := AProperties.GetDisplayText(ANode.Values[AIndex], True);// GetDisplayText(AIndex, ANode, AProperties);
end;
function TcxTreeListMapsInfo.GetIndentStyle(
AColor: TColor; ABorders: TcxBorders): TcxCacheCellStyle;
begin
Result := cxSetStyleBorders(cxIndentStyle, 0, 0,
cxNullRect, cxBtnShadowColor, ABorders);
with Result do
begin
BrushBkColor := cxColorToRGB(AColor);
BrushFGColor := BrushBkColor;
FontColor := cxColorToRGB(TreeList.OptionsView.TreeLineColor);
end;
end;
function TcxTreeListMapsInfo.GetNodeItemDisplayValue(
ANode: TcxTreeListNode; AColumn: TcxTreeListColumn; var Align: TcxAlignText): Variant;
var
AProp: TcxCustomEditProperties;
begin
AProp := TcxColumnAccess(AColumn).DoGetEditProperties(ANode);
if Owner.IsNativeFormat then
Result := GetDisplayValue(AColumn.ItemIndex, ANode, AProp)
else
Result := GetDisplayText(AColumn.ItemIndex, ANode, AProp);
if VarIsNull(Result) then Result := '';
ALign := AlignToCxAlign[TcxPropertiesAccess(AProp).Alignment.Horz];
end;
function TcxTreeListMapsInfo.IsGroupNode(
ANode: TcxTreeListNode; var AInfo: TcxPreviewInfoItem): Boolean;
begin
if CurGroupInfo = nil then
CurGroupInfo := GroupList;
Result := (CurGroupInfo <> nil) and (CurGroupInfo.Node = ANode);
if Result then
begin
AInfo := CurGroupInfo;
CurGroupInfo := CurGroupInfo.Next;
end;
end;
function TcxTreeListMapsInfo.IsHasPreview(
ANode: TcxTreeListNode; var AInfo: TcxPreviewInfoItem): Boolean;
begin
if CurPreviewInfo = nil then
CurPreviewInfo := PreviewList;
Result := (CurPreviewInfo <> nil) and (CurPreviewInfo.Node = ANode);
if Result then
begin
AInfo := CurPreviewInfo;
CurPreviewInfo := CurPreviewInfo.Next;
end;
end;
function TcxTreeListMapsInfo.IsNativeFormatProperties(
AProperties: TcxCustomEditProperties): Boolean;
begin
Result := (AProperties is TcxDateEditProperties) or (AProperties is TcxCurrencyEditProperties) or
(AProperties is TcxSpinEditProperties) or (AProperties is TcxCalcEditProperties) or
(AProperties is TcxTimeEditProperties);
end;
procedure TcxTreeListMapsInfo.ValidateMaps;
var
I: Integer;
ABand: TcxBandInfoItem;
begin
with HeaderInfoList do
begin
for I := 0 to BandCount - 1 do
begin
ABand := Bands[I];
ABand.Position.Bottom := Dimension.cy;
cxFillMapItem(HeaderMap, ABand, True);
ABand.Position.Bottom := 1;
if Footer then cxFillMapItem(FooterMap, ABand, False);
ABand.RegisterStyles;
end;
for I := 0 to ColumnCount - 1 do
begin
if Footer then cxFillMapItem(FooterMap, Columns[I], False);
Columns[I].RegisterStyles;
end;
end;
end;
function TcxTreeListMapsInfo.GetBandLineHeight: Integer;
begin
with TreeList do
Result := TcxViewInfoAccess(ViewInfo).BandLineHeight * OptionsView.BandLineCount;
end;
function TcxTreeListMapsInfo.GetBands: Boolean;
begin
Result := TreeList.OptionsView.Bands;
end;
function TcxTreeListMapsInfo.GetNodeCellsCount: Integer;
begin
Result := HeaderInfoList.Dimension.cy - 1;
end;
function TcxTreeListMapsInfo.GetPreview: Boolean;
begin
Result := TreeList.Preview.Active;
end;
function TcxTreeListMapsInfo.GetPreviewAutoHeight: Boolean;
begin
Result := TreeList.Preview.AutoHeight;
end;
function TcxTreeListMapsInfo.GetProvider: IcxExportProvider;
begin
Result := Owner.Provider;
end;
function TcxTreeListMapsInfo.GetHeaders: Boolean;
begin
Result := TreeList.OptionsView.Headers;
end;
function TcxTreeListMapsInfo.GetFooter: Boolean;
begin
Result := TreeList.OptionsView.Footer;
end;
function TcxTreeListMapsInfo.GetFooters(AColumn: TcxTreeListColumn): Boolean;
begin
Result := Footer and AColumn.Options.Footer;
end;
function TcxTreeListMapsInfo.GetGridLines: Boolean;
begin
Result := TreeList.OptionsView.GridLines <> tlglNone;
end;
function TcxTreeListMapsInfo.GetHeaderLineHeight: Integer;
begin
Result := TcxViewInfoAccess(TreeList.ViewInfo).HeaderLineHeight;
end;
function TcxTreeListMapsInfo.GetTreeList: TcxTreeListAccess;
begin
Result := Owner.TreeList;
end;
function TcxTreeListMapsInfo.GetVertInc: Integer;
begin
Result := 2 * Byte(TreeList.OptionsView.GridLines in [tlglVert, tlglBoth]);
end;
procedure TcxTreeListMapsInfo.AddColumnsFromBand(
var AOfs: Integer; ABand: TcxTreeListBand);
var
I, J, ALeft, ABandWidth: Integer;
procedure AddColumn(ALineOfs: Integer; AColumn: TcxColumnAccess);
var
R: TRect;
begin
with AColumn do
begin
R := Rect(ALeft, ALineOfs + 1, // + 1 band header offset but may be invisible
ALeft + DisplayWidth, ALineOfs + Position.LineCount + 1);
Inc(ALeft, DisplayWidth);
end;
HeaderInfoList.AddItem(R, AColumn, TcxColumnInfoItem);
end;
begin
ABandWidth := TcxBandAccess(ABand).DisplayWidth;
for I := 0 to ABand.BandRows.Count - 1 do
begin
ALeft := AOfs;
with ABand.BandRows[I] do
begin
for J := 0 to Count - 1 do
AddColumn(LineOffset, TcxColumnAccess(Items[J]));
end;
end;
HeaderInfoList.AddItem(Rect(AOfs, 0, AOfs + ABandWidth, 1), ABand, TcxBandInfoItem);
Inc(AOfs, ABandWidth);
end;
{ TcxTreeListExportHelper }
constructor TcxTreeListExportHelper.Create(ATreeList: TcxCustomTreeListControl;
AExportType: Integer; const AFileName: string);
function DefaultStyle: TcxCacheCellStyle;
begin
cxViewParamsToCacheStyle(TreeList.Styles.GetBackgroundParams, Result);
end;
begin
FTreeList := TcxTreeListAccess(ATreeList);
TcxExport.Provider(AExportType, AFileName).GetInterface(IcxExportProvider, FProvider);
FProvider.SetDefaultStyle(DefaultStyle);
FSelectionList := TList.Create;
FSelectionList.Capacity := FTreeList.DataController.RecordCount;
MapsInfo := GetMapsInfoClass.Create(Self);
end;
destructor TcxTreeListExportHelper.Destroy;
begin
try
MapsInfo.Free;
FSelectionList.Free;
FProvider := nil;
finally
inherited Destroy;
end;
end;
procedure TcxTreeListExportHelper.CallIterationProc(ANode: TcxTreeListNode;
AIndex: Integer; AProc: TcxTreeListNodeItarationHandler);
var
APrevIndex: Integer;
begin
APrevIndex := TcxNodeAccess(ANode).FVisibleIndex;
TcxNodeAccess(ANode).FVisibleIndex := AIndex;
try
AProc(ANode);
finally
TcxNodeAccess(ANode).FVisibleIndex := APrevIndex;
end;
end;
procedure TcxTreeListExportHelper.DoCalculateTableMap;
begin
MapsInfo.DoCalculate;
end;
procedure TcxTreeListExportHelper.DoWriteCells;
begin
MapsInfo.DoWrite;
Provider.Commit;
end;
procedure TcxTreeListExportHelper.DoIterate(
AProc: TcxTreeListNodeItarationHandler);
begin
if not Assigned(AProc) then Exit;
if ExportSelection then
DoIterateSelectionNodes(AProc)
else
DoIterateAllNodes(AProc);
end;
procedure TcxTreeListExportHelper.DoIterateAllNodes(AProc: TcxTreeListNodeItarationHandler);
var
AIndex: Integer;
AStartNode: TcxTreeListNode;
begin
AStartNode := TreeList.Nodes.Root.GetFirstChild;
AIndex := 0;
while AStartNode <> nil do
begin
CallIterationProc(AStartNode, AIndex, AProc);
if Expand then
AStartNode := AStartNode.GetNext
else
AStartNode := AStartNode.GetNextVisible;
Inc(AIndex);
end;
end;
procedure TcxTreeListExportHelper.DoIterateSelectionNodes(
AProc: TcxTreeListNodeItarationHandler);
var
I: Integer;
begin
for I := 0 to FSelectionList.Count - 1 do
CallIterationProc(TcxTreeListNode(FSelectionList[I]), I, AProc);
end;
function TcxTreeListExportHelper.GetMapsInfoClass: TcxTreeListMapsInfoClass;
begin
Result := TcxTreeListMapsInfo;
end;
function TcxTreeListExportHelper.AddToSelection(ANode: TcxTreeListNode): Boolean;
begin
Result := FSelectionList.IndexOf(ANode) <> cxInvalidIndex;
if not Result then
begin
if not ANode.IsVisible then
begin
if not Expand then
Exit
else
ANode.Expanded := True;
end;
FSelectionList.Add(ANode);
Result := True;
end;
end;
procedure TcxTreeListExportHelper.CreateSelectionList;
var
I: Integer;
procedure CheckListItem(ANode: TcxTreeListNode);
begin
while ANode <> nil do
begin
if ANode.Selected and AddToSelection(ANode) then
CheckListItem(ANode.GetFirstChild);
ANode := ANode.GetNext;
end;
end;
begin
for I := 0 to TreeList.SelectionCount - 1 do
AddToSelection(TcxNodeAccess(TreeList.Selections[I]).GetRootParent);
for I := 0 to FSelectionList.Count - 1 do
CheckListItem(TcxTreeListNode(FSelectionList.List^[I]));
FSelectionList.Sort(cxNodesCompare);
end;
procedure TcxTreeListExportHelper.SetExportSelection(Value: Boolean);
begin
FExportSelection := Value;
if Value then CreateSelectionList;
end;
// external procedures definition
procedure cxExportTL4ToFile(AFileName: string; ATreeList: TcxCustomTreeListControl;
AExportType: Integer; AExpand, ASaveAll, AUseNativeFormat: Boolean;
const ASeparators: array of string; const AFileExt: string);
var
I: Integer;
AIntf: IcxExportWithSeparators;
begin
if AFileExt <> '' then
AFileName := ChangeFileExt(AFileName, '.' + AFileExt);
if not ATreeList.Visible then
cxTreeListError(scxExportNotVisibleControl);
with TcxTreeListExportHelper.Create(ATreeList, AExportType, AFileName) do
try
FExpand := AExpand;
FIsNativeFormat := AUseNativeFormat;
ExportSelection := not ASaveAll;
if cxExportTL4Link.Supports(Provider, IcxExportWithSeparators, AIntf) and (Length(ASeparators) > 0) then
begin
for I := Low(ASeparators) to High(ASeparators) do
AIntf.AddSeparator(ASeparators[I]);
end;
DoCalculateTableMap;
DoWriteCells;
finally
Free;
end;
end;
procedure cxExportTL4ToHTML(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; const AFileExt: string = 'html');
begin
cxExportTL4ToFile(AFileName, ATreeList, cxExportToHtml, AExpand, ASaveAll, False, [], AFileExt);
end;
procedure cxExportTL4ToXML(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; const AFileExt: string = 'xml');
begin
cxExportTL4ToFile(AFileName, ATreeList, cxExportToXML, AExpand, ASaveAll, False, [], AFileExt);
end;
procedure cxExportTL4ToExcel(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; AUseNativeFormat: Boolean = True;
const AFileExt: string = 'xls');
begin
cxExportTL4ToFile(AFileName, ATreeList, cxExportToExcel, AExpand, ASaveAll,
AUseNativeFormat, [], AFileExt);
end;
procedure cxExportTL4ToText(const AFileName: string; ATreeList: TcxCustomTreeListControl;
AExpand: Boolean = True; ASaveAll: Boolean = True; const ASeparator: string = '';
const ABeginString: string = ''; const AEndString: string = ''; const AFileExt: string = 'txt');
begin
cxExportTL4ToFile(AFileName, ATreeList, cxExportToText, AExpand, ASaveAll, False,
[ASeparator, ABeginString, AEndString], AFileExt);
end;
initialization
Move(cxIndentFontName[1], cxIndentStyle.FontName[0], Length(cxIndentFontName));
cxExportInit(TcxGetResourceStringProc(@cxGetResourceString), @ColorToRGB, {$IFDEF VCL} True {$ELSE} False {$ENDIF});
end.