tsprintgrid.pas

企业进销存管理系统

  bnDetail.Font.Name := FGrid.Font.Name;
  bnDetail.Font.Size := Round(FGrid.Font.Size / FHorzScale);
  if bnDetail.Font.Size < FGrid.GridReport.MinFontSize then
     bnDetail.Font.Size := FGrid.GridReport.MinFontSize; 
  FcellDrawInfo.Font := TFont.Create;
  if FGrid.HeadingOn then
     bnColumnHeader.Height := FGrid.HeadingHeight + 4
  else
     bnColumnHeader.Height := 0;

  i := 1;
  printCol := 1;
  iLeft := 2;
  while (printCol <= FMaxCols) and (i <= FGrid.Cols) do
  begin
    aColumn := FGrid.Col[FGrid.DataColnr[i]];
    if (aColumn <> Nil) and
       (aColumn.Visible) and
       (((aColumn.Selected) and (FGrid.ColSelectMode = csMulti)) or
        (FGrid.ColSelectMode = csNone) or (FGrid.SelectedCols.Count = 0))  then
    begin
       if (iLeft + ColWidth(aColumn.Width)) > (qrGrid.Page.Width - qrGrid.Page.LeftMargin - qrGrid.Page.RightMargin) then
       begin
         FMaxCols := i - 1;
         break;
       end;
       // First create a column heading if HeadingOn
       if FGrid.HeadingOn then
       begin
         aReportLabel := TQRLabel.Create(qrGrid);
         aReportLabel.Parent   := bnColumnHeader;
         aReportLabel.AutoSize := False;
         aReportLabel.Caption  := aColumn.Heading;
         aReportLabel.WordWrap := (aColumn.WordWrap = wwOn) or ((FGrid.WordWrap = wwOn) and (aColumn.WordWrap = wwDefault));
         aReportLabel.Height   := bnColumnHeader.Height - 2;
         with aReportLabel do
         begin
           Name := 'Header' + IntToStr(i);
           Font.Size := Round(FGrid.HeadingFont.Size / FHorzScale);
           Alignment  := TAlignment(aColumn.Alignment);
           Font.Style := [fsBold, fsUnderline];
           Left  := iLeft;
           Size.Top   := 4;
           Size.Width := ColWidth(aColumn.Width);
           Caption    := aColumn.Heading;
         end;
         FControls.Add(aReportLabel);
       end;

       if FGrid.PrintTotals and aColumn.PrintTotals then
          AddReportTotal;

       // Then create the label for data in the detailband...
       if (aColumn.ControlType = ctPicture) or
          (aColumn.ControlType = ctCheck) then
          AddImage
       else
          AddLabel;
       iLeft := NextColumnPos(iLeft, aColumn);
       Inc(printCol);
    end;
    Inc(i);
  end;    // for
end;

function TfmPrintGrid.NextColumnPos(Left : Integer; aColumn : TtsCol) : Integer;
begin
  Result := Left + ColumnSeparation + ColWidth(aColumn.Width);
end;

function TfmPrintGrid.ColWidth(Width : Integer) : Integer;
begin
  Result := Round(Width / FHorzScale);
end;

procedure TfmPrintGrid.Print;
begin
  // Print without Preview...
  FRow := 1;
  try
    qrGrid.Print;
  except on E:Exception do
    raise Exception.Create('Error previewing report ' + E.Message);
  end;
  FRow := 1;
end;

procedure TfmPrintGrid.PreView;
begin
  FRow := 1;
  try
    qrGrid.Preview;
  except on E:Exception do
    raise Exception.Create('Error previewing report ' + E.Message);
  end;
  FRow := 1;
end;

procedure TfmPrintGrid.ClearDrawInfo;
begin
  FcellDrawInfo.Color := clNone;
  FcellDrawInfo.WordWrap := wwOff;
  FcellDrawInfo.Alignment := taLeftJustify;
  FcellDrawInfo.Font.Color := clNone;
  FcellDrawInfo.Font.Style := [];
  FcellDrawInfo.Font.Name := '';
  FcellDrawInfo.Font.Size := 0;
end;

function  TfmPrintGrid.ColumnReportTotal(iCol : Integer) : TosReportTotal;
var i : Integer;
begin
  Result := Nil;
  for i := 0 to FTotalControls.Count - 1 do
    if (TosReportTotal(FTotalControls.Items[i]).FColumn = iCol) then
    begin
      Result := TosReportTotal(FTotalControls.Items[i]);
      break;
    end;
end;

procedure TfmPrintGrid.IncrementColumnTotal(iCol : Integer; theLabel : TQRLabel);
var fValue : Double;
    i : Integer;
    sValue : String;
    bNegative : Boolean;
