看看我的东西行不行！
unit GeneralReport;
interface
uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
StdCtrls, ExtCtrls, Forms, Quickrpt, QRCtrls, Db, DBTables, Dialogs, Printers,
ADODB;
type
TReport = class(TQuickRep)
GroupHeader: TQRGroup;
Detail: TQRBand;
Footer: TQRBand;
Summary: TQRBand;
PageHeader: TQRBand;
Data: TQuery;
procedure DataAfterOpen(DataSet: TDataSet);
procedure DetailBeforePrint(Sender: TQRCustomBand;
var PrintBand: Boolean);
private
Fwidth: array of Integer;
StartColumn: Integer;
FLeft: array of Integer;
GroupField: string;
GTop, PerWidth: Integer;
FwidthList: string;
procedure GetWidth(widthList: string);
// 根据指定的宽度来设定列宽!
procedure GetLeftAndWidth;
// 得到列左边和列宽的数据
procedure SetColumnTitle;
// 设定列标题
procedure SetColumn;
// 设定列对应的字段
procedure SetFooter;
procedure AddTitle;
// 设定小组统计的字段名
procedure SetSummary;
// 统计求和值
procedure AddHeadText;
//增加分组题头
procedure AddTotalText;
//添加统计字头
procedure AddPageCountAndDate;
// 添加页码和打印日期
public
procedure ReportPrintcommon(sql, title, widthlist, pGroupField:
string;
pagewidth, pageheigth, rowheigth, columnwidth, headheigth, topheigth:
Integer;
displayGroupField, DisplayDate, DetailDisplayGroupColumn, displayTotal,
displaySubTotal, NewGroupNewPage: Boolean);
end;
var
Report: TReport;
const
LeftM = 10;
const
Line = 5;
const
ColumnName = 'LColumName';
const
ExprDetail = 'ExprDetail';
const
ExprFooter = 'ExprFooter';
const
ExprSummary = 'ExprSummary';
const
QRDetail = 'QRDetail';
const
QRFooter = 'QRFooter';
const
QRGroup = 'QRGroup';
const
QRSummary = 'QRSummary';
procedure SetPageWidthLength(Width, Length: Integer);
// sourceSQL :sourceSQL of the report content ;
title :The title of the report
// pGroupField :the field Which the report Grouped by ;
WidthList :String of the width of each column
// firstColumn : print first Column ? ;
Headtext .....
// pWidth ,pLength : width and length of the page ;
ptop :the heigth of the top margin
// pperWidth :the comon width of columns ;
headerHeigth,detailHeigth : the heigth of detail and header Bands
// 通用报表过程
implementation
{$R *.DFM}
uses DataBaseSet;
procedure TReport.ReportPrintCommon(sql, title, widthlist, pGroupField: string;
pagewidth, pageheigth, rowheigth, columnwidth, headheigth, topheigth: Integer;
displayGroupField, DisplayDate, DetailDisplayGroupColumn, displayTotal,
displaySubTotal, NewGroupNewPage: Boolean);
var
pt: TQRLabel;
begin
try
SetPageWidthLength(pagewidth, pageheigth);
except
Application.MessageBox('设置打印机纸张不成功！', '提示信息', 0);
end;
FwidthList := WidthList;
GroupHeader.ForceNewPage := NewGroupNewPage;
ReportTitle := Title;
page.Width := pageWidth;
Page.Length := Pageheigth;
AddTitle;
GTop := TopHeigth;
PageHeader.Height := HeadHeigth;
perWidth := ColumnWidth;
detail.Height := RowHeigth;
report.GRoupField := pGroupField;
Footer.Enabled := displaysubtotal;
summary.Enabled := DisPlaytotal;
if Pos('+', GroupField) > 0 then
GRoupHeader.Expression :=
'Data.' + Copy(Groupfield, 1, Pos('+', GroupField) - 1) + '+ Data.' +
Copy(GroupField, Pos('+', GroupField) + 1, Length(Groupfield) - Pos('+',
GroupField))
else
GroupHeader.Expression := 'Data.' + GroupField;
if GroupField = '' then
Footer.Enabled := False;
FWidthList := WidthList;
if DetailDisplayGroupColumn then
StartColumn := 0
else
begin
if Pos('+', GroupField) > 0 then
StartColumn := 2
else
StartColumn := 1;
end;
Data.sql.Clear;
Data.sql.Text := SQL;
Data.DatabaseName := globalInfos.DatabaseName;
//Data.ConnectionString := GetConnectionString;
try
//if Data.ExecSQL >0 then
data.Open;
if (GRoupField <> '') and (displayGroupField) then
AddHeadText;
if displaySubTotal or displayTotal then
AddTotalText;
if DisplayDate then
AddPageCountAndDate;
pt := Findcomponent('LTitle') as TQRLabel;
pt.Caption := Title;
finally
end;
end;
procedure TReport.SetColumn;
var
i: Integer;
begin
if not data.Active then
Exit;
with detail.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRdetail + '00';
Shape := qrsRectangle;
Left := Fleft[0];
Top := 0;
Width := FLeft[Data.fieldcount] - fleft[0];
Height := Detail.Height;
end;
for i := startColumn to Data.FieldCount - 1do
begin
if (Data.Fields.DataType in
[ftCurrency, ftSmallint, ftInteger, ftWord, ftFloat]) then
with detail.AddPrintable(TQRExpr) as TQRExprdo
begin
Name := ExprDetail + IntToStr(i);
AutoSize := False;
Top := line;
Width := FWidth - 4;
Left := Fleft[i + 1] - Width - 5;
AlignMent := taRightJustify;
Expression := 'DATA.' + Data.Fields.FieldName;
Mask := '###,##0.00';
end
else
with detail.AddPrintable(TQRExpr) as TQRExprdo
begin
Name := ExprDetail + IntToStr(i);
AutoSize := True;
Top := line;
Left := Fleft + 8;
AlignMent := taLeftJustify;
if Pos('率', Data.Fields.FieldName) > 0 then
begin
AutoSize := False;
Top := line;
Width := FWidth - 4;
Left := Fleft[i + 1] - Width - 5;
AlignMent := taRightJustify;
end;
Expression := 'DATA.' + Data.Fields.FieldName;
end;
if i > startColumn then
with Detail.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRDetail + IntToStr(i);
Shape := qrsVertLine;
Left := Fleft - 30;
Top := 0;
Height := Detail.Height;
end;
end;
end;
procedure TReport.SetColumnTitle;
var
i: Integer;
begin
if not data.Active then
Exit;
with PageHeader.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRGroup + '00';
Shape := qrsRectangle;
Left := Fleft[0];
Top := GTop;
Width := FLeft[Data.fieldcount] - fleft[0];
Height := PageHeader.Height - Gtop;
end;
for i := startColumn to Data.FieldCount - 1do
begin
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := ColumnName + IntToStr(i);
Caption := Data.Fields.FieldName;
AutoSize := True;
Left := (Fleft + Fleft[i + 1]) div 2 - 3 * Length(Caption);
Top := GTop + line;
AlignMent := taleftJustify;
Caption := Data.Fields.FieldName;
end;
if i > startColumn then
with PageHeader.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRGroup + IntToStr(i);
Shape := qrsVertLine;
Left := Fleft - 30;
Top := GTop;
end;
end;
end;
procedure TReport.SetFooter;
var
i: Integer;
begin
if not data.Active then
Exit;
with Footer.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRFooter + '00';
Shape := qrsRectangle;
Left := Fleft[0];
Top := 0;
Width := FLeft[Data.fieldcount] - fleft[0];
Height := Footer.Height;
end;
for i := startColumn to Data.FieldCount - 1do
begin
if i > startColumn then
if (Data.Fields.DataType in
[ftCurrency, ftSmallint, ftInteger, ftWord, ftFloat]) then
with Footer.AddPrintable(TQRExpr) as TQRExprdo
begin
Name := ExprFooter + IntToStr(i);
AutoSize := False;
Width := FWidth - 7;
Left := Fleft + Line;
Top := line;
Left := Fleft[i + 1] - Width - 5;
AlignMent := taRightJustify;
ResetAfterPrint := True;
Expression := 'sum(Data.' + Data.Fields.FieldName + ')';
Mask := '###,##0.00';
if Pos('读数', Data.Fields.FieldName) > 0 then
begin
Expression := '';
Mask := '###,##0.0'
end;
end;
if i > startColumn then
with Footer.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRfooter + IntToStr(i);
Shape := qrsVertLine;
Left := Fleft - 30;
Top := 0;
Height := Footer.Height;
end;
end;
end;
procedure TReport.SetSummary;
var
i: Integer;
begin
if not data.Active then
Exit;
with summary.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRSummary + '00';
Shape := qrsRectangle;
Left := Fleft[0];
Top := 0;
Width := FLeft[Data.fieldcount] - fleft[0];
Height := summary.Height;
end;
for i := startColumn to Data.FieldCount - 1do
begin
if i > startColumn then
with summary.AddPrintable(TQRShape) as TQRShapedo
begin
Name := QRsummary + IntToStr(i);
Shape := qrsVertLine;
Left := Fleft - 30;
Top := 0;
Height := summary.Height;
end;
if i > startColumn then
if (Data.Fields.DataType in
[ftCurrency, ftSmallint, ftInteger, ftWord, ftFloat]) then
with summary.AddPrintable(TQRExpr) as TQRExprdo
begin
Name := ExprSummary + IntToStr(i);
AutoSize := False;
Width := FWidth - 9;
Left := Fleft + Line;
Top := line;
Left := Fleft[i + 1] - Width - 5;
AlignMent := taRightJustify;
Expression := 'Sum(Data.' + Data.Fields.FieldName + ')';
Mask := '###,##0.00';
if Pos('读数', Data.Fields.FieldName) > 0 then
begin
Expression := '';
Mask := '###,##0.0'
end;
end;
end;
end;
procedure TReport.GetLeftAndWidth;
var
i: Integer;
begin
if not Data.Active then
Exit;
setLength(FLeft, Data.FieldCount + 1);
SetLength(FWidth, Data.FieldCount + 1);
if FWidthList <> '' then
GetWidth(FWidthList);
if Pos('+', Groupfield) > 0 then
FLeft[0] := 0
else
FLeft[0] := LeftM;
for i := 0 to Data.FieldCount - 1do
begin
if FWidth = 0 then
FWidth := PerWidth;
end;
if StartColumn = 1 then
FLeft[1] := LeftM;
for i := startcolumn + 1 to Data.FieldCountdo
begin
FLeft := FLeft[i - 1] + FWidth[i - 1];
end;
end;
procedure TReport.DataAfterOpen(DataSet: TDataSet);
begin
GetLeftAndWidth;
SetColumntitle;
SetColumn;
SetFooter;
SetSummary;
end;
procedure Report_PaidCustom(sourceSQL, Title: string;
FirstColumn: Boolean);
begin
end;
procedure TReport.AddHeadText;
var
field1, Field2: string;
begin
if Pos('+', Groupfield) > 1 then
begin
field1 := Copy(Groupfield, 1, Pos('+', GroupField) - 1);
Field2 := Copy(GroupField, Pos('+', GroupField) + 1, Length(Groupfield) -
Pos('+', GroupField));
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'HeadText1';
AutoSize := False;
Caption := Field1 + '：';
Left := FLeft[2] + 20;
Width := PageHeader.Width;
Top := GTop - 25;
end;
with PageHeader.AddPrintable(TQRExpr) as TQRExprdo
begin
Name := 'HeadField1';
Expression := 'DATA.' + Field1;
Left := fleft[2] + 20 + 8 * Length(field1);
Top := GTop - 25;
end;
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'HeadText2';
AutoSize := False;
Caption := Field2 + '：';
Left := Fleft[3] + 30;
Width := PageHeader.Width;
Top := GTop - 25;
end;
with PageHeader.AddPrintable(TQRExpr) as TQRExprdo
begin
//pt := PageHeader.FindComponent('HeadText') as TQRLabel;
Name := 'HeadField2';
Expression := 'DATA.' + Field2;
Left := FLeft[3] + 30 + 9 * Length(field2);
Top := GTop - 25;
end;
end
else
begin
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'HeadText';
AutoSize := False;
Caption := GroupField + '：';
Left := 20;
Width := PageHeader.Width;
Top := GTop - 25;
end;
with PageHeader.AddPrintable(TQRExpr) as TQRExprdo
begin
//pt := PageHeader.FindComponent('HeadText') as TQRLabel;
Name := 'HeadField';
Expression := GroupHeader.Expression;
Left := FLeft[2];
Top := GTop - 25;
end;
end;
end;
procedure TReport.AddTotalText;
begin
with Summary.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'SummaryText';
Caption := '总计：';
Left := Fleft[2] - 35;
Top := line;
end;
with Footer.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'FooterText';
Caption := '小计：';
Left := Fleft[2] - 35;
Top := Line;
end;
end;
procedure Report_FeeList(sourceSQL, Title: string;
firstColumn: Boolean);
begin
end;
procedure TReport.AddPageCountAndDate;
var
textLeftpos: Integer;
begin
textLeftpos := Report.Width - 300;
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'printDate';
Caption := '打印日期：';
Left := textLeftpos - 50;
Top := Gtop - 25;
end;
with PageHeader.AddPrintable(TQRSysData) as TQRSysDatado
begin
Name := 'QRSysDataPrintDate';
Data := qrsDate;
Left := textLeftpos + 10;
Top := Gtop - 25;
end;
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'PageText1';
Caption := '第';
Left := textLeftpos + 75;
Top := Gtop - 25;
end;
with PageHeader.AddPrintable(TQRSysData) as TQRSysDatado
begin
Name := 'QRsysdataPage';
Data := qrsPageNumber;
Left := textLeftpos + 90;
Top := Gtop - 25;
end;
with PageHeader.AddPrintable(TQRLabel) as TQRLabeldo
begin
Name := 'PageText2';
Caption := '页';
Left := textLeftpos + 110;
Top := Gtop - 25;
end;
end;
procedure TReport.GetWidth(widthList: string);
var
str: string;
FEverywidth, i: Integer;
begin
str := WidthList;
i := 0;
while not (trim(str) = '')do
begin
Feverywidth := StrtoInt(trim(Copy(str, 1, Pos('/', str) - 1)));
Fwidth := FEveryWidth;
str := trim(Copy(str, Pos('/', str) + 1, Length(str) - Pos('/', str)));
i := i + 1;
end;
end;
procedure SetPageWidthLength(Width, Length: Integer);
var
aDevice: array[0..CCHDEVICENAME - 1] of char;
aDriver: array[0..MAX_PATH - 1] of char;
aPort: array[0..31] of char;
hDevMode: THandle;
pDevMode: PDeviceMode;
printer: Tprinter;
begin
// 获取打印机DeviceMode的句柄
printer := Tprinter.Create();
Printer.GetPrinter(aDevice, aDriver, aPort, hDevMode);
if hDevMode <> 0 then
begin
// 获取指向DeviceMode的指针
pDevMode := GlobalLock(hDevMode);
if pDevMode <> nil then
begin
pDevMode^.dmFields := pDevMode^.dmFields or DM_PAPERLENGTH;
pDevMode^.dmPaperWidth := Length;
pDevMode^.dmFields := pDevMode^.dmFields or DM_PAPERWIDTH;
pDevMode^.dmPaperLength := Width;
pDevMode^.dmFields := pDevMode^.dmFields or DM_PAPERSIZE;
pDevMode^.dmPaperSize := DMPAPER_USER;
ResetDC(Printer.Handle, pDevMode^);
GlobalUnlock(hDevMode);
end;
end;
printer.Free;
end;
procedure TReport.AddTitle;
var
la: TQRLabel;
begin
la := PageHeader.AddPrintable(TQRLabel) as TQRLabel;
with lado
begin
Name := 'LTitle';
Font.Name := '宋体';
Font.Size := 14;
AutoSize := False;
Left := 0;
AlignMent := taCenter;
la.Width := PageHeader.Width - 10;
Top := GTop - 5;
end;
la := nil;
end;
procedure TReport.DetailBeforePrint(Sender: TQRCustomBand;
var PrintBand: Boolean);
var
i: Integer;
AField: TField;
begin
with Detaildo
begin
for i := 0 to ControlCount - 1do
begin
if (Controls is TQRDBText) then
begin
AField := (Controls as TQRDBText).DataSet.FieldByName(
(Controls as TQRDBText).DataField);
if (AField is TFloatField) or (AField is TCurrencyField) then
if AField.asFloat = 0 then
(Controls as TQRDBText).Enabled := False
else
(Controls as TQRDBText).Enabled := True;
end;
if Controls is TQRExpr then
begin
AField := Data.FieldByName(Copy((Controls as TQRExpr).Expression, 6,
Length((Controls as TQRExpr).Expression) - 5));
if AField.dataType in [ftFloat, ftCurrency, ftInteger] then
if (Controls as TQRExpr).Value.dblResult = 0 then
(Controls as TQRExpr).Enabled := False
else
(Controls as TQRExpr).Enabled := True;
end;
end;
end;
end;
end.
