用Delphi的QuickReport动态制作--流水式报表
谁做过？ 问题点数：100、回复次数：6Top
1 楼wzsswz（岌岌荆棘）回复于 2002-06-16 10:59:05 得分 95
参靠 Demos\QuickRptTop
2 楼wzsswz（岌岌荆棘）回复于 2002-06-16 11:16:54 得分 0
unit RPT_main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, Grids, DBGrids, DBTables, Db, ExtCtrls, StdCtrls,
quickrpt, qrextra, qrprntr, qrctrls, ToolWin, ComCtrls, Buttons, Menus;
type
TRPT_Form = class(TForm)
Panel1: TPanel;ToolBar1: TToolBar;DBNavigator1: TDBNavigator;
Panel3: TPanel;Panel5: TPanel;Panel6: TPanel;Panel4: TPanel;Panel7: TPanel;
Label1: TLabel; ListBoxFields: TListBox;
bn_exit: TSpeedButton; PopupMenu1: TPopupMenu;N1: TMenuItem;
BitBtn1: TBitBtn;btnPreview1: TSpeedButton;Btn_prior: TSpeedButton;
Btn_next: TSpeedButton;SpeedButton1: TSpeedButton;SpeedButton2: TSpeedButton;
Lb_sum: TListBox;Lb_group: TListBox;
Query1: TQuery; DataSource1: TDataSource;
Splitter1: TSplitter;Splitter2: TSplitter;
Splitter3: TSplitter; Panel2: TPanel;
Dg1: TDBGrid;Query1OrderNo: TFloatField;
Query1CustNo: TFloatField;
Query1SaleDate: TDateTimeField;
Query1ShipDate: TDateTimeField;
Query1ShipVIA: TStringField;
Query1Terms: TStringField;
Query1PaymentMethod: TStringField;
Query1ItemsTotal: TCurrencyField;
Query1TaxRate: TFloatField;
Query1Freight: TCurrencyField;
Query1AmountPaid: TCurrencyField;
Query1lxxmDl4: TDBGrid;
Query1xmP: TDBGrid;
cBoxGroupByContininent: TCheckBox;
cBox_sum: TCheckBox;
rbAllFields: TRadioButton;
rbSelectFields: TRadioButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
procedure btnPreviewClick(Sender: TObject);
procedure rbAllFieldsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Dg1ColumnMoved(Sender: TObject; FromIndex,ToIndex: Integer);
procedure N1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure bn_exitClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Btn_priorClick(Sender: TObject);
procedure Btn_nextClick(Sender: TObject);
procedure set_next(var mylist: Tlistbox);
procedure set_prior(var mylist: Tlistbox);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
RPT_Form: TRPT_Form;
implementation
{$R *.DFM}
var
pass_query :Tquery;
pass_ds:TDatasource;
mysql:string;
function dup(aChar : Char; Count : integer) : string;
var
I : integer;
begin
result := '';
for I := 1 to Count do result := result + aChar;
end;
procedure TRPT_Form.FormCreate(Sender: TObject);
var
nIdx: integer;
begin
pass_query:= query1;
pass_ds:=DataSource1;
pass_query.Open;
mysql:=pass_query.SQL.GetText;
with pass_query,ListBoxFields,lb_group do
for nIdx := 0 to FieldCount - 1 do
begin
ListBoxFields.Items.Add(Fields[nIdx].DisplayName);
lb_group.Items.Add(Fields[nIdx].DisplayName);
end;
rbAllFieldsClick(rbAllFields);
lb_sum.Clear;
with lb_sum,pass_query do
begin
for nIdx:=0 to FieldCount -1 do
if (fields[nIdx].DataType = ftFloat) or(fields[nIdx].DataType = ftcurrency) then
Items.Add(Fields[nIdx].DisplayName);
end;
end;
procedure TRPT_Form.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
pass_query.Close;
end;
procedure TRPT_Form.rbAllFieldsClick(Sender: TObject);
begin
rbAllFields.OnClick := nil;
rbSelectFields.OnClick := rbAllFields.OnClick;
if Sender = rbAllFields then
begin
rbSelectFields.Checked := not rbAllFields.Checked;
ListBoxFields.Font.Color:=clblack;
end
else
begin
rbAllFields.Checked := not rbSelectFields.Checked;
ListBoxFields.Font.Color:=clblue;
end;
rbAllFields.OnClick := rbAllFieldsClick;
rbSelectFields.OnClick := rbAllFields.OnClick;
ListBoxFields.Enabled := rbSelectFields.Checked;
end;
procedure TRPT_Form.Btn_priorClick(Sender: TObject);
begin
set_prior(lb_group);
end;
procedure TRPT_Form.Btn_nextClick(Sender: TObject);
begin
set_next(lb_group);
end;
procedure TRPT_Form.SpeedButton1Click(Sender: TObject);
begin
set_prior(lb_sum);
end;
procedure TRPT_Form.SpeedButton2Click(Sender: TObject);
begin
set_next(lb_sum);
end;
procedure TRPT_Form.SpeedButton3Click(Sender: TObject);
begin
set_prior(ListBoxFields);
end;
procedure TRPT_Form.SpeedButton4Click(Sender: TObject);
begin
set_next(ListBoxFields);
end;
procedure TRPT_Form.set_prior(var mylist: Tlistbox);
var
ii: integer;
my_item:string;
begin
with mylist do
for ii := 0 to Items.Count - 1 do
begin
if (Selected[ii]) and (ii <> 0) then
begin
my_item:=items[ii];
items.Delete(ii);
items.Insert(ii-1,my_item);
Selected[ii-1]:=true;
end;
end;
end;
procedure TRPT_Form.set_next(var mylist: Tlistbox);
var
i: integer;
my_item:string;
begin
with mylist do
for i := Items.Count-1 downto 0 do
begin
if (Selected[i]) and (i <> Items.Count-1) then
begin
my_item:=items[i];
items.Delete(i);
items.Insert(i+1,my_item);
Selected[i+1]:=true;
end;
end;
end;
procedure TRPT_Form.BitBtn1Click(Sender: TObject);
var
i:integer;
begin
pass_query.Close;
for i:= 0 to pass_query.FieldCount - 1 do
pass_query.Fields[i].Visible:=true;
pass_query.Open;
ListBoxFields.Clear;
with Dg1,ListBoxFields do
for i := 0 to FieldCount - 1 do
ListBoxFields.Items.Add(Fields[i].DisplayName);
rbAllFieldsClick(rbAllFields);
end;
procedure TRPT_Form.bn_exitClick(Sender: TObject);
begin
close;
end;
procedure TRPT_Form.Dg1ColumnMoved(Sender: TObject; FromIndex,
ToIndex: Integer);
var
nIdx: integer;
begin
ListBoxFields.Clear;
with Dg1,ListBoxFields do
for nIdx := 0 to FieldCount - 1 do
Items.Add(Fields[nIdx].DisplayName);
rbAllFieldsClick(rbAllFields);
end;
procedure TRPT_Form.N1Click(Sender: TObject);
var
nIdx:integer;
begin
with dg1 do
begin
dg1.SelectedField.Visible:=false;
ListBoxFields.Clear;
with Dg1,ListBoxFields do
for nIdx := 0 to FieldCount - 1 do
Items.Add(Fields[nIdx].DisplayName);
rbAllFieldsClick(rbAllFields);
end;
end;Top
3 楼wzsswz（岌岌荆棘）回复于 2002-06-16 11:25:36 得分 0
//下面是控制部分：
procedure TRPT_Form.btnPreviewClick(Sender: TObject);
var
fieldname, sum_field,group_field,order_field,headtitle:string;
aReport: Tcustomquickrep;
QRGp: array of TQRGroup;
QRDBTxt: array of TQRDBText;
QRGroupFooter: TQRBand;
QRGroupheader: TQRband;
QRLbHeader:TQrLabel;
FieldList: TStringList;
mm, i, nIdx, j,k: integer;
sum_name: array of TQRExpr;
Sum_Group: TQRExpr;
begin
FieldList := nil;
QRGroupFooter := nil;
Sum_Group := nil;
headtitle:=caption;
with ListBoxFields do
if Enabled then
begin
FieldList := TStringList.Create;
for nIdx := 0 to Items.Count - 1 do
if Selected[nIdx] then
begin
for i :=0 to pass_query.FieldCount-1 do
begin
if pass_query.Fields[i].DisplayName = Items[nIdx] then
fieldname:=pass_query.Fields[i].FieldName;
end;
FieldList.Add(fieldname);
end;
end;
aReport := nil;
QRCreateList(aReport,self, pass_query, '', FieldList);
aReport.Font.Name:='宋体';
aReport.Font.Size:=9;
QRGroupheader := TQRband.Create(Self); //标题属性 标题来自 CAPTION
with QRGroupheader do
begin
Parent := areport;
top:=0;
height := 60;
QRGroupheader.BandType:= rbPageHeader;
end;
QRLbHeader := TQRLabel.Create(Self);//用TQRLabel显示标题
with QRLbHeader do
begin
Parent:= QRGroupheader;
left:= round(QRGroupheader.width/4);
caption:=headtitle;
font.Name:='宋体';
font.Size:=16;
Font.Style := [fsBold];
Top := Parent.Height - height-38;
end;
if cBoxGroupByContininent.Checked then
begin
with pass_query,lb_group do//设置 TQRDBText 属性
begin
setlength(QRDBTxt,Items.Count);
setlength(QRGp,Items.Count);
if lb_group.Enabled then
begin
order_field := '';
k:=0;
for mm := 0 to Items.Count - 1 do
begin
if Selected[mm] then
begin
for i :=0 to pass_query.FieldCount-1 do
if pass_query.Fields[i].DisplayName = Items[mm] then
begin
group_field := pass_query.Fields[i].FieldName;
k := k+1;
end;
close;
if k = 1 then
begin
order_field:=order_field+group_field;
sql.Add(' order by '+ order_field );
end
else
begin
order_field:=','+group_field;
sql.Add(order_field ) ;
end;
open;
QRGp[mm] := TQRGroup.Create(Self);
with QRGp[mm] do
begin
Parent := areport;
Master := Parent; // 设置 detail band
Expression := group_field;
end;
QRDBTxt[mm] := TQRDBText.Create(Self);
with QRDBTxt[mm] do
begin
Parent:= QRGp[mm];
Dataset := pass_query;
DataField := group_field;
Font.Style := [fsItalic, fsBold];
Top := Parent.Height - Height;
end; //设置 FooterBand 属性
QRGroupFooter := TQRBand.Create(Self);//create a group
with QRGroupFooter do
begin
Parent := areport;
BandType := rbGroupFooter;
end;
QRGp[mm].FooterBand := QRGroupFooter;
end;
end;
end;
end;
end;
Top
4 楼pick2103（快乐天天）回复于 2002-06-16 11:29:17 得分 0
怎么这么长啊 呵呵Top
5 楼pick2103（快乐天天）回复于 2002-06-16 11:30:44 得分 5
看看Top
6 楼wzsswz（岌岌荆棘）回复于 2002-06-16 11:32:00 得分 0
if cBox_sum.Checked then
begin
with aReport do
begin
Bands.HasSummary := True; // 增加 summary band
Bands.SummaryBand.Height := round(Bands.SummaryBand.Height * 1.5);
with lb_sum do
if Enabled then
begin
j:=0;
for mm := 0 to Items.Count - 1 do
begin
if Selected[mm] then
begin
for i :=0 to pass_query.FieldCount-1 do
begin
if pass_query.Fields[i].DisplayName = Items[mm] then
begin
sum_field:=pass_query.Fields[i].FieldName;
setlength(sum_name,Items.Count);
sum_name[mm] := TQRExpr(Bands.SummaryBand.AddPrintable(TQRExpr));
sum_name[mm].Caption:=Items[mm];
with sum_name[mm] do
begin
AutoSize := false;
with TQRLabel(Bands.SummaryBand.AddPrintable(TQRLabel)) do
begin
Parent := Bands.SummaryBand;
Top := 20; //从SummaryBand中取出TQRLabel的宽度
AutoSize := true;
Caption := Dup('X', pass_query.fieldbyname(sum_field).DisplayWidth);
AutoSize := false;
sum_name[mm].Width := Width;
AutoSize := True;
Caption := '合计'+Items[mm];//（合计字段）
Font.Style := [fsBold];
Frame.DrawBottom := true;
if sum_name[mm].Width < Width then//调整TQrexpr字段宽度
sum_name[mm].Width := Width
else
begin
AutoSize := false;
Width := sum_name[mm].Width;
end;
sum_name[mm].Top := Top + Height + 4;
Left := round((sum_name[mm].Width + 24)*j*0.4);
sum_name[mm].Left :=left;
end; //给 TQrexpr字段的Alignment属性 赋值
Alignment := taLeftJustify;
Expression := 'sum('+sum_field+')';
Mask := '#0.00,'; //确定小数尾数。
end;
if QRGroupFooter <> nil then // sum on group footer
begin
Sum_Group := TQRExpr(QRGroupFooter.AddPrintable(TQRExpr));
with Sum_Group do
begin
AutoSize := false;
Width := sum_name[mm].Width;
with TQRLabel(QRGroupFooter.AddPrintable(TQRLabel)) do
begin
Parent := QRGroupFooter;
Top := 4;
AutoSize := True;
Caption := '小计'+Items[mm];
Font.Style := [fsBold];
Frame.DrawBottom := true;
if Sum_Group.Width < Width then
Sum_Group.Width := Width
else
begin
AutoSize := false;
Width := Sum_Group.Width;
end;
Sum_Group.Top := Top + Height + 4;
left := sum_name[mm].Left;
end;
left := sum_name[mm].Left;
Alignment := sum_name[mm].Alignment;
Expression := sum_name[mm].Expression;
Mask := sum_name[mm].Mask;
ResetAfterPrint := True;
end;
end;
end;
end;
j:=j+2;
end;
end;
end;
end;
end;
with areport.bands.detailband do
for nIdx := 0 to ControlCount - 1 do
if Controls[nIdx] is TQRExpr then
with TQRExpr(Controls[nIdx]) do
if Alignment = taRightJustify then
Mask := '#0.00,'; //确定小数尾数。
aReport.Preview;
aReport.Free;
if FieldList <> nil then //释放内存
FieldList.Free;
//恢复SQL原始状态
with pass_query do
begin
close;
sql.Clear;
sql.Add(mysql);
open;
end;
end;
end.
Top
7 楼wsgy（炮弹）回复于 2002-06-16 11:36:48 得分 0
wzsswz:
代码太长了！不过我研究研究，先谢了！Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
