⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 reportcontrol.~pa

📁 国产的报表控件
💻 ~PA
📖 第 1 页 / 共 5 页
字号:
{************************************
*  表格式报表处理系统 of  DELPHI    *
*  China Report system of DELPHI    *
*  简称:CReport V3.0               *
*  原创:郭家骏、王寒松             *
*  修改:廖伯志                     *
*  修改:赵慧诚,本人水平有限(大部   *
*  分看不懂),只能增加行号和子行号;*
*  LineNum行号,SubLineNum子行号(每个*
*  子表行号)                        *
*  最后修改日期:1999.11.22         *
*************************************}
unit ReportControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, Math, Printers, Menus, Db, FileCtrl;

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;

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

    // 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
    { Private declarations }
    FPreviewStatus: Boolean;

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

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

    FLeftMargin: Integer;
    FRightMargin: Integer;
    FTopMargin: Integer;
    FBottomMargin: Integer;

    FcellFont: TlogFont;
    FcellFont_d: TlogFont;
    FLeftMargin1: Integer;
    FRightMargin1: Integer;
    FTopMargin1: Integer;
    FBottomMargin1: Integer;

    // 换页加表头(不加表头)
    FNewTable: Boolean;

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

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

    // 编辑、颜色及字体
    FEditWnd: HWND;
    FEditBrush: HBRUSH;
    FEditFont: HFONT;

    //    FReportMenu : TPopupMenu;
  protected
    { Protected declarations }
    procedure CreateWnd; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveToFile(FileName: string);
    procedure LoadFromFile(FileName: string);
    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 NewTable(ColNumber, RowNumber: Integer);

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

    procedure InsertCell;
    procedure DeleteCell;
    procedure AddCell;

    procedure CombineCell;

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

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

    procedure SetCellDiagonal(NewDiagonal: UINT);
    procedure SetCellColor(NewTextColor, NewBackColor: COLORREF);
    procedure SetCellFont(CellFont: TLOGFONT);
    procedure SetCellAlign(NewHorzAlign, NewVertAlign: Integer);

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

    function getcellfont:tfont; // add wang hang song

    procedure UpdateLines;

    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;
    property TablePerPage: Integer read FTablePerPage write FTablePerPage default 2147483647;

  published
    { Published declarations }
    property Left;
    property Top;
    property Cursor;
    property Hint;
    property Visible default True;
    property Enabled default True;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property ShowHint;
  end;

  TDatasetItem = class(TObject)
    pDataset: TDataset;
    strName: string;
  end;

  TVarTableItem = class(TObject)
    strVarName: string;
    strVarValue: string;
  end;

  TMyRect = class(TObject)
  public
    Left: Integer;
    Top: Integer;
    Right: Integer;
    Bottom: Integer;
  end;

  TReportRunTime = class(TComponent)
  private
    FFileName: TFileName;
    FAutoGroup : Boolean;
    FEnableEdit : Boolean;
    FDList: TList; // 保存数据集的指针和名称的对照
    FVarList: TList; // 保存变量的名字和值的对照表
    FLineList: TList; // 保存报表的设计信息(从文件中读入)
    FPrintLineList: TList; //保存要打印的某一页的行信息
    FOwnerCellList: TList; // 保存每一页中合并后单元格前后的指针

    Width: Integer;
    Height: Integer;

    // 定义换页加表头
    FNewTable: Boolean;

    //定义行号
    FLineNum:Integer;
    FSubLineNum:Integer;

    //定义从表数据叶好
    FSubPageNum:Integer;

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

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

    FHeaderHeight: Integer;

    Fallprint: Boolean; //是否打印全部记录,默认为全部

    FLeftMargin: Integer;
    FRightMargin: Integer;
    FTopMargin: Integer;
    FBottomMargin: Integer;

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

    FPageCount: Integer; // page count in print preview

    procedure UpdateLines;
    procedure UpdatePrintLines;
    procedure PrintOnePage;
    procedure LoadRptFile;
    function GetDatasetName(strCellText: string): string;
    function GetDataset(strCellText: string): TDataset;
    function DatasetByName(strDatasetName: string): TDataset;
    function GetVarValue(strVarName: string): string;
    function GetFieldName(strCellText: string): string;
    procedure SetRptFileName(const Value: TFileName);
    procedure SaveTempFile(PageNumber: Integer);
    procedure LoadTempFile(strFileName: string);
    procedure DeleteAllTempFiles;
    procedure SetAutoGroup(Value : Boolean);
    procedure SetEnableEdit(Value : Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetDataset(strDatasetName: string; pDataSet: TDataSet);
    procedure SetVarValue(strVarName, strVarValue: string);
    property allprint: boolean read Fallprint write Fallprint default true;
    procedure ResetContent;
    procedure PrintPreview(bPreviewMode: Boolean);
    procedure PreparePrint;
    procedure loadfile(value: tfilename);
    procedure Print;
    procedure Resetself;
    Function Cancelprint:boolean;
  published
    property ReportFile: TFileName read FFileName write SetRptFileName;
    property AutoGroup:boolean Read Fautogroup Write setautogroup Default True;
    property EnableEdit:boolean Read FEnableEdit Write setEnableEdit;
  end;

  TCellTable = class(TObject)
    PrevCell: TReportCell;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -