报表处理组件 BY DELPHI

本人倾精力，时间使用DELPHI开发了一套报表处理组件，适合各种软件系统复杂的

报表处理功能，尤其是其提供的报表编辑，打印预览及数据导入接口等功能可以迅

速满足客户提出的有关报表处理的各种需求。

1.设计原则：

1.1 由抽象到具体的类层次管理简化报表处理对象的复杂性。

1.2 报表编辑、原始数据导入到打印预览一体化处理流程。

1.3 灵活的数据访问接口，程序代码与报表设计无关。

2.主要功能：

2.1 类EXCEL的设计界面，提供多种可编辑对象，包括普通文本、公式计算、数据导入等不同属性单元格，以及图形、图像、图表、文本框、数据视图、定制表

格等对象。

2.2 客户可以自由设计定制报告单格式，如普通式、彩色印刷式、图表一体式等。

2.3 美观的报表预览器，多种打印输出格式。

3.应用对象：

3.1 电网监控系统报表处理分系统（各种运行日报，月报，年报等）。

3.2 医院管理信息系统（各种统计分析报表）。

3.3 酒店管理信息系统（各种查询统计报表）。

3.4 检验管理系统（各种格式报告单）。

4.申明：

本人对本套组件拥有全部自主版权。

5.类树:

{ Forward declarations }

TGridCoordinate = class;

TGridCoordinates = class;

TCustomObject = class; {Abstract Class}

{1}

TActiveObject = class;

TActiveObjectClass = class of TActiveObject;

TGridCellObject = class;

TGridCellGroup = class;

//TDataViewParams = class

TDataView = class;

TDataTable = class;

TTileDataView = class;

TCascadeBand = class;

TCascadeBands = class;

TCascadeDataView = class;

TPlate = class;

TPlateClass = class of TPlate;

TChartPlate = class;

TImagePlate = class;

TTextPlate = class;

TActiveObjects = class;

TSelectedObjects = class;

{2}

TSparsePointerArray = class;

TSparseList = class;

TGridCellText = class;

TGridCellFrame = class;

TGridCell = class;

TGridCellClass = class of TGridCell;

TTextCell = class;

TDBCell = class;

TFormulaCell = class;

TRowCells = class;

TGridCells = class;

TGridCellEdit = class;

TSelectedCoord = class;

TSelectedCoords = class;

TTitleWindow = class;

TColumnWindow = class;

TRowWindow = class;

TClientWindow = class;

TTool = class;

{TSpreadsheetTool = class;}

TCoolScrollBar = class;

TCoolScrollControl = class;

TReportGrid = class;

欢迎公司或个人与我联系。

也希望各位同仁多多指教。

Email:lmis@sina.com。

6.附:

一个可以书写任意文本的Procedure，包括旋转字体。

TTextAlign = (taLeft,taRight,taHorzCenter,

taTop,taBottom,taVertCenter);

TTextAligns = set of TTextAlign;

TTextControl = (tcNormal,tcWordBreak,tcSelfAdapt,tcCalcRect);

TTextDirection = tdVertChinese..90;{Angles of text}

procedure WriteText(ACanvas: TCanvas;var ARect: TRect;AText: string; Aligns: TTextAligns;

Control: TTextControl;Direction: TTextDirection{; BeErase: Boolean = TRUE});

var S: String;

TempStr: WideString;

ColorRef: TColorRef;

DitheredFlag: Boolean;

LogicFont: TLogFont;

Scaler: Extended;

I,J,X,Y: Integer;

Interval,MaxExtent:Integer;

TextMetric: TTextMetric;

TempExtent: TSize;

TempRect: TRect;

procedure SetLogicFont(W: Integer = 0;H: Integer = 0);

begin

with LogicFont,ACanvas.Font do

begin

if H = 0 then lfHeight := Height

else lfHeight := H;

lfWidth := W;

lfEscapement := 10*Direction;

lfOrientation := 10*Direction;

lfWeight := FW_NORMAL;//FW_BOLD;

lfItalic := BYTE(fsItalic in Style);

lfUnderline := BYTE(fsUnderline in Style);

lfStrikeOut := BYTE(fsStrikeOut in Style);

lfCharSet := Charset;

lfOutPrecision := OUT_TT_PRECIS;

lfClipPrecision := CLIP_DEFAULT_PRECIS;

lfQuality := DEFAULT_QUALITY;

lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;

StrCopy(lfFaceName,PChar(Name));

end;

ACanvas.Font.Handle := Windows.CreateFontIndirect(LogicFont);

end;

procedure DrawDitheredText(BeginX,BeginY: Integer; TheText: String);

begin

DrawBitmap.Canvas.Lock; {Must have it !!}

