reportcontrol.pas

企业智能(ERP)管理系统

//ReportControl.pas
{*************************************************/
*  表格式报表处理系统 of  DELPHI
*  简称：CReport
*  原创：郭家骏、王寒松

*  优化(Ver 4.02)：宋科（Godman）
*  优化内容：
   1、增加对流的支持
   2、将生成临时文件改为用内存流
   3、优化了一些代码，更OO
   4、将部分全局变量改为类域
   5、修改了因为找不到数据集或字段而报错
   6、整理了代码的缩进
   7、整理了代码的一些大小写

    大家修改后最好是发布到Internet，这样大家共同完善，保护了别人的努力也同时
    保护了自已的努力。

　　请将修改后的源码发我一份：[e-mail]

宋科（Godman）
珠海 2003.11.27


*　修改(ver 4.01): 李泽伦，内容：

   1.按国人习惯的表格设计,未满一页自动以空表格补齐 (可选)
   2.对预览窗口进行了重新设计,在预览时可重设边距及纸张(增加了用户调用页面设置等内容),更加美观和实用.
   3.完全重写了PreparePrint过程,不再出现打印空页或有时不能完全打印数据等问题
   4.新增部份函数和过程,可在预览时由最终用户通过拖动边框线立即永久性修改某一单元格宽.
   5.修改了报表模板编辑器(再不需要EXE文件了),与控件为一体,双击即可调用。pageNo有3种样式可选(第?页,第?/?页,第?-?页)
   6.增加了数据表字段列表按健,可通过拖动字段自动填入模板单元格中.
   7.增加了在模板中控制数值显示格式的功能,不用在字段属性中设置,由此也可不必再设置永久字段了。
   8.更正了拆分单元格后，不能对齐的问题。
   9.增加了在IDE中的预览和模板编辑器调用功能.
  10.增加了两个函数,可实现每一页及整个表的每列汇总功能，各列的和还可做加减运算并将结果填入任意列中。
  11.增加了图片功能(.bmp.jpg.ico类型均可),包括对数据库中的图像字段均可预览打印.
  12.可打印DBGrid.
  13.新增及完善了动态报表的支持功能,可对单个cell或成批cell进行设置或赋值.

  2003.8.8
***************************************************}
unit ReportControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Math, Printers, Menus, DBGrids,
  Db, jpeg,
  dbtables, DesignEditors, DesignIntf, ShellAPI, REPmess;
//dsgnintf d5
const
  // Horz Align
  TEXT_ALIGN_LEFT = 0;
  TEXT_ALIGN_CENTER = 1;
  TEXT_ALIGN_RIGHT = 2;

  // Vert Align
  TEXT_ALIGN_TOP = 0;
  TEXT_ALIGN_VCENTER = 1;
  TEXT_ALIGN_BOTTOM = 2;

  // 斜线定义
  LINE_LEFT1 = 1; // left top to right bottom
  LINE_LEFT2 = 2; // left top to right
  LINE_LEFT3 = 4; // left top to bottom

  LINE_RIGHT1 = $100; // right top to left bottom
  LINE_RIGHT2 = $200; // right top to left
  LINE_RIGHT3 = $400; // right top to bottom

