功能复杂DBGrid转到QuickReport打印//zswang

unit DBGQRUnit;interfaceuses
  Windows, SysUtils, Messages, Classes, Graphics, Controls, Math,
  QuickRpt, Qrctrls, ExtCtrls, StdCtrls, DBGrids, Db, DBTables, Dialogs, Forms;type
  TQuickReportDBGQR = class(TQuickRep)
    QRBandHead: TQRBand;
    QRBandTitle: TQRBand;
    QRBandDetail: TQRBand;
    QRBandSummary: TQRBand;
    QRBand1: TQRBand;
    QRSysData1: TQRSysData;
    QRLabel1: TQRLabel;
    QRLabel2: TQRLabel;
    procedure QRDBTextPrint(Sender: TObject; var Value: String);
    procedure QuickRepStartPage(Sender: TCustomQuickRep);
  private
    FQRCaption: TQRLabel; //报表标题
    FQRHead: TQRLabel; //表头
    FQRTrail: TQRLabel; //表尾
    FCaption: TLabel; //标题标签
    FHead: TLabel; //标题标签
    FTrail: TLabel; //表尾标签
    FDBGrid: TDBGrid; //报表相对网格
    FListCount: Integer; //报表列数
    FDataSet: TDataSet; //报表数据源
    FQRLabelList: array of TQRLabel; //报表标题列表
    FQRDBTextList: array of TQRDBText; //报表文本列表
    FQRShape: array of TQRShape; //报表图形列表
    FQRLabel: array of TQRLabel; //报表标签列表
    FColunmPos: Integer; //报表当前列位置
    FQRLabelHeight: Integer; //最大标签高度
    FDBGridWidth: Integer; //宽度
    FTempS: string; //临时字符串
    FTempW, FTempL: array of Integer; //临时宽度、左界列表
    FPlane: Integer; //记忆程度(栏数)
    FFloor: Integer; //程度
    FBool: Boolean; //是否可以正常显示
    FVert: Boolean; //是否加左右边线
    FColumns: Integer; //列数
    FColumnSpace: Integer; //列距
    FReplaceCaption: string; //将被替换的标题
    FReplaceHead: string; //将被替换的表头
    FReplaceTrail: string; //将被替换的表尾
    procedure ListAdd(mColunm: TColumn); { 网格列转换成报表列 }
    procedure SetGrid; { 设置网格属性 }
    procedure SetDBGrid(const Value: TDBGrid);
    procedure SetVert(const Value: Boolean);
    procedure ReplaceStr(var nStr: string); { 替换字符串 }
  public
    property RDataSet: TDataSet read FDataSet write FDataSet;
    property RDBGrid: TDBGrid read FDBGrid write SetDBGrid;
    property RCaption: TLabel read FCaption write FCaption;
    property RHead: TLabel read FHead write FHead;
    property RTrail: TLabel read FTrail write FTrail;
    property RVert: Boolean read FVert write SetVert;
  public
    procedure DataInit; { 数据初始化 }
    procedure DataFain; { 数据终止化 }
  end;function DoQuickReportDBGQR(mDBGrid: TDBGrid;
  mCaption, mHead, mTrail: TLabel; mTitle: string = ''; mVert: Boolean = True
  ): Boolean; { 将数据网格转换成报表 }implementationconst
  cColunmPos = 2;
  cFormatDateCn      = 'yyyy''年''mm''月''dd''日''';  //中文日期格式
  cFormatTimeCn      = 'hh''时''nn''分''ss''秒''';    //中文时间格式type
  TPaperSize = record
    rCode: Integer;
    rName: string;
  end;const
  cPaperSizeCount = 28;
  cPaperSizeList: array[0 .. Pred(cPaperSizeCount)] of TPaperSize =
(
(rCode: 08; rName: 'A3')            {00},//A3=8
(rCode: 09; rName: 'A4')            {01},//A4=9
(rCode: 10; rName: 'A4Small')       {02},//A4Small=10
(rCode: 11; rName: 'A5')            {03},//A5=11
(rCode: 12; rName: 'B4')            {04},//B4=12
(rCode: 13; rName: 'B5')            {05},//B5=13
(rCode: 24; rName: 'CSheet')        {06},//CSheet=24
(rCode: 27; rName: 'Custom')        {07},//Custom=27
(rCode: 09; rName: 'Default')       {08},//Default=0 //rCode: 00;
(rCode: 25; rName: 'DSheet')        {09},//DSheet=25
(rCode: 20; rName: 'Env10')         {10},//Env10=20
(rCode: 21; rName: 'Env11')         {11},//Env11=21
(rCode: 22; rName: 'Env12')         {12},//Env12=22
(rCode: 23; rName: 'Env14')         {13},//Env14=23
(rCode: 19; rName: 'Env9')          {14},//Env9=19
(rCode: 26; rName: 'ESheet')        {15},//ESheet=26
(rCode: 07; rName: 'Executive')     {16},//Executive=7
(rCode: 14; rName: 'Folio')         {17},//Folio=14
(rCode: 04; rName: 'Ledger')        {18},//Ledger=4
(rCode: 05; rName: 'Legal')         {19},//Legal=5
(rCode: 01; rName: 'Letter')        {20},//Letter=1
(rCode: 02; rName: 'LetterSmall')   {21},//LetterSmall=2
(rCode: 18; rName: 'Note')          {22},//Note=18
(rCode: 16; rName: 'qr10X14')       {23},//qr10X14=16
(rCode: 17; rName: 'qr11X17')       {24},//qr11X17=17
(rCode: 15; rName: 'Quarto')        {25},//Quarto=15
(rCode: 06; rName: 'Statement')     {26},//Statement=6
(rCode: 03; rName: 'Tabloid')       {27} //Tabloid=3
);type
  THeightWidth = record                           //长宽类型
    rHeight: Integer;                             //长
    rWidth: Integer;                              //宽
  end; { record[THeightWidth] }{$R *.DFM}function FormParent(mControl: TControl): TForm; { 寻找控件的窗体父亲 }
begin
  Result := nil;
  while Assigned(mControl.Parent) do if mControl.Parent is TForm then begin
    Result := TForm(mControl.Parent);
    Break;
  end else mControl := mControl.Parent;
end; { FormParent }function ZsIif(mBool: Boolean; mDataA: Variant; mDataB: Variant): Variant;
begin
  if mBool then
    Result := mDataA
  else
    Result := mDataB;
end; { ZsIif }function ZsTogo(mStr: string; mSetChar: TSysCharSet; mCount: Integer = 1;
  mLeft: Boolean = True): string; { 取字串直到mSetChar在mStr中出现mCount次开始 }
var
  I, J, K, L: Integer;
begin
  Result := '';
  K := 0;
  L := Length(mStr);
  for I := 1 to L do begin
    J := ZsIif(mLeft, I, Succ(L - I));
    if K >= mCount then Result :=
      ZsIif(mLeft, '', mStr[J]) + Result + ZsIif(mLeft, mStr[J], '');
    if mStr[J] in mSetChar then Inc(K);
  end;
end; { ZsTogo }function ZsGoto(mStr: string; mSetChar: TSysCharSet; mCount: Integer = 1;
  mLeft: Boolean = True): string; { 取字串直到mSetChar在mStr中出现mCount次结束 }
var
  I, J, K, L: Integer;
begin
  Result := '';
  K := 0;
  L := Length(mStr);
  for I := 1 to L do
  begin
    J := ZsIif(mLeft, I, Succ(L - I));
    if mStr[J] in mSetChar then Inc(K);
    if K >= mCount then Break;
    Result :=
      ZsIif(mLeft, '', mStr[J]) + Result + ZsIif(mLeft, mStr[J], '');
  end;