try

with DrawBitmap do

begin

//Windows.ExtTextOut(Handle,0,0,ETO_OPAQUE,@TempRect, Nil,0,Nil);

Windows.ExtTextOut(Canvas.Handle, BeginX - ARect.Left , BeginY - ARect.Top,

{ETO_OPAQUE or }ETO_CLIPPED, @TempRect, PChar(TheText), Length(TheText),Nil);

ACanvas.CopyRect(ARect,Canvas,TempRect);

end;

finally

DrawBitmap.Canvas.Unlock;

end;

begin

{if BeErase then

if ACanvas.Brush.Style <> bsSolid then

begin

ACanvas.Pen.Style := psClear;

ACanvas.Rectangle(ARect);

ACanvas.Pen.Style := psSolid;

end else ACanvas.FillRect(ARect);

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

}

if AText = '' then Exit;

ColorRef := ColorToRGB(ACanvas.Brush.Color);

DitheredFlag := //(ACanvas = Printer.Canvas) or

(Windows.GetNearestColor(ACanvas.Handle, ColorRef) <> ColorRef);

if DitheredFlag then

begin

with DrawBitmap,ARect do { Use offscreen bitmap to eliminate flicker and }

begin { brush origin tics in painting / scrolling. }

Width := Max(Width, Right - Left);

Height := Max(Height, Bottom - Top);

Canvas.Font := ACanvas.Font;

Canvas.Brush := ACanvas.Brush;

Canvas.Brush.Style := bsSolid;

TempRect := Rect(0, 0, Right - Left, Bottom - Top);

Windows.ExtTextOut(Canvas.Handle,0,0,{ETO_OPAQUE or }ETO_CLIPPED,@TempRect, Nil,0,Nil)

end;

{Prepare parameters for below process}

case Direction of

tdVertChinese:

begin

{More special,use the equivalent width font}

ACanvas.Font.Pitch := fpFixed;

Scaler := 1;

MaxExtent := ARect.Bottom - ARect.Top ;

end;

0:{Horizontal}

begin

Scaler := 1;

MaxExtent := ARect.Right - ARect.Left ;

end;

1..45:

begin

SetLogicFont;

Scaler := Cos(Direction * Pi / 180);

MaxExtent := Floor((ARect.Right - ARect.Left)/Scaler);

end;

46..90:

begin

SetLogicFont;

Scaler := Sin(Direction * Pi / 180);

MaxExtent := Floor((ARect.Bottom - ARect.Top)/ Scaler);

end;

-90..-46:

begin

SetLogicFont;

Scaler := Sin(-Direction * Pi / 180);

MaxExtent := Floor((ARect.Bottom - ARect.Top)/ Scaler);

end;

-45..-1:

begin

SetLogicFont;

Scaler := Cos(-Direction * Pi / 180);

MaxExtent := Floor((ARect.Right - ARect.Left)/Scaler);

end;

{Get control text}

case Control of

tcWordBreak:

begin

J := 0;

X := 0;

TempStr := WideString(AText);

for I := 1 to Length(WideString(AText)) do

begin

S := WideString(AText)[I];

if (S = #13) or (S = #10) then

J := 0

else begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);

//TempExtent := ACanvas.TextExtent(S);

if Direction = tdVertChinese then

begin

Inc(J,TempExtent.CY);

if J > MaxExtent then

begin

J := TempExtent.CY;

Insert(#13#10,TempStr,I+X); {Soft return}

Inc(X,2);

end;

end else

begin

Inc(J,TempExtent.CX);

if J > MaxExtent then

begin

J := TempExtent.CX;

Insert(#13#10,TempStr,I+X); {Soft return}

Inc(X,2);

end;

Texts.Text := TempStr;

end;

tcSelfAdapt:

begin

Texts.Text := AText;

if Direction = tdVertChinese then

begin

//J := 0;

//X := Length(WideString(Texts[0]));

//TempStr := WideString(Texts[0]);

TempStr := '';

for I := 0 to Texts.Count - 1 do

begin

if Length(TempStr) < Length(WideString(Texts[I])) then

TempStr := WideString(Texts[I]);

//if X < Length(WideString(Texts[I])) then

//begin

// X := Length(WideString(Texts[I]));

// J := I;

//end;

end;

//TempStr := WideString(Texts[J]);

if Length(TempStr) <> 0 then

begin

J := Floor(MaxExtent / Length(TempStr));

for I := ACanvas.Font.Size-1 downto 5 do

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

if TextMetric.tmHeight < J then Break

else ACanvas.Font.Size := I;

end;

// if -ACanvas.Font.Height > J then

// SetLogicFont(0,0);

// else

end;

end else begin

J := 0;

S := '';

for I := 0 to Texts.Count - 1 do

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

if J < TempExtent.CX then

begin

S := Texts[I];

J := TempExtent.CX;

end;

{for I := ACanvas.Font.Size-1 downto 5 do

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);

if TempExtent.CX < MaxExtent then Break

else ACanvas.Font.Size := I;

end;}

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);

