preport.~pas

是 delphi6的函数库

{1030  增加是否套打功能 版本识别号 选择单元格内容
1101
自动调整显示字体大小  竖式报表
0 保存到数据库
1 打印预览时 最好不要全部读到内存；-先显示第一页，再显示其他
2 表格属性 3 设计后预览功能 纸张设置功能
4 根据数据集产生报表功能 5 多单据主从表打印
}
Unit PReport;

Interface

Uses
  Windows, Messages, SysUtils, FileCtrl, Classes, Graphics, Controls,
  Forms, Dialogs, Math, Printers, Menus, dbgrids, Db, jpeg, dbtables,
  DesignEditors, DesignIntf, ShellAPI, ExtCtrls, ListActns,StdCtrls;
Const
  //版本号
  VERSIONNO_BEGIN=2004001;//开始版本号
  VERSIONNO_CURRENT=2004002;//版本号 版本升级:先修改 VERSIONNO_CURRENT,再修改Read相关内容
  // 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;
  TPRClass = Class;
   //  TReportCell类定义
  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;
    FCellTop:integer;
   // FCellheight:integer;

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

    FDragCellHeight: Integer;
    FMinCellHeight: Integer;
    FDefineCellHeight: Integer;
    FRequiredCellHeight: Integer;
    // Cell的Top属性从隶属的行中取得      int GetCellTop();
    // Cell的Height属性从隶属行和跨越行中取得 int GetCellHeight();
    // 边线
    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;//显示格式
    FCellDef: String;//取数描述
    FBmp: TBitmap;
    FbmpYn: boolean;
    // 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 SetDefineCellHeight(CellHeight: 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 SetCellDef(CellDef: String);//0825
    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; PrintDesign,bPrintLine: 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 Write FCellTop;
    Property CellHeight: Integer Read GetCellHeight Write FDefineCellHeight;

    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 DefineCellHeight: Integer Read FDefineCellHeight Write SetDefineCellHeight;

    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;
    Property CellDef: String Read FCellDef Write SetCellDef;
    // font
    Property LogFont: TLOGFONT Read FLogFont Write SetLogFont;
  End;

  TReportLine = Class(TObject)
  Private
    { Private declarations }
    FPRControl: TPRClass;     // 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 PReportCtl: TPRClass Read FPRControl Write
      FPRControl;
    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;
  //20040826
  TDatasetDef = Class(TObject)
    sDataset: String;  //
    sDefine: String; //报表属性 
    slFieldName:TStringList;  //字段名称
    slFieldLabel:TStringList; //字段标签
  End;
  //变量对照列表
  TVariables = Class(TObject)
    sVariableName: String;
    sVariableValue: String;
  End;

  TPRClass = Class(TWinControl)
  Private
    FCreportEdit: boolean;
    { 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;
    FFootNo: integer;                   //表尾的第一行在整个页的第几行
    // 换页加表头（不加表头）
    FNewTable: Boolean;
// 定义打印多少行后重新加表头=明细表行数限制  vip
     FVersionNo:Integer;  //版本号
     FAncientStyle:Boolean;
     FDataLine: Integer;
     FAddSpace:Boolean;
     FPrintLine:boolean;
    FDatasourceList:TList;
    FTablePerPage: Integer;
    // 鼠标操作支持
    FMousePoint: TPoint;
    // 编辑、颜色及字体
    FEditWnd: HWND;
    FEditBrush: HBRUSH;
    FEditFont: HFONT;
    //FReportMenu : TPopupMenu;
    Function LFindComponent(Owner: TComponent; Name: String): TComponent;
    Procedure setCreportEdit(Const value: boolean);
    Procedure SetParam(FIDE, Tableopen: boolean; name: String);
  Protected
    { Protected declarations }
    Procedure CreateWnd; Override;
  Public
    { Public declarations }
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    //
    Procedure SetDatasource(strDatasetName: String; pDataSet: TDataSet);
    Procedure SaveToFile(FileName: String);
    Procedure LoadFromFile(FileName: String);
    procedure LoadFromStream(Stream: TStream;const APosition:Integer=0);
    procedure SaveToStream(Stream: TStream;const APosition:Integer=0);
    Procedure SetCellFocus(row, col: integer); //  选择单元格
    Procedure SetCellSFocus(row1, col1, row2, col2: integer);  //  选择单元格

    Procedure SaveBmp(thiscell: Treportcell; filename: String);
    Function LoadBmp(thiscell: Treportcell): TBitmap;
    Procedure FreeBmp(thiscell: Treportcell);
    Procedure SetLineHegit(row, h: integer);

    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;
    Property DatasourceList: TList Read FDatasourceList Write FDatasourceList;
    // 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);  //在定义动态报表时,设置纸的大小 不调用windows的打印设置对框时
    Procedure SetPageSize(w, h: integer); //  动态报表设置纸张大小

    Procedure NewTable(ColNumber, RowNumber: Integer);

    Procedure InsertLine;
    Function CanInsert: Boolean;
    Procedure AddLine;
    Function CanAdd: Boolean;
    Procedure DeleteLine;

    Procedure InsertCell;
    Procedure DeleteCell;
    Procedure AddCell;

    Procedure SetCellText(cRow, ccoln: integer; RcallText: String); //
    Procedure SetCellDef(cRow, ccoln: integer; sCellDef: String); //
    Procedure GetCellsWadth(HasDataNo: integer); //
    Procedure SetFileCellWidth(filename: String; 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 SetCellColor(NewTextColor, NewBackColor: COLORREF);

    Procedure SetCellDispFormt(mek: String);
    Procedure SetSelectedCellText(sText: String);

    Procedure SetCellFont(CellFont: TLOGFONT);
    Procedure SetCellAlign(NewHorzAlign, NewVertAlign: Integer);
    //设置当前选定所有单元格宽度2004-09-27
    Procedure SetCellsWidth(CellWidth: Integer);
    Procedure SetCellsHeight(CellHeight: Integer);

    Procedure SetCellTextColor(NewTextColor: COLORREF);
    Procedure SetCellAlignHorzAlign(NewHorzAlign: Integer);
    Procedure SetCellAlignNewVertAlign(NewVertAlign: Integer);
    Procedure SetCellBackColor(NewBackColor: COLORREF);

    Procedure SetMargin(nLeftMargin, nTopMargin, nRightMargin, nBottomMargin:
      Integer);
    Function GetMargin: TRect;

    Function getcellfont: tfont;

    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 TablePerPage: Integer Read FTablePerPage Write FTablePerPage Default
      2147483647;
  Published
    { Published declarations :boolean;}
    Property Left;
    Property Top;
    Property Cursor;
    Property DataLine: Integer Read FDataLine Write FDataLine Default 0;
    Property AddEmptyLine: Boolean Read FAddSpace Write FAddSpace Default false;
    Property AncientStyle: Boolean Read FAncientStyle Write FAncientStyle Default false;
    //是否套打
    Property PrintLine: Boolean Read FPrintLine Write FPrintLine Default true;

    Property Hint;
    Property Visible Default True;
    Property Enabled Default True;
    Property OnMouseMove;
    Property OnMouseDown;
    Property OnMouseUp;
    Property ShowHint;
    Property OnDragOver;