type
  TReportCell = class;
  TReportLine = class;
  TReportControl = class;

  TReportCell = class(TObject)
  private
    { Private declarations }
    FLeftMargin: Integer; // 左边的空格
    FOwnerLine: TReportLine; // 隶属行
    FOwnerCell: TReportCell; // 隶属的单元格
    FCellsList: TList; // 覆盖的Cell

    // Index
    FCellIndex: Integer; // Cell在行中的索引

    // size & position
    FCellLeft: Integer;
    FCellWidth: Integer;

    FCellRect: TRect; // 计算得来
    FTextRect: TRect;

    FDragCellHeight: Integer;
    FMinCellHeight: Integer;
    FRequiredCellHeight: Integer;

    // Cell的Top属性从隶属的行中取得
    // int GetCellTop();
    // Cell的Height属性从隶属行和跨越行中取得
    // int GetCellHeight();

    // border
    FLeftLine: Boolean;
    FLeftLineWidth: Integer;

    FTopLine: Boolean;
    FTopLineWidth: Integer;

    FRightLine: Boolean;
    FRightLineWidth: Integer;

    FBottomLine: Boolean;
    FBottomLineWidth: Integer;

    // 斜线
    FDiagonal: UINT;

    // color
    FTextColor: COLORREF;
    FBackGroundColor: COLORREF;

    // align
    FHorzAlign: Integer;
    FVertAlign: Integer;

    // string
    FCellText: string;
    FCellDispFormat: string;

    FBmp: TBitmap; // add 李泽伦
    FBmpYn: boolean; // add 李泽伦
    // font
    FLogFont: TLOGFONT;
    function GetCellHeight: Integer;
    function GetCellTop: Integer;
    function GetOwnerLineHeight: Integer;
  protected
    { Protected declarations }
    procedure SetLeftMargin(LeftMargin: Integer);
    procedure SetOwnerLine(OwnerLine: TReportLine);

    procedure SetOwnerCell(Cell: TReportCell);
    function GetOwnedCellCount: Integer;

    procedure SetCellLeft(CellLeft: Integer);
    procedure SetCellWidth(CellWidth: Integer);

    procedure SetLeftLine(LeftLine: Boolean);
    procedure SetLeftLineWidth(LeftLineWidth: Integer);

    procedure SetTopLine(TopLine: Boolean);
    procedure SetTopLineWidth(TopLineWidth: Integer);

    procedure SetRightLine(RightLine: Boolean);
    procedure SetRightLineWidth(RightLineWidth: Integer);

    procedure SetBottomLine(BottomLine: Boolean);
    procedure SetBottomLineWidth(BottomLineWidth: Integer);

    procedure SetCellText(CellText: string);
    procedure SetCellDispFormat(CellDispFormat: string);
    procedure SetLogFont(NewFont: TLOGFONT);

    procedure SetBackGroundColor(BkColor: COLORREF);
    procedure SetTextColor(TextColor: COLORREF);

  public
    { Public declarations }
    procedure AddOwnedCell(Cell: TReportCell);
    procedure RemoveAllOwnedCell;
    procedure RemoveOwnedCell(Cell: TReportCell);
    function IsCellOwned(Cell: TReportCell): Boolean;
    procedure CalcCellRect;
    procedure CalcMinCellHeight;
    procedure PaintCell(hPaintDC: HDC; bPrint: Boolean);
    procedure CopyCell(Cell: TReportCell; bInsert: Boolean);

    constructor Create;
    destructor Destroy; override;

    // Properties
    property LeftMargin: Integer read FLeftMargin write SetLeftMargin;
    property OwnerLine: TReportLine read FOwnerLine write SetOwnerLine;
    property OwnerCell: TReportCell read FOwnerCell write SetOwnerCell;
    property OwnedCellCount: Integer read GetOwnedCellCount;

    property CellIndex: Integer read FCellIndex write FCellIndex;

    // size & position
    property CellLeft: Integer read FCellLeft write SetCellLeft;
    property CellWidth: Integer read FCellWidth write SetCellWidth;
    property CellTop: Integer read GetCellTop;
    property CellHeight: Integer read GetCellHeight;

    property CellRect: TRect read FCellRect;
    property TextRect: TRect read FTextRect;

    property DragCellHeight: Integer read FDragCellHeight;
    // or protected property ?
    property MinCellHeight: Integer read FMinCellHeight write FMinCellHeight;
    property RequiredCellHeight: Integer read FRequiredCellHeight;
    property OwnerLineHeight: Integer read GetOwnerLineHeight;

    // border
    property LeftLine: Boolean read FLeftLine write SetLeftLine default True;
    property LeftLineWidth: Integer read FLeftLineWidth write SetLeftLineWidth default 1;

    property TopLine: Boolean read FTopLine write SetTopLine default True;
    property TopLineWidth: Integer read FTopLineWidth write SetTopLineWidth default 1;

    property RightLine: Boolean read FRightLine write SetRightLine default True;
    property RightLineWidth: Integer read FRightLineWidth write SetRightLineWidth default 1;

    property BottomLine: Boolean read FBottomLine write SetBottomLine default True;
    property BottomLineWidth: Integer read FBottomLineWidth write SetBottomLineWidth default 1;

    // 斜线
    property Diagonal: UINT read FDiagonal write FDiagonal;

    // color
    property TextColor: COLORREF read FTextColor write SetTextColor default clBlack;
    property BkColor: COLORREF read FBackGroundColor write SetBackGroundColor default clWhite;

    // align
    property HorzAlign: Integer read FHorzAlign write FHorzAlign default 1;
    property VertAlign: Integer read FVertAlign write FVertAlign default 1;

    // string
    property CellText: string read FCellText write SetCellText;
    property CellDispFormat: string read FCellDispFormat write SetCellDispFormat;


    // font
    property LogFont: TLOGFONT read FLogFont write SetLogFont;
  end;

  TReportLine = class(TObject)
  private
    { Private declarations }
    FReportControl: TReportControl; // Report Control的指针
    FCells: TList; // 保存所有在该行中的CELL
    FIndex: Integer; // 行的索引

    FMinHeight: Integer;
    FDragHeight: Integer;
    FLineTop: Integer;
    FLineRect: TRect;
    function GetLineHeight: Integer;
    function GetLineRect: TRect;
    procedure SetDragHeight(const Value: Integer);
    procedure SetLineTop(const Value: Integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    property ReportControl: TReportControl read FReportControl write FReportControl;
    property Index: Integer read FIndex write FIndex;
    property LineHeight: Integer read GetLineHeight write SetDragHeight;
    property LineTop: Integer read FLineTop write SetLineTop;
    property LineRect: TRect read GetLineRect;
    property PrevLineRect: TRect read FLineRect;

    procedure CalcLineHeight;
    procedure CreateLine(LineLeft, CellNumber, PageWidth: Integer);
    procedure CopyLine(Line: TReportLine; bInsert: Boolean);

    constructor Create;
    destructor Destroy; override;
  end;

  TReportControl = class(TWinControl)
  private
    FCreportEdit: boolean; //// add 李泽伦
    { Private declarations }
    FPreviewStatus: Boolean;

    FLineList: TList;
    FSelectCells: TList;
    FEditCell: TReportCell;

    FReportScale: Integer;
    FPageWidth: Integer;
    FPageHeight: Integer;

    FLeftMargin: Integer; // 1
    FRightMargin: Integer;
    FTopMargin: Integer;
    FBottomMargin: Integer;

    FcellFont: TlogFont;
    FcellFont_d: TlogFont;

    FLeftMargin1: Integer;
    FRightMargin1: Integer;
    FTopMargin1: Integer;
    FBottomMargin1: Integer;

    FHootNo: Integer; //表尾的第一行在整个页的第几行 李泽伦


    // 换页加表头（不加表头）
    FNewTable: Boolean;

    // 定义打印多少行后从新加表头
    FDataLine: Integer;

    FTablePerPage: Integer;

    // 鼠标操作支持
    FMousePoint: TPoint;

    // 编辑、颜色及字体
    FEditWnd: HWND;
    FEditBrush: HBRUSH;
    FEditFont: HFONT;
    //procedure SetScale(const Value: Integer);

    //FReportMenu : TPopupMenu;

    procedure setCreportEdit(const value: boolean); //// add 李泽伦
  protected
    { Protected declarations }
    procedure CreateWnd; override;
  public
    { Public declarations }
    CPreviewEdit: boolean;

    FprPageNo: Integer; //打印文件的纸张序号  李泽伦
    FprPageXy: Integer; //打印文件的纸张纵横方向  李泽伦
    fPaperLength: Integer;
    fPaperWidth: Integer;

    cp_pgw, cp_pgh, scale: Integer;

    CellsWidth: array of array of Integer; //李泽伦 存用户在预览时拖动表格后新的单元格宽度,
    NhasSumALl: Integer; //有合计的行在模板中是第几行 lzl.

    cp_prewYn: Boolean; //代表是否处于预览状态, 李泽伦　
    //EditEpt:Boolean; //是否充许用户在预览时调用编辑程序修改模板

    cellline_d: TReportCell; //用于保存选中单元格的属性
    celldisp: TReportCell; //用于显示Mouse位置的单元格属性

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    //procedure setSaveToFile(callRow,lenk:Integer;RcallText:array of string);
    procedure SaveToStream(Stream: TStream;const APosition:Integer=0);
    procedure SaveToFile(FileName: string);
    procedure LoadFromStream(Stream: TStream;const APosition:Integer=0);
    procedure LoadFromFile(FileName: string);

    procedure SetCellFocus(row, col: Integer); //add 李泽伦 选择单元格
    procedure SetCellSFocus(row1, col1, row2, col2: Integer); //add 李泽伦 选择单元格

    procedure SaveBmp(ThisCell: Treportcell; filename: string); //lzl add
    function LoadBmp(ThisCell: Treportcell): TBitmap; //lzl add
    procedure FreeBmp(ThisCell: Treportcell); //lzl add
    procedure SetLineHegit(row, h: Integer); // lzl add

    procedure PrintIt;
    procedure ResetContent;
    procedure SetScale(const Value: Integer);

    property cellFont: TlogFont read Fcellfont write Fcellfont; //default True;
    property cellFont_d: TlogFont read Fcellfont_d write Fcellfont_d; //default True;

    // Message Handler
    procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMLButtonDBLClk(var Message: TMessage); message WM_LBUTTONDBLCLK;
    procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
    procedure WMContextMenu(var Message: TMessage); message WM_CONTEXTMENU;
    procedure WMPaint(var Message: TMessage); message WM_PAINT;
    procedure WMCOMMAND(var Message: TMessage); message WM_COMMAND;
    procedure WMCtlColor(var Message: TMessage); message WM_CTLCOLOREDIT;


    // Window size
    procedure CalcWndSize;
    procedure SetWndSize(w, h: Integer); //add 李泽伦 在定义动态报表时,设置纸的大小 不调用windows的打印设置对框时
    procedure SetPageSize(w, h: Integer); //add 李泽伦 动态报表设置纸张大小


    procedure NewTable(ColNumber, RowNumber: Integer);

    procedure InsertLine;
    function CanInsert: Boolean;
    procedure AddLine;
    function CanAdd: Boolean;
    procedure DeleteLine;

    procedure InsertCell;
    procedure DeleteCell;
    procedure AddCell;

    procedure SetCallText(cRow, ccoln: Integer; RcallText: string); //add李泽伦
    procedure GetCellsWadth(HasDataNo: Integer); //add 李泽伦
    procedure SetFileCellWidth(filename: string; HasDataNo: Integer); //add 李泽伦
    procedure SetStreamCellWidth(Stream: TStream; HasDataNo: Integer);

    procedure CombineCell;

    procedure SplitCell;
    procedure VSplitCell(Number: Integer);
    function CanSplit: Boolean;

    function CountFcells(crow: Integer): Integer; //李泽伦

    procedure SetCellLines(bLeftLine, bTopLine, bRightLine, bBottomLine: Boolean;
      nLeftLineWidth, nTopLineWidth, nRightLineWidth, nBottomLineWidth: Integer);

    procedure SetCellDiagonal(NewDiagonal: UINT);
    procedure SetCellTextColor(NewTextColor: COLORREF);
    procedure SetCellColor(NewTextColor, NewBackColor: COLORREF);
    procedure SetCellBackColor(NewBackColor: COLORREF);

    procedure SetCellDispFormt(mek: string);
    procedure SetCellSumText(mek: string);

    procedure SetCellFont(CellFont: TLOGFONT);
    procedure SetCellAlign(NewHorzAlign, NewVertAlign: Integer);

    procedure SetCellAlignHorzAlign(NewHorzAlign: Integer);
    procedure SetCellAlignNewVertAlign(NewVertAlign: Integer);

    procedure SetMargin(nLeftMargin, nTopMargin, nRightMargin, nBottomMargin: Integer);
    function GetMargin: TRect;

    function getcellfont: TFont; // add wang hang song

    procedure UpdateLines;

    procedure FreeEdit; //取销编辑状态  李泽伦

    procedure StartMouseDrag(point: TPoint);
    procedure StartMouseSelect(point: TPoint; bSelectFlag: Boolean; shift_down: byte);
    procedure MouseMoveHandler(message: TMSG);

    // 选中区的操作
    function AddSelectedCell(Cell: TReportCell): Boolean;
    function RemoveSelectedCell(Cell: TReportCell): Boolean;
    procedure RemoveAllSelectedCell;

    function IsCellSelected(Cell: TReportCell): Boolean;
    function CellFromPoint(point: TPoint): TReportCell;

    property IsPreview: Boolean read FPreviewStatus write FPreviewStatus default False;
    property ReportScale: Integer read FReportScale write SetScale default 100;
    property IsNewTable: Boolean read FNewTable write FNewTable default True;
    property DataLine: Integer read FDataLine write FDataLine default 2147483647;