?? crctrls.pas
字號:
//ReportControl.pas
{*************************************************/
* 表格式報表處理系統 of DELPHI
* 簡稱:CReport
* 原創:郭家駿、王寒松
* 優化(Ver 4.02):宋科(Godman)
* 優化內容:
1、增加對流的支持
2、將生成臨時文件改為用內存流
3、優化了一些代碼,更OO
4、將部分全局變量改為類域
5、修改了因為找不到數據集或字段而報錯
6、整理了代碼的縮進
7、整理了代碼的一些大小寫
大家修改后最好是發布到Internet,這樣大家共同完善,保護了別人的努力也同時
保護了自已的努力。
請將修改后的源碼發我一份:Godman138@163.com
宋科(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 CRCtrls;
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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -