qrprev.~pas

delphi7报表打印控件源码 可以设计报表

        // have to reset the thumbs with this call
        QRPreviewPageAvailable(self, 1);
        thumbGrid.Row := 0;
        PrintSetup.Enabled := False;
        Print.Enabled := true;
      end
      else
        ShowMessage(SqrFileNotExist);
  finally
    free;
  end;
end;

procedure TQRStandardPreview.QRPreviewPageAvailable(Sender: TObject; PageNum: Integer);
begin
  UpdateInfo;
  ThumbGrid.RowCount := QRPrinter.PageCount;
  ThumbGrid.Invalidate;
  if qrprinter.status = mpFinished then
  begin
    PrintSetup.Enabled := true;
    Print.Enabled := true;
  end;
end;

procedure TQRStandardPreview.QRPreviewProgressUpdate(Sender: TObject; Progress: Integer);
var
  AProgress: integer;
begin
  if Progress >= LastProgress + 5 then
  begin
    StatusBar.Panels[0].Text := IntToStr(Progress) + '%';
    LastProgress := Progress;
  end;
  if (Progress = 0) or (Progress = 100) then StatusBar.Panels[0].Text := '';
end;

procedure TQRStandardPreview.FormCreate(Sender: TObject);
begin
  HorzScrollbar.Tracking := true;
  VertScrollbar.Tracking := true;
  TResizeGrid(ThumbGrid).OnResize := ResizeThumb;
   //if QRPrinter.PageCount<2 then Tabs.Width := 0;
end;

procedure TQRStandardPreview.QRPreviewHyperlink(Sender: TObject;
  EventType: TQRHyperlinkEventType; Link: string; var Handled: Boolean);
begin
  Statusbar.Panels[2].Text := Link;
end;

procedure TQRStandardPreview.OutlineViewChange(Sender: TObject; Node: TTreeNode);
var
  NewPage: integer;
  ARect: TRect;
begin
  QRPrinter.PageList.QROutline.FindPosition(Node, ARect, NewPage);
  if NewPage > 0 then
  begin
    QRPreview.PageNumber := NewPage;
    UpdateInfo;
  end;
end;

procedure TQRStandardPreview.ResizeThumb(Sender: TObject);
begin
  ThumbFontHeight := ThumbGrid.Canvas.TextHeight('P');
  ThumbGrid.DefaultColWidth := ThumbGrid.Width - 4;
  if FReportOrientation = poPortrait then
  begin
    ThumbDrawWidth := Round((ThumbGrid.DefaultColWidth - 20));
    ThumbDrawHeight := Round((ThumbDrawWidth / QRPrinter.PaperWidth) * QRPrinter.PaperLength - ThumbFontHeight);
  end
  else
  begin
    ThumbDrawWidth := Round((ThumbGrid.DefaultColWidth - 20));
    ThumbDrawHeight := Round((ThumbDrawWidth / QRPrinter.PaperLength) * QRPrinter.PaperWidth - ThumbFontHeight);
  end;

  ThumbGrid.DefaultRowHeight := ThumbDrawHeight;
  ThumbLeftMargin := Round((ThumbGrid.DefaultColWidth - ThumbDrawWidth) / 2);
  ThumbTopMargin := Round((ThumbGrid.DefaultRowHeight - ThumbDrawHeight) / 2);
end;

procedure TQRStandardPreview.ThumbGridDrawCell(Sender: TObject; ACol, ARow: Integer; ARect: TRect; State: TGridDrawState);
var
  APage: TMetafile;
begin
  APage := QRPrinter.GetPage(ARow + 1);
  if APage <> nil then
    PaintPageToCanvas(APage, ThumbGrid.Canvas, Rect(ARect.Left + ThumbLeftMargin, ARect.Top + 10,
      ARect.Right - 30, ARect.Bottom - 10), true);
  ThumbGrid.Canvas.Brush.Color := clBtnFace;
  ThumbGrid.Canvas.Textout(ARect.Left, ARect.Top, IntToStr(ARow + 1));
  APage.Free;
end;

procedure TQRStandardPreview.ThumbGridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
  if ThumbUpdating then exit;
  QRPreview.PageNumber := ARow + 1;
  UpdateInfo;
end;

function TQRStandardPreview.GetTextSearch(var MatchCase: boolean; var AText: string): boolean;
var
  SrchDlg: TSearchDlg;