end; { ZsGoto }function ZsPaperSizeNameToCode(mName: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Pred(cPaperSizeCount) do
    if UpperCase(cPaperSizeList[I].rName) = UpperCase(mName) then begin
      Result := cPaperSizeList[I].rCode;
      Exit;
    end;
end; { ZsPaperSizeNameToCode }function ZsDown(s: string): string; { 返回反向字符串 }
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(s) do
    Result := Concat(s[I], Result);
end; { ZsDown }function ZsApart(s: string; cs: TSysCharSet; var lStr, rStr: string;
  IsLeft: Boolean = True): Char; { 获取以字符集cs为分界的字符串 }
var
  I: Integer;
  Hxm: Boolean;
  vlStr, vrStr: string;
begin
  Result := #0;
  Hxm := True;
  if not IsLeft then
    s := ZsDown(s);
  vlStr := '';
  vrStr := '';
  for I := 1 to Length(s) do
    if Hxm then
      if s[I] in cs then
      begin
        Hxm := False;
        Result := s[I]
      end
      else
        vlStr := Concat(vlStr, s[I])
    else
      vrStr := Concat(vrStr, s[I]);
  if IsLeft then
  begin
    lStr := vlStr;
    rStr := vrStr;
  end
  else
  begin
    rStr := ZsDown(vlStr);
    lStr := ZsDown(vrStr);
  end;
end; { ZsApart }function ZsCount(s: string; cs: TSysCharSet): Integer;
{ 返回字符集在s中出现的次数 }
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(s) do
    if s[I] in cs then
      Inc(Result);
end; { ZsCount }function ZsMa(x, vMin, vMax: Integer): Boolean; overload;
{ 返回整型参数x是否在指定范围内 }
begin
  Result := (vMin <= x) and (x <= vMax);
end; { ZsMa }function ZsAlign(mSelfWidth, mLeft, mWidth: Integer; //容器右,自身宽度,容器宽度
  mAlignment: TAlignment): Integer; { 反回对齐后的左边界 }
  // 对齐方式
begin
  Result := 0;
  case mAlignment of
    taLeftJustify: Result := mLeft; // 左对齐
    taRightJustify: Result := mWidth - mSelfWidth + mLeft; // 右对齐
    taCenter: Result := (mWidth - mSelfWidth) div 2;  //居中
  end;
end; { ZsAlign }function ZsTextFontHeightWidth(mCanvas: TCanvas; mText: string): THeightWidth;
{ 返回指定字体的文本对应的长宽 }
begin
  with mCanvas do begin
    Result.rHeight := TextHeight(mText);
    Result.rWidth := TextWidth(mText);
  end;
end; { ZsTextFontHeightWidth }function ZsTextFontWidth(mCanvas: TCanvas; mText: string): Integer;
{ 返回指定字体的文本对应的宽 }
begin
  Result := ZsTextFontHeightWidth(mCanvas, mText).rWidth;
end; { ZsTextFontWidth }function ZsTextFontHeight(mCanvas: TCanvas; mText: string): Integer;
{ 返回指定字体的文本对应的长 }
begin
  Result := ZsTextFontHeightWidth(mCanvas, mText).rHeight;
end; { ZsTextFontHeight }function DoQuickReportDBGQR(mDBGrid: TDBGrid;
  mCaption, mHead, mTrail: TLabel; mTitle: string = ''; mVert: Boolean = True
  ): Boolean; { 将数据网格转换成报表 }
var
  V: Variant;
  I: Integer;
//  vColumns, vColumnSpace: Integer;
  vForm: TForm;
//  vMargin: TRect;
//  vOrientation: Boolean;
  vStr: string;
begin
  Result := Assigned(mDBGrid) and Assigned(mDBGrid.DataSource.DataSet) and
    (mDBGrid.DataSource.DataSet.Active);
  if not Result then Exit;
  vStr := FormParent(mDBGrid).Caption; //得到网格所在窗体的标题
//  Result := DoFormSelectPrintField(mDBGrid, vStr);
  if not Result then Exit;  vForm := TForm.Create(nil);
  vForm.Hide;
  with TQuickReportDBGQR.Create(Application) do try
    Parent := vForm;
    RVert := mVert;
    ReportTitle := '打印' + mTitle;
    RCaption := mCaption;
    RHead := mHead;
    RTrail := mTrail;
    RDBGrid := mDBGrid;
    RDataSet := mDBGrid.DataSource.DataSet;
    I := ZsPaperSizeNameToCode('A4');
//    FColumns := vColumns;
    if I < 0 then Exit;///////Begin 纸张设置
    V := I;
    Page.PaperSize := V;
(*
    Page.Columns := FColumns;
    Page.LeftMargin := vMargin.Left;
    Page.RightMargin := vMargin.Right;
    Page.TopMargin := vMargin.Top;
    Page.BottomMargin := vMargin.Bottom;
    FColumnSpace := vColumnSpace;
    Page.ColumnSpace := FColumnSpace;
    V := vOrientation;
    Page.Orientation := V;
*)
///////End 纸张设置
    DataInit;
    if FBool then Preview;
  finally
    DataFain;
    Free;
    vForm.Free;
  end; { with }
end; { DoQuickReportDBGQR }{ TQuickReportDBGQR }procedure TQuickReportDBGQR.DataFain;  { 数据终止化 }
var
  I: Integer;
begin
  for I := Low(FQRLabelList) to High(FQRLabelList) do
    FQRLabelList[I].Free;
  FQRLabelList := nil;  for I := Low(FQRDBTextList) to High(FQRDBTextList) do
    FQRDBTextList[I].Free;
  FQRDBTextList := nil;  for I := Low(FQRShape) to High(FQRShape) do
    FQRShape[I].Free;
  FQRShape := nil;  for I := Low(FQRLabel) to High(FQRLabel) do
    FQRLabel[I].Free;
  FQRLabel := nil;  FQRCaption.Free;
  FQRHead.Free;
  FQRTrail.Free;
end; { DataFain }procedure TQuickReportDBGQR.DataInit; { 数据初始化 }
var
  I, L: Integer;
  vColumns: TColumn;
begin
  FTempS := '';  FQRLabelList := nil;
  FQRDBTextList := nil;
  FPlane := 0;
  FListCount := 0;
  FColunmPos := cColunmPos;
  DataSet := RDataSet;///////Begin 画线-^
  SetLength(FQRShape, Succ(Length(FQRShape)));
  FQRShape[High(FQRShape)] := TQRShape.Create(Self);
  FQRShape[High(FQRShape)].Parent := QRBandTitle;
  FQRShape[High(FQRShape)].Top := 0;
  FQRShape[High(FQRShape)].Left := 0;
  FQRShape[High(FQRShape)].Shape := qrsHorLine;
  FQRShape[High(FQRShape)].Pen.Width := 2; //?1
  FQRShape[High(FQRShape)].Height := 2;
  FQRShape[High(FQRShape)].Width := FDBGridWidth + 2;
///////End 画线-^  if FVert then begin
///////Begin 画线<|
    SetLength(FQRShape, Succ(Length(FQRShape)));
    FQRShape[High(FQRShape)] := TQRShape.Create(Self);
    FQRShape[High(FQRShape)].Parent := QRBandTitle;    FQRShape[High(FQRShape)].Top := 1; //QRBandDetail.Height + 1;
    FQRShape[High(FQRShape)].Width := 1;
    FQRShape[High(FQRShape)].Left := 0;
    FQRShape[High(FQRShape)].Shape := qrsVertLine;
    FQRShape[High(FQRShape)].Pen.Width := 2;
    FQRShape[High(FQRShape)].Height := (FQRLabelHeight + 9) * FFloor; //?1
///////End 画线<|///////Begin 画线|>
    SetLength(FQRShape, Succ(Length(FQRShape)));
    FQRShape[High(FQRShape)] := TQRShape.Create(Self);
    FQRShape[High(FQRShape)].Parent := QRBandTitle;
    FQRShape[High(FQRShape)].Top := 1;
    FQRShape[High(FQRShape)].Left := FDBGridWidth + 2;
    FQRShape[High(FQRShape)].Shape := qrsVertLine;
    FQRShape[High(FQRShape)].Pen.Width := 2; //?1
    FQRShape[High(FQRShape)].Height := (FQRLabelHeight + 9) * FFloor;
    FQRShape[High(FQRShape)].Width := 1;
///////End 画线|>
  end;  vColumns := nil;
  with RDBGrid do for I := 0 to Pred(Columns.Count) do if Columns[I].Visible then
  begin
    vColumns := Columns[I];
    ListAdd(vColumns);
  end;
  FBool := Assigned(vColumns);
  if not FBool then Exit;/////  J := ZsCount(FTempS, ['_']);
  L := FPlane;
  while L > 0 do begin
///////Begin 加标签
    SetLength(FQRLabel, Succ(Length(FQRLabel)));
    FQRLabel[High(FQRLabel)] := TQRLabel.Create(Self);
    FQRLabel[High(FQRLabel)].Transparent := True;
    FQRLabel[High(FQRLabel)].Parent := QRBandTitle;    FQRLabel[High(FQRLabel)].Top := Pred(L) * (FQRLabelHeight + 9) + 5;
    FQRLabel[High(FQRLabel)].Left := FTempL[Pred(L)];    FQRLabel[High(FQRLabel)].Caption := ZsGoto(FTempS, ['_'], 1, False);
    FQRLabel[High(FQRLabel)].Font.Assign(vColumns.Font);
    FQRLabel[High(FQRLabel)].Width := FTempW[Pred(L)];
    FQRLabel[High(FQRLabel)].Alignment := taCenter;
    FQRLabel[High(FQRLabel)].WordWrap := False;
///////End 加标签
    FTempS := ZsTogo(FTempS, ['_'], 1, False);///////Begin 画线-=
    SetLength(FQRShape, Succ(Length(FQRShape)));
    FQRShape[High(FQRShape)] := TQRShape.Create(Self);
    FQRShape[High(FQRShape)].Parent := QRBandTitle;
    FQRShape[High(FQRShape)].Top := L * (FQRLabelHeight + 9);
    FQRShape[High(FQRShape)].Left := FQRLabel[High(FQRLabel)].Left + 1;
    FQRShape[High(FQRShape)].Width := FTempW[Pred(L)];
    FQRShape[High(FQRShape)].Shape := qrsHorLine;
    FQRShape[High(FQRShape)].Pen.Width := 1;
    FQRShape[High(FQRShape)].Height := 1;
///////End 画线-=
    Dec(L);
  end;
  SetGrid;
end; { DataInit }procedure TQuickReportDBGQR.ListAdd(mColunm: TColumn);  { 网格列转换成报表列 }
var
  I, J, L, T, Y: Integer;
  vPlane: Integer;
  vStrLeft, vStrRight, vStr1, vStr2, vStr: string;
  vChar: Char;
begin
  I := FListCount; //保留数组下标
  Inc(FListCount); //增加列数
  SetLength(FQRLabelList, FListCount); //增加标题列
  SetLength(FQRDBTextList, FListCount); //增加文本列
  FQRLabelList[I] := TQRLabel.Create(nil);
  with FQRLabelList[I] do
  begin
    Y := 0;
    vChar := ZsApart(mColunm.Title.Caption, ['_'],  vStrLeft, vStrRight, False);
    vPlane := ZsCount(mColunm.Title.Caption, ['_']);
    if vChar = #0 then begin
      T := FPlane;
      while T > 0 do begin
///////Begin 加标签
        SetLength(FQRLabel, Succ(Length(FQRLabel)));
        FQRLabel[High(FQRLabel)] := TQRLabel.Create(Self);
        FQRLabel[High(FQRLabel)].Transparent := True;
        FQRLabel[High(FQRLabel)].Parent := QRBandTitle;        FQRLabel[High(FQRLabel)].Top := Pred(T) * (FQRLabelHeight + 9) + 5;
        FQRLabel[High(FQRLabel)].Left := FTempL[Pred(T)];        FQRLabel[High(FQRLabel)].Caption := ZsGoto(FTempS, ['_'], 1, False);
        FQRLabel[High(FQRLabel)].Font.Assign(mColunm.Font);
        FQRLabel[High(FQRLabel)].Width := FTempW[Pred(T)];
        FQRLabel[High(FQRLabel)].Alignment := taCenter;
        FQRLabel[High(FQRLabel)].WordWrap := False;
///////End 加标签
        FTempS := ZsTogo(FTempS, ['_'], 1, False);///////Begin 画线-=
        SetLength(FQRShape, Succ(Length(FQRShape)));
        FQRShape[High(FQRShape)] := TQRShape.Create(Self);
        FQRShape[High(FQRShape)].Parent := QRBandTitle;
        FQRShape[High(FQRShape)].Top := T * (FQRLabelHeight + 9);
        FQRShape[High(FQRShape)].Left := FQRLabel[High(FQRLabel)].Left + 1;
        FQRShape[High(FQRShape)].Width := FTempW[Pred(T)];
        FQRShape[High(FQRShape)].Shape := qrsHorLine;
        FQRShape[High(FQRShape)].Pen.Width := 1;
        FQRShape[High(FQRShape)].Height := 1;
///////End 画线-=
        Dec(T);
      end;
      for L := 0 to Pred(vPlane) do FTempL[L] := FColunmPos;
      FTempS := '';
    end
    else begin
      J := Max(vPlane, FPlane);
      T := J;
      while T > 0 do begin
        vStr1 := ZsGoto(FTempS, ['_'], Succ(J - T));
        vStr2 := ZsGoto(vStrLeft, ['_'], Succ(J - T));
        if vStr1 <> vStr2 then begin
          L := FPlane;
          while L > (J - T) do begin
///////Begin 加标签      {T}
            SetLength(FQRLabel, Succ(Length(FQRLabel)));
            FQRLabel[High(FQRLabel)] := TQRLabel.Create(Self);
            FQRLabel[High(FQRLabel)].Transparent := True;
            FQRLabel[High(FQRLabel)].Parent := QRBandTitle;            FQRLabel[High(FQRLabel)].Top := Pred(L) * (FQRLabelHeight + 9) + 5;
            FQRLabel[High(FQRLabel)].Font.Color := clRed;
            FQRLabel[High(FQRLabel)].Left := FTempL[Pred(L)];            FQRLabel[High(FQRLabel)].Caption := ZsGoto(FTempS, ['_'], 1, False);
            FQRLabel[High(FQRLabel)].Font.Assign(mColunm.Font);
            FQRLabel[High(FQRLabel)].Width := FTempW[Pred(L)];
            FQRLabel[High(FQRLabel)].Alignment := taCenter;
            FQRLabel[High(FQRLabel)].WordWrap := False;
///////End 加标签
            FTempS := ZsTogo(FTempS, ['_'], 1, False);///////Begin 画线-=
            SetLength(FQRShape, Succ(Length(FQRShape)));
            FQRShape[High(FQRShape)] := TQRShape.Create(Self);
            FQRShape[High(FQRShape)].Parent := QRBandTitle;
            FQRShape[High(FQRShape)].Top := L * (FQRLabelHeight + 9);
            FQRShape[High(FQRShape)].Left := FQRLabel[High(FQRLabel)].Left + 1;
            FQRShape[High(FQRShape)].Width := FTempW[Pred(L)];
            FQRShape[High(FQRShape)].Shape := qrsHorLine;
            FQRShape[High(FQRShape)].Pen.Width := 1;
            FQRShape[High(FQRShape)].Height := 1;
///////End 画线-=
            Dec(L);
            Y := L;
          end;
          for L := J - T to Pred(J) do begin
            FTempW[L] := 0;
            FTempL[L] := FColunmPos;
          end;
          Break;
        end else if FPlane > 0 then begin
          Y := Succ(J - T);
        end;
        Dec(T);
      end;
    end;    Parent := QRBandTitle;
    Width := mColunm.Width + 20;
    for L := 0 to Pred(vPlane) do FTempW[L] := FTempW[L] + Width;    vStr := vStrRight;
    T := ZsCount(vStr, ['~']) + 1;
    vStr := StringReplace(vStr, '~', #13#10#32, [rfReplaceAll]);    Height := ((FQRLabelHeight + 9) * FFloor);    Top := ((FQRLabelHeight + 9) * (vPlane + FFloor - T)) div 2 + 5;
    Left := FColunmPos;
    AutoSize := False;
    AutoStretch := True;
    OnPrint := QRDBTextPrint;
    FQRLabelList[I].Alignment := mColunm.Title.Alignment;
    Font.Assign(mColunm.Font);
    Transparent := True;
    Caption := vStr;
    WordWrap := False;
    if I > 0 then
    begin
///////Begin 画线<|
      SetLength(FQRShape, Succ(Length(FQRShape)));
      FQRShape[High(FQRShape)] := TQRShape.Create(Self);
      FQRShape[High(FQRShape)].Parent := QRBandTitle;      FQRShape[High(FQRShape)].Top := Max(Y * (FQRLabelHeight + 9), 1);
      FQRShape[High(FQRShape)].Width := 1;
      FQRShape[High(FQRShape)].Left := Left + 1;
      FQRShape[High(FQRShape)].Shape := qrsVertLine;
      FQRShape[High(FQRShape)].Pen.Width := 1;
      FQRShape[High(FQRShape)].Height := Height;
///////End 画线<|
    end;
    Inc(FColunmPos, Width);
    FPlane := vPlane;
    FTempS := vStrLeft;
  end; { with }
///////End 设置标题列///////Begin 设置文本列
  FQRDBTextList[I] := TQRDBText.Create(nil);
  with FQRDBTextList[I] do
  begin
    Parent := QRBandDetail;
    Top := 2;
    DataSet := RDataSet;
    DataField := mColunm.FieldName;
    Alignment := mColunm.Alignment;
    Font := mColunm.Font;
    if I = 0 then begin
      Width := FQRLabelList[I].Width + 2;
      Left := FQRLabelList[I].Left - 2;
    end else
    begin
      Width := FQRLabelList[I].Width;
      Left := FQRLabelList[I].Left;
    end;
    AutoSize := False;
    AutoStretch := False;
    OnPrint := QRDBTextPrint;    if I > 0 then
    begin
///////Begin 画线<|
      SetLength(FQRShape, Succ(Length(FQRShape)));
      FQRShape[High(FQRShape)] := TQRShape.Create(Self);
      FQRShape[High(FQRShape)].Parent := QRBandDetail;      FQRShape[High(FQRShape)].Top := -1;
      FQRShape[High(FQRShape)].Width := 1;
      FQRShape[High(FQRShape)].Left := Left + 1;
      FQRShape[High(FQRShape)].Shape := qrsVertLine;
      FQRShape[High(FQRShape)].Pen.Width := 1;
      FQRShape[High(FQRShape)].Height := Height + 4;
///////End 画线<|
    end;
  end; { with }
///////End 设置文本列end; { ListAdd }procedure TQuickReportDBGQR.SetGrid; { 设置网格属性 }
var
  vStr: string;
begin
  if FListCount <= 0 then Exit;
  QRBandTitle.Height := ((FQRLabelHeight + 9) * FFloor);
  QRBandDetail.Height := FQRDBTextList[0].Height + 1;
  QRBandHead.Height := 0;
  QRBandSummary.Height := 0;  if Assigned(FCaption) then
  begin
///////Begin 设置标题
    FQRCaption := TQRLabel.Create(nil);
    FQRCaption.Transparent := True;
    FQRCaption.Parent := QRBandHead;
    FQRCaption.Font := FCaption.Font;
    FQRCaption.Height := FCaption.Height;
    vStr := FCaption.Caption;
    ReplaceStr(vStr);
    FQRCaption.Caption := vStr;
    QRBandHead.Height := FQRCaption.Height;    FReplaceCaption := FCaption.Caption;;
    if ZsMa(FCaption.Tag, 0, 2) then
      FQRCaption.Left := ZsAlign(FQRCaption.Width, 0, FColunmPos * FColumns +
        Pred(FColumns) * Round(Page.LeftMargin + Page.RightMargin + FColumnSpace),
        TAlignment(FCaption.Tag))
    else FQRCaption.Left := FCaption.Left;
///////End 设置标题
  end;  if Assigned(FHead) then
  begin
///////Begin 设置表头
    FQRHead := TQRLabel.Create(nil);
    FQRHead.Transparent := True;
    FQRHead.Parent := QRBandHead;
    FQRHead.Font := FHead.Font;
    FQRHead.Height := FHead.Height;
    vStr := FHead.Caption;
    ReplaceStr(vStr);
    FQRHead.Caption := vStr;
    FQRHead.Top := FQRCaption.Height;
    FReplaceHead := FHead.Caption;
    QRBandHead.Height := QRBandHead.Height + FQRHead.Height + 10;
    if ZsMa(FHead.Tag, 0, 2) then
      FQRHead.Left := ZsAlign(FQRHead.Width, 0, FColunmPos * FColumns +
        Pred(FColumns) * Round(Page.LeftMargin + Page.RightMargin + FColumnSpace),
        TAlignment(FHead.Tag))
    else FQRHead.Left := FHead.Left;
///////End 设置表头
  end;  if Assigned(FTrail) then
  begin
///////Begin 设置表尾
    FQRTrail := TQRLabel.Create(nil);
    FQRTrail.Parent := QRBandSummary;
    FQRTrail.Font := FTrail.Font;
    FQRTrail.Top := 3;
    FQRTrail.Height := FTrail.Height;
    vStr := FTrail.Caption;
    ReplaceStr(vStr);
    FQRTrail.Caption := vStr;
    FQRTrail.Transparent := True;
    QRBandSummary.Height := FQRTrail.Height + 10;
    FReplaceTrail := FTrail.Caption;
    if ZsMa(FTrail.Tag, 0, 2) then
      FQRTrail.Left := ZsAlign(FQRTrail.Width, 0, FColunmPos * FColumns +
        Pred(FColumns) * Round(Page.LeftMargin + Page.RightMargin + FColumnSpace),
        TAlignment(FTrail.Tag))
    else FQRTrail.Left := FTrail.Left;
///////End 设置表尾///////Begin 画线_
    SetLength(FQRShape, Succ(Length(FQRShape)));
    FQRShape[High(FQRShape)] := TQRShape.Create(Self);
    FQRShape[High(FQRShape)].Parent := QRBandSummary;    FQRShape[High(FQRShape)].Top := 0;
    FQRShape[High(FQRShape)].Width := FDBGridWidth + 2;
    FQRShape[High(FQRShape)].Left := 0;
    FQRShape[High(FQRShape)].Shape := qrsHorLine;
    FQRShape[High(FQRShape)].Pen.Width := 2;
    FQRShape[High(FQRShape)].Height := 1; //?1
///////End 画线_
  end;///////Begin 画线-^
  SetLength(FQRShape, Succ(Length(FQRShape)));
  FQRShape[High(FQRShape)] := TQRShape.Create(Self);
  FQRShape[High(FQRShape)].Parent := QRBandDetail;  FQRShape[High(FQRShape)].Top := 0;
  FQRShape[High(FQRShape)].Width := FDBGridWidth + 1;
  FQRShape[High(FQRShape)].Left := 1;
  FQRShape[High(FQRShape)].Shape := qrsHorLine;
  FQRShape[High(FQRShape)].Pen.Width := 1;
  FQRShape[High(FQRShape)].Height := 1;
///////End 画线-^///////Begin 画线_
  SetLength(FQRShape, Succ(Length(FQRShape)));
  FQRShape[High(FQRShape)] := TQRShape.Create(Self);
  FQRShape[High(FQRShape)].Parent := QRBandDetail;  FQRShape[High(FQRShape)].Top := QRBandDetail.Height + 1;
  FQRShape[High(FQRShape)].Width := FDBGridWidth + 1;
  FQRShape[High(FQRShape)].Left := 1;
  FQRShape[High(FQRShape)].Shape := qrsHorLine;
  FQRShape[High(FQRShape)].Pen.Width := 2;
  FQRShape[High(FQRShape)].Height := 1; //?1
///////End 画线_  if FVert then begin
///////Begin 画线<|
    SetLength(FQRShape, Succ(Length(FQRShape)));
    FQRShape[High(FQRShape)] := TQRShape.Create(Self);
    FQRShape[High(FQRShape)].Parent := QRBandDetail;    FQRShape[High(FQRShape)].Top := 0; //QRBandDetail.Height + 1;
    FQRShape[High(FQRShape)].Width := 1;
    FQRShape[High(FQRShape)].Left := 0;
    FQRShape[High(FQRShape)].Shape := qrsVertLine;
    FQRShape[High(FQRShape)].Pen.Width := 2;
    FQRShape[High(FQRShape)].Height := QRBandDetail.Height + 2; //?1
///////End 画线<|///////Begin 画线|>
    SetLength(FQRShape, Succ(Length(FQRShape)));
    FQRShape[High(FQRShape)] := TQRShape.Create(Self);
    FQRShape[High(FQRShape)].Parent := QRBandDetail;    FQRShape[High(FQRShape)].Top := 0; //QRBandDetail.Height + 1;
    FQRShape[High(FQRShape)].Width := 1;
    FQRShape[High(FQRShape)].Left := FDBGridWidth + 2;
    FQRShape[High(FQRShape)].Shape := qrsVertLine;
    FQRShape[High(FQRShape)].Pen.Width := 2;
    FQRShape[High(FQRShape)].Height := QRBandDetail.Height + 2; //?1
///////End 画线|>
  end;
end;procedure TQuickReportDBGQR.QRDBTextPrint(Sender: TObject;
  var Value: String);
begin
  Value := Format(' %s ', [Value]);
end;procedure TQuickReportDBGQR.SetDBGrid(const Value: TDBGrid);
var
  I, J: Integer;
begin
  FTempW := nil;
  FTempL := nil;  FDBGrid := Value;
  FQRLabelHeight := 0;
  FDBGridWidth := 0;
  FFloor := 1;
  with RDBGrid do for I := 0 to Pred(Columns.Count) do
  begin
    if not Columns[I].Visible then Continue;
    J := ZsCount(Columns[I].Title.Caption, ['_']);
    if FFloor < Succ(J) then FFloor := Succ(J);
    Canvas.Font.Assign(Columns[I].Title.Font);
    J := ZsTextFontHeight(Canvas, Columns[I].Title.Caption);
    if FQRLabelHeight < J then FQRLabelHeight := J;
    FDBGridWidth := FDBGridWidth + Columns[I].Width + 20;
  end;
  SetLength(FTempW, Pred(FFloor));
  SetLength(FTempL, Pred(FFloor));
end;procedure TQuickReportDBGQR.SetVert(const Value: Boolean);
begin
  FVert := Value;
end;procedure TQuickReportDBGQR.QuickRepStartPage(Sender: TCustomQuickRep);
var
  vStr: string;
begin
  if Assigned(FQRCaption) then begin
    vStr := FReplaceCaption;
    ReplaceStr(vStr);
    FQRCaption.Caption := vStr;
  end;  if Assigned(FQRHead) then begin
    vStr := FReplaceHead;
    ReplaceStr(vStr);
    FQRHead.Caption := vStr;
  end;  if Assigned(FQRTrail) then begin
    vStr := FReplaceTrail;
    ReplaceStr(vStr);
    FQRTrail.Caption := vStr;
  end;
end;procedure TQuickReportDBGQR.ReplaceStr(var nStr: string); { 替换字符串 }
begin
  nStr := StringReplace(nStr, '_', '', [rfReplaceAll]);
  nStr := StringReplace(nStr, '&p', '&P', [rfReplaceAll]);
  nStr := StringReplace(nStr, '&P', Format('%d', [PageNumber]), [rfReplaceAll]);
  nStr := StringReplace(nStr, '&d', '&D', [rfReplaceAll]);
  nStr := StringReplace(nStr, '&D', FormatDateTime(cFormatDateCn, Now), [rfReplaceAll]);
  nStr := StringReplace(nStr, '&t', '&T', [rfReplaceAll]);
  nStr := StringReplace(nStr, '&T', FormatDateTime(cFormatTimeCn, Now), [rfReplaceAll]);
end;end.

解决方案 »

  1.   

    //^ DBGQRUnit.pas//DBGQRUnit.dfm
    object QuickReportDBGQR: TQuickReportDBGQR
      Left = 0
      Top = 0
      Width = 1632
      Height = 1056
      Frame.Color = clBlack
      Frame.DrawTop = False
      Frame.DrawBottom = False
      Frame.DrawLeft = False
      Frame.DrawRight = False
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -13
      Font.Name = 'Arial'
      Font.Style = []
      Functions.Strings = (
        'PAGENUMBER'
        'COLUMNNUMBER'
        'REPORTTITLE')
      Functions.DATA = (
        '0'
        '0'
        '''''')
      OnStartPage = QuickRepStartPage
      Options = [FirstPageHeader, LastPageFooter]
      Page.Columns = 1
      Page.Orientation = poPortrait
      Page.PaperSize = Ledger
      Page.Values = (
        100
        2794
        100
        4318
        100
        100
        0)
      PrinterSettings.Copies = 1
      PrinterSettings.Duplex = False
      PrinterSettings.FirstPage = 0
      PrinterSettings.LastPage = 0
      PrinterSettings.OutputBin = LargeCapacity
      PrintIfEmpty = True
      SnapToGrid = True
      Units = MM
      Zoom = 100
      object QRBandHead: TQRBand
        Left = 38
        Top = 38
        Width = 1556
        Height = 40
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        AlignToBottom = False
        Color = clWhite
        ForceNewColumn = False
        ForceNewPage = False
        Size.Values = (
          105.833333333333
          4116.91666666667)
        BandType = rbPageHeader
      end
      object QRBandTitle: TQRBand
        Left = 38
        Top = 78
        Width = 1556
        Height = 27
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        AlignToBottom = False
        Color = clWhite
        ForceNewColumn = False
        ForceNewPage = False
        Size.Values = (
          71.4375
          4116.91666666667)
        BandType = rbColumnHeader
      end
      object QRBandDetail: TQRBand
        Left = 38
        Top = 105
        Width = 1556
        Height = 32
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        AlignToBottom = False
        Color = clWhite
        ForceNewColumn = False
        ForceNewPage = False
        Size.Values = (
          84.6666666666667
          4116.91666666667)
        BandType = rbDetail
      end
      object QRBandSummary: TQRBand
        Left = 38
        Top = 137
        Width = 1556
        Height = 40
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        AlignToBottom = False
        Color = clWhite
        ForceNewColumn = False
        ForceNewPage = False
        Size.Values = (
          105.833333333333
          4116.91666666667)
        BandType = rbSummary
      end
      object QRBand1: TQRBand
        Left = 38
        Top = 177
        Width = 1556
        Height = 40
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        AlignToBottom = False
        Color = clWhite
        ForceNewColumn = False
        ForceNewPage = False
        Size.Values = (
          105.833333333333
          4116.91666666667)
        BandType = rbPageFooter
        object QRSysData1: TQRSysData
          Left = 16
          Top = 15
          Width = 46
          Height = 17
          Frame.Color = clBlack
          Frame.DrawTop = False
          Frame.DrawBottom = False
          Frame.DrawLeft = False
          Frame.DrawRight = False
          Size.Values = (
            44.9791666666667
            42.3333333333333
            39.6875
            121.708333333333)
          Alignment = taLeftJustify
          AlignToBand = False
          AutoSize = True
          Color = clWhite
          Data = qrsPageNumber
          Transparent = False
          FontSize = 10
        end
        object QRLabel1: TQRLabel
          Left = 2
          Top = 16
          Width = 14
          Height = 17
          Frame.Color = clBlack
          Frame.DrawTop = False
          Frame.DrawBottom = False
          Frame.DrawLeft = False
          Frame.DrawRight = False
          Size.Values = (
            44.9791666666667
            5.29166666666667
            42.3333333333333
            37.0416666666667)
          Alignment = taLeftJustify
          AlignToBand = False
          AutoSize = True
          AutoStretch = False
          Caption = '第'
          Color = clWhite
          Transparent = False
          WordWrap = True
          FontSize = 10
        end
        object QRLabel2: TQRLabel
          Left = 27
          Top = 17
          Width = 14
          Height = 17
          Frame.Color = clBlack
          Frame.DrawTop = False
          Frame.DrawBottom = False
          Frame.DrawLeft = False
          Frame.DrawRight = False
          Size.Values = (
            44.9791666666667
            71.4375
            44.9791666666667
            37.0416666666667)
          Alignment = taLeftJustify
          AlignToBand = False
          AutoSize = True
          AutoStretch = False
          Caption = '页'
          Color = clWhite
          Transparent = False
          WordWrap = True
          FontSize = 10
        end
      end
    end
      

  2.   

    //DemoUnit.pas
    unit DemoUnit;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls, QuickRpt, QRCtrls, DB, DBTables, Grids,
      DBGrids;type
      TForm1 = class(TForm)
        Button1: TButton;
        Table1: TTable;
        DataSource1: TDataSource;
        DBGrid1: TDBGrid;
        Label1: TLabel;
        Label2: TLabel;
        Label3: TLabel;
        procedure Button1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementationuses DBGQRUnit;{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
    begin
      DoQuickReportDBGQR(DBGrid1, Label1, Label2, Label3);
    end;procedure TForm1.FormCreate(Sender: TObject);
    begin
      Table1.Open;
    end;end.//DemoUnit.dfm
    object Form1: TForm1
      Left = 80
      Top = 121
      Width = 544
      Height = 375
      Caption = 'Form1'
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      OldCreateOrder = False
      Scaled = False
      OnCreate = FormCreate
      PixelsPerInch = 96
      TextHeight = 13
      object Label1: TLabel
        Left = 56
        Top = 48
        Width = 77
        Height = 13
        Caption = '苦苦作了一个月'
      end
      object Label2: TLabel
        Left = 56
        Top = 72
        Width = 36
        Height = 13
        Caption = 'zswang'
      end
      object Label3: TLabel
        Left = 440
        Top = 280
        Width = 54
        Height = 13
        Caption = '2000-05-23'
      end
      object Button1: TButton
        Left = 344
        Top = 22
        Width = 75
        Height = 25
        Caption = 'Button1'
        TabOrder = 0
        OnClick = Button1Click
      end
      object DBGrid1: TDBGrid
        Left = 56
        Top = 88
        Width = 433
        Height = 185
        DataSource = DataSource1
        TabOrder = 1
        TitleFont.Charset = DEFAULT_CHARSET
        TitleFont.Color = clWindowText
        TitleFont.Height = -11
        TitleFont.Name = 'MS Sans Serif'
        TitleFont.Style = []
        Columns = <
          item
            Expanded = False
            FieldName = 'NAME'
            Title.Caption = 'LOOK_NAME'
            Visible = True
          end
          item
            Expanded = False
            FieldName = 'SIZE'
            Title.Caption = 'LOOK_SIZE'
            Visible = True
          end
          item
            Expanded = False
            FieldName = 'WEIGHT'
            Title.Caption = 'WEIGHT~LINE'
            Visible = True
          end
          item
            Expanded = False
            FieldName = 'AREA'
            Visible = True
          end>
      end
      object Table1: TTable
        Active = True
        DatabaseName = 'DBDEMOS'
        TableName = 'animals.dbf'
        Left = 16
        Top = 1
      end
      object DataSource1: TDataSource
        DataSet = Table1
        Left = 48
        Top = 1
      end
    end
      

  3.   

    zswang:
    你既然用了QuickRep来实现打印功能，有必要写的这么复杂嘛？？？
    虽然你的功能是完全实现了，但是有一种方法简单的多。呵呵
      

  4.   

    这是zswang的早期作品,让大家见笑了
      

  5.   

    zswang：
      不好意思，我不是针对你来说的，只是觉得你的程序太长，刚才看了我头晕 ：)
      
      

  6.   

    to 962veiri(风尘旅人)　
    你给俺一个短的？俺就喜欢简洁的，代码越少越好啊，嘿嘿
    快快快快快快快快快快快快快快快快快快快快快快快快快快
      

  7.   

    to 962veiri(风尘旅人)　
    你给俺一个短的？俺就喜欢简洁的，代码越少越好啊，嘿嘿
    快快快快快快快快快快快快快快快快快快快快快快快快快快
      

  8.   

    //　━━━━┯━━━━━┯━━━━━━━━━┯━━━━━━
    //　　　　　│　　A2　　│　　A3　　　　　　│　A4　　　　
    //　　　　　├─┬─┬─┼─────┬───┼─┬────
    //　　　a1　│　│　│　│　　B4　　│　B5　│　│　B7　 　
    //          │b1│b2│b3├─┬─┬─┼─┬─┤b6├─┬──
    //          │  │　│　│c1│c2│c3│c4│c5│  │c6│c7
    //  ────┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼──
    //  ☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
    //  ━━━━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━┷━━
      

  9.   

    to zswang(伴水)(被黑中):
    这样的程序你还有多少啊？都贴出来给我这样的懒虫用多好啊！真真谢谢你！
      

  10.   

    to zswang(伴水)(被黑中):
    这样的程序你还有多少啊？都贴出来给我这样的懒虫用多好啊！真真谢谢你！