tsprintdbgrid.pas

企业进销存管理系统

       if (iLeft + Round(ColWidth(aColumn.Width)/2)) > (qrGrid.Page.Width - qrGrid.Page.RightMargin) then
       begin
         FMaxCols := i - 1;
         break;
       end;
       // First create a column heading
       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);
           if Font.Size < 8 then
              Font.Size := 8;
           Alignment  := TAlignment(aColumn.Alignment);
           Font.Style := [fsBold, fsUnderline];
           Left  := iLeft;
           Size.Top   := 4;
           Size.Width := ColWidth(aColumn.Width);
         end;
         FControls.Add(aReportLabel);
       end;
       
       if FGrid.PrintTotals and aColumn.PrintTotals then
          AddReportTotal;

       // Then create the label for data in the detailband...
       if (aColumn is TtsDbCol) and
          (TtsDbCol(aColumn).Field <> Nil) and
          (TtsDbCol(aColumn).Field.DatasetField <> Nil) and
          (TtsDbCol(aColumn).Field.DatasetField.DataType = ftMemo) then
          AddRichText
       else if (aColumn.ControlType = ctPicture) or
               (aColumn.ControlType = ctCheck) then
          AddImage
       else
          AddLabel;
       iLeft := NextColumnPos(iLeft, aColumn);
       Inc(printCol);
    end;
    Inc(i);
  end;
end;

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

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

procedure TfmPrintDbGrid.LoadBookmarks;
var sCurr : String;
begin
  FBookmarks.Clear;
  sCurr := FGrid.DataSource.DataSet.Bookmark;
  FGrid.BeginUpdate;
  FGrid.DataSource.DataSet.DisableControls;
  try
    with TtsDbGrid(FGrid).DataSource.DataSet do
    begin
      First;
      while not eof do
      begin
        FBookmarks.Add(Bookmark);
        Next;
      end;
    end;
  finally
    FGrid.DataSource.DataSet.Bookmark := sCurr;
    FGrid.EndUpdate;
    FGrid.DataSource.DataSet.EnableControls;
  end;
end;

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

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

procedure TfmPrintDbGrid.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  TfmPrintDbGrid.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 TfmPrintDbGrid.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 := ftCurrency;
      end
      else if (sValue[i] = ThousandSeparator) then
        System.Delete(sValue, i, 1)
      else if (sValue[i] = DecimalSeparator) then
        ColumnReportTotal(iCol).FDataType := ftFloat
      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 TfmPrintDbGrid.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 TfmPrintDbGrid.qrGridNeedData(Sender: TObject; var MoreData: Boolean);
var iIndex, DataCol : integer;
    aReportLabel : TQRLabel;
    aReportImage : TQRImage;
    aReportRichText : TQRRichText;
    aHeader : TtsCol;
    FCurrentBookmark : String;
    Cancel : Boolean;

    procedure ApplyFormat(aControl : TQRLabel);
    begin
      aControl.ParentFont := True;
      aControl.Color := bnDetail.Color;
		  if FGrid.CellColor[DataCol, FCurrentBookmark] <> clNone then
			  aControl.Color := FGrid.CellColor[DataCol, FCurrentBookmark]
      else
      begin
        if (FGrid.DrawOverlap = doDrawRowOnTop) then
        begin
          if (FGrid.RowColor[FCurrentBookmark] <> clNone) then
             aControl.Color := FGrid.RowColor[FCurrentBookmark]
          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[FCurrentBookmark] <> clNone) then
             aControl.Color := FGrid.RowColor[FCurrentBookmark];
        end;
      end;
			if FGrid.CellFont[DataCol, FCurrentBookmark] <> nil then
         aControl.Font.Assign(FGrid.CellFont[DataCol, FCurrentBookmark])
      else
			begin
        if (FGrid.DrawOverlap = doDrawRowOnTop) then
        begin
          if (FGrid.RowFont[FCurrentBookmark] <> Nil) then
             aControl.Font.Assign(FGrid.RowFont[FCurrentBookmark])
          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[FCurrentBookmark] <> Nil) then
             aControl.Font.Assign(FGrid.RowFont[FCurrentBookmark])
          else
             aControl.Font.Color  := FGrid.Font.Color;
        end;
			end;
			if Assigned(FGrid.OnGetDrawInfo) then
			begin
        ClearDrawInfo;
				FGrid.OnGetDrawInfo(FGrid, DataCol, FCurrentBookmark, 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, FCurrentBookmark]);
  		    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
        if (VarType(FGrid.Cell[DataCol, FCurrentBookmark]) = varEmpty) then
           aReportImage.Picture.Assign(FUncheckedBitmap)
        else if (FGrid.CellCheckBoxState[DataCol, FCurrentBookmark] = cbChecked) then
           aReportImage.Picture.Assign(FCheckedBitmap)
        else
           aReportImage.Picture.Assign(FUncheckedBitmap);
      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, FCurrentBookmark];
      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, FCurrentBookmark];
    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;
          FGrid.DoPrintCell(i, FCurrentBookmark, 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;    // case              
            end;    // if
          end;
        end;
        Inc(i);
      end;
    end;

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

    FGrid.DataSource.DataSet.Bookmark := FBookmarks.Strings[FRow-1];
    FCurrentBookmark := FGrid.DataSource.DataSet.Bookmark;

    if FGrid.RowVisible[FCurrentBookmark] then
    begin
      // Cancel Print Row?
      Cancel := False;
      FGrid.DoPrintRow(FCurrentBookmark, 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;
  end;
  Inc(FRow);
  laRecordCount.Caption := IntToStr(FRowCount) + ' Records ';
end;

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

procedure TfmPrintDbGrid.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 TfmPrintDbGrid.qrGridAfterPrint(Sender: TObject);
begin
  FRow := 1;
  FRowCount := 0;
end;

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

procedure TfmPrintDbGrid.qrGridBeforePrint(Sender: TCustomQuickRep;
  var PrintReport: Boolean);
begin
  ConfigureColumns(FGrid);
  if (FGrid.DataSource.DataSet.RecordCount > 0) then
     LoadBookmarks;
  PrintReport := (FGrid.Rows > 0);
  FRow := 1;
  FRowCount := 0;
end;

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

procedure TfmPrintDbGrid.SetGrid(aCustomDbGrid : TtsCustomDbGrid);
begin
  FGrid := TtsDbGrid(aCustomDbGrid);
end;

end.