setprint.pas

delphi作得信息业进销存源码.功能全面,运行稳定.

      DstList.Items.Insert(0, '序号' + Copy(strSpace, 1, 46) + 'DetailNo');
    end;
    intLmLines := 1;
    intWidth := 0;
    Memo1.Font := mmoLm.Font;
    //Lm Lines; Width; strTotalFields ...
    strTotalFields := '';
    for i := 0 to TotalList.Items.Count - 1 do
      if TotalList.State[i] = cbChecked then
        strTotalFields := strTotalFields +
          Copy(TotalList.Items[i], 51, Length(TotalList.Items[i]) - 50) + ';';
    blnHaveTotal := false;
    blnHavePageTotal := false;
    for i := 0 to DstList.Items.Count - 1 do
    begin
      strTmp := Copy(DstList.Items[i], 51, Length(DstList.Items[i]) - 50);
      for j := 0 to dbgColWidth.Columns.Count - 1 do
        if dbgColWidth.Columns[j].FieldName = strTmp then
          break;
      //Width
      intWidth := intWidth + Trunc(dbgColWidth.Columns[j].Width * dblBl) +
        TextWidth(mmoNy.Font, 'A');
      //Lm Line Count
      Memo1.Lines.Clear;
      Memo1.Lines.Text := dbgColWidth.Columns[j].Title.Caption;
      Memo1.Width := Trunc(dbgColWidth.Columns[j].Width * dblBl) +
        TextWidth(mmoNy.Font, 'A');
      if Memo1.Lines.Count > intLmLines then
        intLmLines := Memo1.Lines.Count;
      //HaveTotal
      if Pos(UpperCase(dbgColWidth.Columns[j].FieldName) + ';', UpperCase(strTotalFields)) > 0 then
        blnHaveTotal := true;
    end;
    blnHavePageTotal := blnHaveTotal;
    blnHaveTotal := cbHj.Checked and blnHaveTotal;
    blnHavePageTotal := cbXj.Checked and blnHavePageTotal;
    if intLmLines > 5 then
      intLmLines := 5;
    //Bj (Left,Right)
    if cbBj.Checked then
    begin
      edtPageLeft.Value := 10;
      edtPageRight.Value := 10;
      if qrbYm.Width > intWidth then
      begin
        Page.LeftMargin := 10 + StrToFloat(FormatFloat('0.000', (qrbYm.Width - intWidth) * qrbYm.Size.Width / qrbYm.Width / 2));
        Page.RightMargin := Page.Width - Page.LeftMargin - StrToFloat(FormatFloat('0.000', intWidth * qrbYm.Size.Width / qrbYm.Width)) - 0.5;
        edtPageLeft.Value := Trunc(Page.LeftMargin);
        edtPageRight.Value := Trunc(Page.RightMargin);
      end;
    end else
    begin
      Page.LeftMargin := edtPageLeft.Value;
      Page.RightMargin := edtPageRight.Value;
    end;
    //Ym
    if not YmDy.Checked or (YmRich.Text = '') then
      qrbYm.Height := 0
    else
    begin
      with qrbYm do
      begin
        Height := GetRichEditHeight(YmRich) + RichMargin;
        Color := YmColor.Color;
        DrawBandFrame(qrbYm, YmHx.ItemIndex);
      end;
      with qrrYm do
      begin
        Top := RichMargin div 2;
        Height := qrbYm.Height - RichMargin div 2;
        Width := qrbYm.Width;
        RichClone(YmRich, YmRich_P);
        SetRichText(YmRich_P);
        YmRich_P.SelectAll;
        if YmRightAlign.Down then
          YmRich_P.Paragraph.Alignment := taRightJustify
        else if YmCenterAlign.Down then
          YmRich_P.Paragraph.Alignment := taCenter
        else
          YmRich_P.Paragraph.Alignment := taLeftJustify;
        ParentRichEdit := YmRich_P;
      end;
    end;
    //Bt
    if not BtDy.Checked  or (BtRich.Text = '') then
      qrbBt.Height := 0
    else
    begin
      with qrbBt do
      begin
        Height := GetRichEditHeight(BtRich) + RichMargin;
        Color := BtColor.Color;
        DrawBandFrame(qrbBt, BtHx.ItemIndex);
      end;
      with qrrBt do
      begin
        Top := RichMargin div 2;
        Height := qrbBt.Height - RichMargin div 2;
        Width := qrbBt.Width;
        RichClone(BtRich, BtRich_P);
        SetRichText(BtRich_P);
        BtRich_P.SelectAll;
        if BtRightAlign.Down then
          BtRich_P.Paragraph.Alignment := taRightJustify
        else if BtCenterAlign.Down then
          BtRich_P.Paragraph.Alignment := taCenter
        else
          BtRich_P.Paragraph.Alignment := taLeftJustify;
        ParentRichEdit := BtRich_P;
      end;
    end;
    //Bgbt
    if not BgbtDy.Checked  or (BgbtRich.Text = '') then
      qrbBgbt.Height := 0
    else
    begin
      with qrbBgbt do
      begin
        Height := GetRichEditHeight(BgbtRich) + RichMargin;
        Color := BgbtColor.Color;
        DrawBandFrame(qrbBgbt, BgbtHx.ItemIndex);
      end;
      with qrrBgbt do
      begin
        Top := RichMargin div 2;
        Height := qrbBgbt.Height - RichMargin div 2;
        Width := qrbBgbt.Width;
        RichClone(BgbtRich, BgbtRich_P);
        SetRichText(BgbtRich_P);
        BgbtRich_P.SelectAll;
        if BgbtRightAlign.Down then
          BgbtRich_P.Paragraph.Alignment := taRightJustify
        else if BgbtCenterAlign.Down then
          BgbtRich_P.Paragraph.Alignment := taCenter
        else
          BgbtRich_P.Paragraph.Alignment := taLeftJustify;
        ParentRichEdit := BgbtRich_P;
      end;
    end;
    //Lm
    with qrbLm do
    begin
      Height := TextHeight(mmoLm.Font, 'A') * intLmLines +
        Trunc(TextHeight(mmoLm.Font, 'A') * (StrToFloat(edtLmXj.Text)));
      Color := mmoLm.Color;
    end;
    intLeft := 0;
    for i := 0 to DstList.Items.Count - 1 do
    begin
      strTmp := Copy(DstList.Items[i], 51, Length(DstList.Items[i]) - 50);
      for j := 0 to dbgColWidth.Columns.Count - 1 do
        if dbgColWidth.Columns[j].FieldName = strTmp then
          break;
      CShape :=TQRShape.Create(self);
      with CShape do
      begin
        Parent := qrbLm;
        Brush.Color := qrbLm.Color;
        Top := 0;
        Left := intLeft;
        intWidth := Trunc(dbgColWidth.Columns[j].Width * dblBl) +
          TextWidth(mmoNy.Font, 'A') + 1;
        if cbLmHx.ItemIndex <> 2 then
          Width := intWidth
        else
          Width := intWidth - 1;
        if cbNyHx.ItemIndex = 3 then
          Height := qrblm.Height - 1
        else
          Height := qrblm.Height;
        if rbLmSx.Checked then
          Pen.Style := psSolid
        else
          Pen.Style := psDashDot;
        case cbLmHx.ItemIndex of
          0: Shape := qrsRectangle;
          1: Shape := qrsTopAndBottom;
          2: Shape := qrsRightAndLeft;
          3: Enabled := false;
        end;
      end;
      CMemo :=TQRMemo.Create(self);
      Memo1.Lines.Clear;
      Memo1.Lines.Text := dbgColWidth.Columns[j].Title.Caption;
      Memo1.Width := Trunc(dbgColWidth.Columns[j].Width * dblBl);
      with CMemo do
      begin
        Parent := qrbLm;
        for k := 0 to Memo1.Lines.Count - 1 do
          Lines.Add(Memo1.Lines[k]);
        Alignment := taCenter;
        Top := Trunc(TextHeight(mmoLm.Font, 'A') * StrToFloat(edtLmXj.Text)) div 2 +
          (TextHeight(mmoLm.Font, 'A') * (IntLmLines - Memo1.Lines.Count)) div 2;
        Left := intLeft;
        Width := CShape.Width;
        Height := TextHeight(mmoLm.Font, 'A') * Lines.Count;
        Font := mmoLm.Font;
        Transparent := true;
      end;
      intLeft := CShape.Left + intWidth - 1;
    end;
    //Ny
    with qrbNy do
    begin
      Height := TextHeight(mmoNy.Font, 'A') +
        Trunc(TextHeight(mmoNy.Font, 'A') * (StrToFloat(edtNyXj.Text)));
      Color := mmoNy.Color;
    end;
    intLeft := 0;
    for i := 0 to DstList.Items.Count - 1 do
    begin
      strTmp := Copy(DstList.Items[i], 51, Length(DstList.Items[i]) - 50);
      for j := 0 to dbgColWidth.Columns.Count - 1 do
        if dbgColWidth.Columns[j].FieldName = strTmp then
          break;
      CShape := TQRShape.Create(self);
      with CShape do
      begin
        Parent := qrbNy;
        Brush.Color := qrbNy.Color;
        Top := -1;
        Left := intLeft;
        intWidth := Trunc(dbgColWidth.Columns[j].Width * dblBl) +
          TextWidth(mmoNy.Font, 'A') + 1;
        if cbNyHx.ItemIndex <> 2 then
          Width := intWidth
        else
          Width := intWidth - 1;
        Height := qrbNy.Height;
        if rbNySx.Checked then
          Pen.Style := psSolid
        else
          Pen.Style := psDashDot;
        case cbNyHx.ItemIndex of
          0, 1: Shape := qrsTopAndBottom;
          2: Shape := qrsRightAndLeft;
          3: Enabled := false;
        end;
      end;
      //奇偶行不同色的处理 (长方形会挡住底色，要 '||' + '=')
      if cbNyHx.ItemIndex = 0 then
      begin
        CShape := TQRShape.Create(self);
        with CShape do
        begin
          Parent := qrbNy;
          Brush.Color := qrbNy.Color;
          Top := -1;
          Left := intLeft;
          Width := intWidth - 1;
          Height := qrbNy.Height + 1;
          if rbNySx.Checked then
            Pen.Style := psSolid
          else
            Pen.Style := psDashDot;
          Shape := qrsRightAndLeft;
        end;
      end;
      if dbgColWidth.Columns[j].FieldName = 'DetailNo' then
      begin
        //Xh
        CSysData := TQRSysData.Create(self);
        with CSysData do
        begin
          Parent := qrbNy;
          Data := qrsDetailNo;
          AutoSize := false;
          Alignment := taCenter;
          Top := Trunc(TextHeight(mmoNy.Font, 'A') * StrToFloat(edtNyXj.Text)) div 2;
          Left := intLeft + TextWidth(mmoNy.Font, 'A') div 2;
          Width := CShape.Width - TextWidth(mmoNy.Font, 'A');
          Height := TextHeight(mmoNy.Font, 'A');
          Font := mmoNy.Font;
          Transparent := true;
          if cbHh.Checked then
            OnPrint := rptSetPrint.QRDBTextPrint;
        end;
      end
      else
      begin
        CDBText := TQRDBText.Create(self);
        with CDBText do
        begin
          Parent := qrbNy;
          AutoSize := false;
          DataSet := ADataSet;
          DataField := dbgColWidth.Columns[j].FieldName;
          Alignment := dbgColWidth.Columns[j].Alignment;
          Top := Trunc(TextHeight(mmoNy.Font, 'A') * StrToFloat(edtNyXj.Text)) div 2;
          Left := intLeft + TextWidth(mmoNy.Font, 'A') div 2;
          Width := CShape.Width - TextWidth(mmoNy.Font, 'A');
          Height := TextHeight(mmoNy.Font, 'A');
          Font := mmoNy.Font;
          Transparent := true;
          if cbHh.Checked then
            OnPrint := rptSetPrint.QRDBTextPrint;
        end;
      end;
      intLeft := CShape.Left + intWidth - 1;
    end;
    //Xj
    if not blnHavePageTotal then
      qrbXj.Height := 0
    else
    begin
      with qrbXj do
      begin
        Height := TextHeight(mmoXj.Font, 'A') +
          Trunc(TextHeight(mmoXj.Font, 'A') * (StrToFloat(edtXjXj.Text)));
        Color := mmoXj.Color;
      end;
      intLeft := 0;
      for i := 0 to DstList.Items.Count - 1 do
      begin
        strTmp := Copy(DstList.Items[i], 51, Length(DstList.Items[i]) - 50);
        for j := 0 to dbgColWidth.Columns.Count - 1 do
          if dbgColWidth.Columns[j].FieldName = strTmp then
            break;
        CShape :=TQRShape.Create(self);
        with CShape do
        begin
          Parent := qrbXj;
          Brush.Color := qrbXj.Color;
          if cbNyHx.ItemIndex = 3 then
            Top := 0
          else
            Top := -1;
          Left := intLeft;
          intWidth := Trunc(dbgColWidth.Columns[j].Width * dblBl) +
            TextWidth(mmoNy.Font, 'A') + 1;
          if cbXjHx.ItemIndex <> 2 then
            Width := intWidth
          else
            Width := intWidth - 1;
          Height := qrbXj.Height;
          if rbXjSx.Checked then
            Pen.Style := psSolid
          else
            Pen.Style := psDashDot;
          case cbXjHx.ItemIndex of
            0: Shape := qrsRectangle;
            1: Shape := qrsTopAndBottom;
            2: Shape := qrsRightAndLeft;
            3: Enabled := false;
          end;
        end;
        if i = 0 then
        begin
          CLabel := TQRLabel.Create(self);
          with CLabel do
          begin
            Parent := qrbXj;
            Caption := '小计';
            Name := 'qrlXj';
            Alignment := taCenter;
            Top := Trunc(TextHeight(mmoXj.Font, 'A') * StrToFloat(edtXjXj.Text)) div 2;
            Left := intLeft + TextWidth(mmoNy.Font, 'A') div 2;
            Width := CShape.Width - TextWidth(mmoNy.Font, 'A');
            Height := TextHeight(mmoXj.Font, 'A');
            Font := mmoXj.Font;
            Transparent := true;
          end;
        end;
        if (dbgColWidth.Columns[j].Field is TNumericField) and
          (Pos(UpperCase(dbgColWidth.Columns[j].FieldName) + ';', UpperCase(strTotalFields)) > 0) then
        begin
          CExpr := TQRExpr.Create(self);
          with CExpr do
          begin
            Parent := qrbXj;
            Alignment := taRightJustify;
            ResetAfterPrint := true;
            Mask := TNumericField(dbgColWidth.Columns[j].Field).DisplayFormat;
            Expression := 'sum(if(STOPSUM=0, ' + dbgColWidth.Columns[j].FieldName + ', 0))';
            Top := Trunc(TextHeight(mmoXj.Font, 'A') * StrToFloat(edtXjXj.Text)) div 2;
            Left := intLeft + TextWidth(mmoNy.Font, 'A') div 2;
            Width := CShape.Width - TextWidth(mmoNy.Font, 'A');
            Height := TextHeight(mmoXj.Font, 'A');
            Font := mmoXj.Font;
            Transparent := true;
          end;
        end;
        intLeft := CShape.Left + intWidth - 1;
      end;
    end;
    //Hj
    if not blnHaveTotal then
      qrbHj.Height := 0
    else
    begin
      with qrbHj do
      begin
        Height := TextHeight(mmoHj.Font, 'A') +
          Trunc(TextHeight(mmoHj.Font, 'A') * (StrToFloat(edtHjXj.Text)));
        Color := mmoHj.Color;
      end;
      intLeft := 0;
      for i := 0 to DstList.Items.Count - 1 do
      begin
        strTmp := Copy(DstList.Items[i], 51, Length(DstList.Items[i]) - 50);
        for j := 0 to dbgColWidth.Columns.Count - 1 do
          if dbgColWidth.Columns[j].FieldName = strTmp then
            break;
        CShape :=TQRShape.Create(self);
        with CShape do
        begin
          Parent := qrbHj;
          Brush.Color := qrbHj.Color;
          if cbNyHx.ItemIndex = 3 then
            Top := 0
          else
            Top := -1;
          if cbXjHx.ItemIndex <> 3 then
            Top := Top - 1;
          Left := intLeft;
          intWidth := Trunc(dbgColWidth.Columns[j].Width * dblBl) +
            TextWidth(mmoNy.Font, 'A') + 1;
          if cbHjHx.ItemIndex <> 2 then
            Width := intWidth
          else
            Width := intWidth - 1;
          Height := qrbHj.Height;
          if rbHjSx.Checked then
            Pen.Style := psSolid
          else
            Pen.Style := psDashDot;
          case cbHjHx.ItemIndex of
            0: Shape := qrsRectangle;
            1: Shape := qrsTopAndBottom;
            2: Shape := qrsRightAndLeft;
            3: Enabled := false;
          end;
        end;
        if i = 0 then
        begin
          CLabel := TQRLabel.Create(self);
          with CLabel do
          begin
            Parent := qrbHj;
            Caption := '合计';
            Alignment := taCenter;
            Top := Trunc(TextHeight(mmoHj.Font, 'A') * StrToFloat(edtHjXj.Text)) div 2;
            Left := intLeft + TextWidth(mmoNy.Font, 'A') div 2;
            Width := CShape.Width - TextWidth(mm