if TempExtent.CX > MaxExtent then

for I := -ACanvas.Font.Height downto 1 do

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);

if TempExtent.CX < MaxExtent then Break

else SetLogicFont(I,0);

end;

tcCalcRect:

begin

Texts.Text := AText;

case Direction of

tdVertChinese:

begin

TempStr := WideString(Texts[0]);

for I := 1 to Texts.Count - 1 do

begin

if Length(TempStr) < Length(WideString(Texts[I])) then

TempStr := WideString(Texts[I]);

end;

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

ARect.Bottom := ARect.Top + Length(TempStr) * TextMetric.tmHeight;

end;

0:{Horizontal}

begin

J := 0;

for I := 0 to Texts.Count - 1 do

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

if J < TempExtent.CX then J := TempExtent.CX;

end;

ARect.Right := ARect.Left + J;

end;

1..45,-45..-1:

begin

J := 0;

for I := 0 to Texts.Count - 1 do

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

if J < TempExtent.CX then J := TempExtent.CX;

end;

ARect.Right := ARect.Left + Ceil(J*Scaler);

end;

46..90,-90..-46:

begin

J := 0;

for I := 0 to Texts.Count - 1 do

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

if J < TempExtent.CX then J := TempExtent.CX;

end;

ARect.Bottom := ARect.Top + Ceil(J*Scaler);

end;

else Texts.Text := AText;

end;

{Initialize the origin point}

case Direction of

tdVertChinese:

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

Interval := TextMetric.tmMaxCharWidth + Windows.GetTextCharacterExtra(ACanvas.Handle);

J := Interval * Texts.Count;

if taLeft in Aligns then

X := ARect.Left + J - Interval

else if taHorzCenter in Aligns then

X := (ARect.Right + ARect.Left + J) shr 1 - Interval

else {if taRight in Aligns}

X := ARect.Right - Interval;

Y := ARect.Top + 2;

end;

0:{Horizontal}

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

Interval := TextMetric.tmHeight;// + TextMetric.tmExternalLeading;

J := Interval * Texts.Count;

X := ARect.Left + 2;

if taBottom in Aligns then

Y := ARect.Bottom - J

else if taVertCenter in Aligns then

Y := (ARect.Bottom + ARect.Top - J) shr 1

else {if taTop in Aligns then}

Y := ARect.Top + 2;

end;

1..45:

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

Interval := Ceil((TextMetric.tmHeight {+ TextMetric.tmExternalLeading})/Scaler);

J := Interval * Texts.Count;

X := ARect.Left + 2;

if taBottom in Aligns then

Y := ARect.Bottom - J

else if taVertCenter in Aligns then

Y := (ARect.Bottom + ARect.Top - J) shr 1

else {if taTop in Aligns then}

Y := ARect.Top + 2;

end;

46..90:

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

Interval := Ceil((TextMetric.tmHeight {+ TextMetric.tmExternalLeading})/Scaler);

J := Interval * Texts.Count;

if taRight in Aligns then

X := ARect.Right - J

else if taHorzCenter in Aligns then

X := (ARect.Right + ARect.Left - J) shr 1

else {if taLeft in Aligns}

X := ARect.Left + 2;

Y := ARect.Bottom - 2;

end;

-90..-46:

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

Interval := Ceil((TextMetric.tmHeight{ + TextMetric.tmExternalLeading})/Scaler);

J := Interval * Texts.Count;

if taLeft in Aligns then

X := ARect.Left + J

else if taHorzCenter in Aligns then

X := (ARect.Right + ARect.Left + J) shr 1

else {if taRight in Aligns}

X := ARect.Right - 2;

Y := ARect.Top + 2;

end;

-45..-1:

begin

Windows.GetTextMetrics(ACanvas.Handle,TextMetric);

Interval := Ceil((TextMetric.tmHeight{ + TextMetric.tmExternalLeading})/Scaler);

J := Interval * Texts.Count;

X := ARect.Left + 2;

if taBottom in Aligns then

Y := ARect.Bottom - J

else if taVertCenter in Aligns then

Y := (ARect.Bottom + ARect.Top - J) shr 1

else {if taTop in Aligns then}

Y := ARect.Top + 2;

end;

//OldBrushStyle := ACanvas.Brush.Style;

//ACanvas.Brush.Style := bsClear;

