报表处理组件 BY DELPHI

[Borlandor]

本人倾精力，时间使用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.申明：
本人对本套组件拥有全部自主版权。

欢迎公司或个人与我联系。
也希望各位同仁多多指教。
Email:[e-mail]。


{ 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;

[enmity]

gz

[Borlandor]

一个可以书写任意文本的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;
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;
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;
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;
end;
end;
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;
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;

end;
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;
end;
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;
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;
end;
end;
// ACanvas.Brush.Style := OldBrushStyle;
end;