begin
  AText := '';
  Result := false;
  SrchDlg := TSearchDlg.Create(self);
  srchDlg.ShowModal;
  if srchDlg.cancel then
  begin
    SrchDlg.Free;
    exit;
  end;
  Result := true;
  srchDlg.GetText(AText);
  MatchCase := srchDlg.GetCase;
  SrchDlg.Free;
end;

procedure TQRStandardPreview.FindButtonClick(Sender: TObject);
var
  FindStr: string;
  MatchCase: boolean;
  I: integer;
  APage: TMetafile;
  Dummy: TList;
begin
  if GetTextSearch(MatchCase, FindStr) then
  begin
    SearchResultBox.Enabled := true;
    SearchTextLabel.Caption := FindStr;
    SearchResultBox.Items.Clear;
    for I := 1 to QRPrinter.PageCount do
    begin
      APage := QRPrinter.GetPage(I);
      try
        if StrInMetafile(FindStr, APage, MatchCase) then
          SearchResultBox.Items.Add('第 ' + IntToStr(I) + ' 页');
      finally
        APage.Free;
      end;
    end;
    if SearchResultBox.Items.Count = 0 then
    begin
      SearchResultBox.Items.Add('没有匹配的文本');
      SearchResultBox.Enabled := false;
    end;
  end;
end;

procedure TQRStandardPreview.GotoPageButtonClick(Sender: TObject);
var
  Pnum, K: integer;
  PNStr: string;
  CaptionStr: string;
begin
  CaptionStr := format(SqrGotoPage, [QRPrinter.PageCount]);
  PNStr := format('%d', [QRPreview.PageNumber]);
  InputQuery(CaptionStr, '跳到页 >>', PNStr);
  val(PNStr, Pnum, K);
  if (Pnum < 1) or (Pnum > QRPrinter.PageCount) then
    Pnum := 1;
  SelectPage(Pnum);
end;

procedure TQRStandardPreview.JPG1Click(Sender: TObject);
var
  aImage: TImage;
  APage: TMetafile;
  aJpeg: Tjpegimage;
begin
  with TSaveDialog.Create(Application) do
  try
    Filter := 'BMP位图|*.bmp|JPG图片|*.jpg|单色位图|*.bmp|16色位图|*.bmp|256色位图|*.bmp';
    DefaultExt := '.bmp';
    if Execute then
    begin
      ZoomTo100Click(Sender);
      try
        APage := QRPrinter.GetPage(QRPreview.PageNumber);
        if apage <> nil then
        try
          aImage := TImage.Create(nil);
          if FReportOrientation = poPortrait then
          begin
            aImage.Height := Round(QRPreview.QRPrinter.PaperLength * 0.3795);
            aImage.Width := Round(QRPreview.QRPrinter.PaperWidth * 0.3795);
          end
          else
          begin
            aImage.Width := Round(QRPreview.QRPrinter.PaperLength * 0.3795)-4;
            aImage.Height := Round(QRPreview.QRPrinter.PaperWidth * 0.3795)-4;
          end;
          PaintPageToCanvas(APage, aImage.Canvas, Rect(-1, -1,
            aImage.Width+3, aImage.Height+3), true);
          aImage.Canvas.Brush.Color := clWhite;
          aImage.Canvas.Textout(10, 10, 'BN ' + DateTimeToStr(Now()));
          case FilterIndex of
            1: begin
                DefaultExt := '.bmp';
                aImage.Picture.SaveToFile(FileName);
              end;
            2: begin
                try
                  DefaultExt := '.jpg';
                  aJpeg := Tjpegimage.Create;
                  aJpeg.Assign(aImage.Picture.Bitmap);
                  aJpeg.SaveToFile(FileName);
                finally
                  aJpeg.Free;
                end;
              end;
            3: begin //2
                aImage.Picture.Bitmap.PixelFormat := pf1bit;
                DefaultExt := '.bmp';
                aImage.Picture.SaveToFile(FileName);
              end;
            4: begin //16
                aImage.Picture.Bitmap.PixelFormat := pf4bit;
                DefaultExt := '.bmp';
                aImage.Picture.SaveToFile(FileName);
              end;
            5: begin //256
                aImage.Picture.Bitmap.PixelFormat := pf8bit;
                DefaultExt := '.bmp';
                aImage.Picture.SaveToFile(FileName);
              end;
          else
            begin
              DefaultExt := '.bmp';
              aImage.Picture.SaveToFile(FileName);
            end;
          end;
        finally
          aImage.Free;
        end;
      finally
        APage.Free;
      end;
    end;
  finally
    Free;
  end;