for I := 0 to Texts.Count - 1 do

begin

case Direction of

tdVertChinese:

begin

J := Length(WideString(Texts[I])) * (TextMetric.tmHeight{ + TextMetric.tmExternalLeading});

if taBottom in Aligns then

Y := ARect.Bottom - J

else if taVertCenter in Aligns then

Y := (ARect.Bottom + ARect.Top - J) shr 1

else {if taTop in Aligns then}

Y := ARect.Top + 2;

TempExtent.CX := X;

TempExtent.CY := Y;

for J := 1 to Length(WideString(Texts[I])) do

begin

S := WideString(Texts[I])[J];

if DitheredFlag then

DrawDitheredText(TempExtent.CX,TempExtent.CY,S)

else begin

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,

@ARect, PChar(S), Length(S),Nil);

end;

Inc(TempExtent.CY ,TextMetric.tmHeight{ + TextMetric.tmExternalLeading});

end;

Dec(X,Interval);

end;

0:{Horizontal}

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

if taRight in Aligns then

X := ARect.Right - TempExtent.CX

else if taHorzCenter in Aligns then

X := (ARect.Right + ARect.Left - TempExtent.CX) shr 1

else {if taLeft in Aligns then}

X := ARect.Left + 2;

if DitheredFlag then

DrawDitheredText(X,Y,Texts[I])

else begin

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

Windows.ExtTextOut(ACanvas.Handle, X, Y,{ETO_OPAQUE or} ETO_CLIPPED,

@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);

end;

Inc(Y,Interval);

end;

1..45:

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

J := Ceil(TempExtent.CX*Scaler);

if taRight in Aligns then

begin

TempExtent.CX := ARect.Right - J;

TempExtent.CY := Y + Ceil((X- TempExtent.CX)* Tan(Direction * Pi / 180));

end else if taHorzCenter in Aligns then

begin

TempExtent.CX := (ARect.Right + ARect.Left - J) shr 1;

TempExtent.CY := Y + Ceil((X - TempExtent.CX )* Tan(Direction * Pi / 180));

end else {if taLeft in Aligns then}

begin

TempExtent.CX := ARect.Left + 2;

TempExtent.CY := Y;

end;

if DitheredFlag then

DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])

else begin

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,

@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);

end;

Inc(Y,Interval);

end;

46..90:

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

J := Ceil(TempExtent.CX*Scaler);

if taTop in Aligns then

begin

TempExtent.CY := ARect.Top + J;

TempExtent.CX := X + Ceil((Y - TempExtent.CY)/ Tan(Direction * Pi / 180));

end else if taVertCenter in Aligns then

begin

TempExtent.CY := (ARect.Bottom + ARect.Top + J) shr 1;

TempExtent.CX := X + Ceil((Y - TempExtent.CY)/ Tan(Direction * Pi / 180));

end else {if taLeft in Aligns then}

begin

TempExtent.CY := ARect.Top + 2;

TempExtent.CX := X;

end;

if DitheredFlag then

DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])

else begin

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,

@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);

end;

Inc(X,Interval);

end;

-90..-46:

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

J := Ceil(TempExtent.CX*Scaler);

if taBottom in Aligns then

begin

TempExtent.CY := ARect.Bottom - J;

TempExtent.CX := X + Ceil((TempExtent.CY - Y)/ Tan(-Direction * Pi / 180));

end else if taVertCenter in Aligns then

begin

TempExtent.CY := (ARect.Bottom + ARect.Top - J) shr 1;

TempExtent.CX := X + Ceil((TempExtent.CY - Y)/ Tan(-Direction * Pi / 180));

end else {if taLeft in Aligns then}

begin

TempExtent.CY := ARect.Top + 2;

TempExtent.CX := X;

end;

if DitheredFlag then

DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])

else begin

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,

@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);

end;

Dec(X,Interval);

end;

-45..-1:

begin

Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);

J := Ceil(TempExtent.CX*Scaler);

if taRight in Aligns then

begin

TempExtent.CX := ARect.Right - J;

TempExtent.CY := Y + Ceil((TempExtent.CX - X ) * Tan(-Direction * Pi / 180));

end else if taHorzCenter in Aligns then

begin

TempExtent.CX := (ARect.Right + ARect.Left - J) shr 1;

TempExtent.CY := Y + Ceil((TempExtent.CX - X ) * Tan(-Direction * Pi / 180));

end else {if taLeft in Aligns then}

begin

TempExtent.CX := ARect.Left + 2;

TempExtent.CY := Y;

end;

if DitheredFlag then

DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])

else begin

//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);

Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,

@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);

end;

Inc(Y,Interval);

end;

// ACanvas.Brush.Style := OldBrushStyle;

end;