begin
  if (Trim(theLabel.Caption) <> '') and
     (ColumnReportTotal(iCol) <> Nil) then
  begin
    bNegative := False;
    // Remove commas and dollar signs first...
    sValue := Trim(theLabel.Caption);
    for i := Length(sValue) downto 1 do
      if (sValue[i] = CurrencyString) then
      begin
        System.Delete(sValue, i, 1);
        ColumnReportTotal(iCol).FDataType := 2;
      end
      else if (sValue[i] = ThousandSeparator) then
        System.Delete(sValue, i, 1)
      else if (sValue[i] = DecimalSeparator) then
        ColumnReportTotal(iCol).FDataType := 1
      else if (sValue[i] = '-') then
        bNegative := True
      else if (sValue[i] = '(') or (sValue[i] = ')') then
      begin
        bNegative := True;
        System.Delete(sValue, i, 1);
      end
      else if (sValue[i] IN ['a'..'z','A'..'Z', '!', '@', '#', '%', '^', '&', '*']) then
        exit;
    try
      fValue := StrToFloat(sValue);
    except
      fValue := 0;
    end;
    ColumnReportTotal(iCol).FTotal := ColumnReportTotal(iCol).FTotal + fValue;
    if bNegative then
       ColumnReportTotal(iCol).FIsNegative := True;
  end;
end;

procedure TfmPrintGrid.ShowReportTotals;
var iCol, DataCol : Integer;
begin
  for iCol := 1 to FMaxCols do
  begin
    DataCol := FGrid.DataColnr[iCol];
    if FGrid.Col[DataCol].PrintTotals and
       (ColumnReportTotal(DataCol) <> Nil) then
       ColumnReportTotal(DataCol).ShowTotal;
  end;
end;

procedure TfmPrintGrid.qrGridNeedData(Sender: TObject; var MoreData: Boolean);
var iIndex, DataCol, DataRow : integer;
    aReportLabel : TQRLabel;
    aReportImage : TQRImage;
    aReportRichText : TQRRichText;
    aHeader : TtsCol;
    Cancel : Boolean;

    procedure ApplyFormat(aControl : TQRLabel);
    begin
      aControl.ParentFont := True;
      aControl.Color := bnDetail.Color;
		  if FGrid.CellColor[DataCol, DataRow] <> clNone then
			  aControl.Color := FGrid.CellColor[DataCol, DataRow]
      else
      begin
        if (FGrid.DrawOverlap = doDrawRowOnTop) then
        begin
          if (FGrid.RowColor[DataRow] <> clNone) then
             aControl.Color := FGrid.RowColor[DataRow]
          else if (aHeader.Color <> clNone) then
             aControl.Color := aHeader.Color;
        end
        else
        begin
          if (aHeader.Color <> clNone) then
             aControl.Color := aHeader.Color
          else if (FGrid.RowColor[DataRow] <> clNone) then
             aControl.Color := FGrid.RowColor[DataRow];
        end;
      end;
			if FGrid.CellFont[DataCol, DataRow] <> nil then
         aControl.Font.Assign(FGrid.CellFont[DataCol, DataRow])
      else
			begin
        if (FGrid.DrawOverlap = doDrawRowOnTop) then
        begin
          if (FGrid.RowFont[DataRow] <> Nil) then
             aControl.Font.Assign(FGrid.RowFont[DataRow])
          else if (aHeader.Font <> Nil) then
             aControl.Font.Assign(aHeader.Font)
        end
        else
        begin
          if (aHeader.Font <> Nil) then
             aControl.Font.Assign(aHeader.Font)
          else if (FGrid.RowFont[DataRow] <> Nil) then
             aControl.Font.Assign(FGrid.RowFont[DataRow]);
        end;
			end;
			if Assigned(FGrid.OnGetDrawInfo) then
			begin
        ClearDrawInfo;
				FGrid.OnGetDrawInfo(FGrid, DataCol, DataRow, FcellDrawInfo);
        if FCellDrawInfo.Color <> clNone then
           aControl.Color := FCellDrawInfo.Color
        else
           aControl.Color := bnDetail.Color;
        if FCellDrawInfo.Font.Color <> clNone then
				   aControl.Font.Color := FcellDrawInfo.Font.Color
        else
           aControl.Font.Color := bnDetail.Font.Color;
        if FCellDrawInfo.Font.Style <> [] then
   				 aControl.Font.Style := FcellDrawInfo.Font.Style
        else
           aControl.Font.Style := [];
			end;
    end;

    procedure ShowImage;
    begin
		  aReportImage := TQRImage(aHeader.Data);
      aReportImage.Picture.Assign(Nil);
      if not Cancel then
      begin
        if FGrid.ImageList <> Nil then
        begin
          iIndex := FGrid.ImageList.NameIndex(FGrid.Cell[DataCol, DataRow]);
  		    if (iIndex >= 0) then
             aReportImage.Picture.Assign(FGrid.ImageList.Image[iIndex].Bitmap);
        end;
      end;
    end;

    procedure ShowCheck;
    begin
		  aReportImage := TQRImage(aHeader.Data);
      if Cancel then
         aReportImage.Picture.Assign(Nil)
      else
      begin
        try
          if (VarType(FGrid.Cell[DataCol, DataRow]) = varEmpty) then
             aReportImage.Picture.Assign(FUncheckedBitmap)
          else if (FGrid.CellCheckBoxState[DataCol, DataRow] = cbChecked) then
             aReportImage.Picture.Assign(FCheckedBitmap)
          else
             aReportImage.Picture.Assign(FUncheckedBitmap);
        except on e: Exception do
          aReportImage.Picture.Assign(FUncheckedBitmap);
        end;
      end;
    end;

    procedure ShowLabel;
    begin
			aReportLabel := TQRLabel(aHeader.Data);
      if FGrid.PrintWithGridFormats then
         ApplyFormat(aReportLabel);

      if Cancel then
         aReportLabel.Caption := ''
      else
        aReportLabel.Caption := FGrid.Cell[DataCol, DataRow];
      if FGrid.Col[DataCol].PrintTotals then
         IncrementColumnTotal(DataCol, aReportLabel);
    end;

    procedure ShowRichText;
    begin
			aReportRichText := TQRRichText(aHeader.Data);
      if Cancel then
         RichEdit1.Text := ''
      else
         RichEdit1.Text := FGrid.Cell[DataCol, DataRow];
    end;

    procedure PrintRow;
    var i : Integer;
        aColumn : TtsCol;
    begin
      Inc(FRecCnt);
      bnDetail.Height := FDetailHeight;
      i := 1;
      while (i <= FMaxCols) do
      begin
        aColumn := FGrid.Col[FGrid.DataColnr[i]];
        if aColumn.Visible and
           (((aColumn.Selected) and (FGrid.ColSelectMode = csMulti)) or
            (FGrid.ColSelectMode = csNone) or (FGrid.SelectedCols.Count = 0))  then
        begin
          // Cancel Print Cell?
          Cancel := False;
          DataRow := FGrid.DataRowNr[FRow];
          TtsCustomGrid_(FGrid).DoPrintCell(i, DataRow, Cancel);

          DataCol := aColumn.DataCol;
          aHeader := FGrid.Col[DataCol];
          if TObject(aHeader.Data) is TQRRichText then
             ShowRichText
          else
          begin
            if (aHeader.Data <> Nil) then
            begin
              case aHeader.ControlType of
                ctPicture : ShowImage;
                ctCheck   : ShowCheck;
              else
                ShowLabel;
              end;
            end;
          end;
        end;
        Inc(i);
      end;
    end;