end;

procedure TQRStandardPreview.N1Click(Sender: TObject);
var
  FileExt: string;
  aPDFFilt: TQRPDFDocumentFilter;
  aHTMLFilter: TQRGHTMLDocumentFilter;
  aRTFFilter: TQRRTFExportFilter;
  aExcelFilter: TQRXLSFilter;
  aWMFFilter: TQRWMFExportFilter;
  aCSVFilter: TQRCommaSeparatedFilter;
  aTextFilter: TQRAsciiExportFilter;
begin
  with TSaveDialog.Create(Application) do
  try
    Title := '另存报表为pdf或htm';
    Filter := 'PDF文件|*.pdf|HTM网页|*.htm|' +
      'RTF写字板文件|*.rtf|EXCEL电子表格|*.xls|' +
      'WMF文件|*.wmf|CSV文件|*.csv|' +
      'TEXT文本文件|*.txt';
    DefaultExt := '.pdf';
    if Execute then
    begin
      case FilterIndex of
        1: begin //PDF文件|*.pdf   aPDFFilt: TQRPDFDocumentFilter;
            try
              DefaultExt := '.dbf';
              aPDFFilt := TQRPDFDocumentFilter.Create(FileName);
              aPDFFilt.AddFontMap('Bookman-Old-Style:SIMYOU');
              aPDFFilt.TextOnTop := true;
              aPDFFilt.Concatenating := true;
              QRPreview.QRPrinter.ExportToFilter(aPDFFilt);
              aPDFFilt.EndConcat;
            finally
              aPDFFilt.Free;
            end;
          end;
        2: begin //HTM网页|*.htm|    aHTMLFilter: TQRHTMLDocumentFilter;;
            try
              DefaultExt := '.htm';
              aHTMLFilter := TQRGHTMLDocumentFilter.Create(FileName);
              //aHTMLFilter.TransparentTextBG := true;
              //aHTMLFilter.PictureDir := 'Pics';
              //aHTMLFilter.MultiPage := true;
              //aHTMLFilter.PageLinks := false;
              QRPreview.QRPrinter.ExportToFilter(aHTMLFilter);
            finally
              aHTMLFilter.Free;
            end;
          end;
        3: begin //RTF写字板文件|*.rtf    aRTFFilter: TQRRTFExportFilter;
            try
              DefaultExt := '.rtf';
              aRTFFilter := TQRRTFExportFilter.Create(FileName);
              QRPreview.QRPrinter.ExportToFilter(aRTFFilter);
            finally
              aRTFFilter.Free;
            end;
          end;
        4: begin //EXCEL电子表格|*.xls|   aExcelFilter: TQRXLSFilter;
            try
              DefaultExt := '.xls';
              aExcelFilter := TQRXLSFilter.Create(FileName);
              Try
                QRPreview.QRPrinter.ExportToFilter(aExcelFilter);
              Except
              end;
            finally
              aPDFFilt.Free;
            end;
          end;
        5: begin // WMF文件|*.wmf     aWMFFilter:TQRWMFExportFilter;
            try
              DefaultExt := '.wmf';
              aWMFFilter := TQRWMFExportFilter.Create(FileName);
              QRPreview.QRPrinter.ExportToFilter(aWMFFilter);
            finally
              aWMFFilter.Free;
            end;
          end;
        6: begin //CSV文件|*.csv|    aCSVFilter: TQRCommaSeparatedFilter;
            try
              DefaultExt := '.csv';
              aCSVFilter := TQRCommaSeparatedFilter.Create(FileName);
              QRPreview.QRPrinter.ExportToFilter(aCSVFilter);
            finally
              aCSVFilter.Free;
            end;
          end;
        7: begin //TEXT文本文件|*.txt    aTextFilter: TQRTextFilter;
            try
              DefaultExt := '.txt';
              aTextFilter := TQRAsciiExportFilter.Create(FileName);
              QRPreview.QRPrinter.ExportToFilter(aTextFilter);
             finally
              aTextFilter.Free;
            end;
          end;
      end;
    end;
  finally
    Free;
  end;
end;

end.