报表处理组件 BY DELPHI

类别:Delphi 点击:0 评论:0 推荐:

本人倾精力,时间使用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:[email protected]

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

本文地址:http://com.8s8s.com/it/it6087.htm