begin
  if (FGrid <> Nil) and
     (FRow <= FGrid.Rows) then
  begin
    MoreData := True;

    if FGrid.RowVisible[FRow] then
    begin
      // Cancel Print Row?
      Cancel := False;
      TtsCustomGrid_(FGrid).DoPrintRow(FRow, Cancel);
      if not Cancel then
      begin
        if (FGrid.GridReport.PrintLineMode = lmBanded) and
           (FGrid.GridReport.PrintBandColor <> clNone) then
        begin
          if bnDetail.Color = FDetailColor then
             bnDetail.Color := clWhite
          else
             bnDetail.Color := FDetailColor;
        end;
        PrintRow;
        Inc(FRowCount);
      end
      else
        bnDetail.Height := 0;
      if (FRow = FGrid.Rows) and
         (FGrid.PrintTotals) then
         ShowReportTotals;
    end
    else
       bnDetail.Height := 0;
  end;
  Inc(FRow);
  laRecordCount.Caption := IntToStr(FRowCount) + ' Records ';
end;

procedure TfmPrintGrid.FormDestroy(Sender: TObject);
begin
  FcellDrawInfo.Font.Free;
  FCheckedBitmap.Free;
  FUnCheckedBitmap.Free;
  Initialize;
  FControls.Free;
  FTotalControls.Free;
  FBookmarks.Free;
  FGrid := Nil;
end;

procedure TfmPrintGrid.FormCreate(Sender: TObject);
begin
  FCheckedBitmap := TBitmap.Create;
  FUnCheckedBitmap := TBitmap.Create;
  ilImages.GetBitmap(1, FCheckedBitmap);
  ilImages.GetBitmap(0, FUnCheckedBitmap);
  FControls := TList.Create;
  FTotalControls := TList.Create;
end;

procedure TfmPrintGrid.qrGridAfterPrint(Sender: TObject);
begin
  FRow := 1;
  FRowCount := 0;
end;

procedure TfmPrintGrid.qrGridAfterPreview(Sender: TObject);
begin
  FRow := 1;
  FRowCount := 0;
end;

procedure TfmPrintGrid.qrGridBeforePrint(Sender: TCustomQuickRep;
  var PrintReport: Boolean);
begin
  ConfigureColumns(FGrid);
  PrintReport := (FGrid.Rows > 0);
  FRow := 1;
  FRowCount := 0;
end;

procedure TosReportTotal.ShowTotal;
begin
  try
    case FDataType of
      0  : FLabel.Caption := IntToStr(Round(FTotal));
      1  : FLabel.Caption := FormatFloat('#,##0.00;(#,##0.00)', FTotal);
      2  : FLabel.Caption := FormatFloat(CurrencyString + '#'+ThousandSeparator+'##0'+DecimalSeparator+'00;(' + CurrencyString + '#'+ThousandSeparator+'##0'+DecimalSeparator+'00)', FTotal);
    end;
  except
  end;
end;

procedure TfmPrintGrid.SetGrid(aCustomGrid : TtsCustomGrid);
begin
  FGrid := TtsGrid(aCustomGrid);
end;

end.