怎么打印RichEdit,StringGrid等控件中的内容。

Question

怎么打印RichEdit,StringGrid等控件中的内容。

Answer 1

Procedure TACDListerMain.PrintTable;
  Var
    margins: TRect;
    spacing: Integer;
    Cols: TList;
    Dlg: TPrintProgressDlg;  Procedure SetColumnWidth;
    Var
      i, k, w: Integer;
    Begin
      Printer.Canvas.Font.Style := [ fsBold ];
      For i := 0 To Pred( Grid.ColCount ) Do
        Cols.Add( Pointer( Printer.Canvas.TextWidth( Grid.Cells[ i,0 ] )));      Printer.Canvas.Font.Style := [];
      For i := 1 To Pred( Grid.RowCount ) Do
        For k := 0 To Pred( Grid.ColCount ) Do Begin
          w:= Printer.Canvas.TextWidth( Grid.Cells[ k, i ] );
          If w > Integer( Cols[ k ] ) Then
            Cols[ k ] := Pointer( w );
        End; { For }      w := 2 * Printer.Canvas.Font.PixelsPerInch div 3;
      margins :=
        Rect( w, w, Printer.PageWidth-w, Printer.PageHeight - w );
      spacing := Printer.Canvas.Font.PixelsPerInch div 10;      w := 0;
      For i := 0 To Pred(cols.Count) Do
        w := w + Integer( cols[ i ] ) + spacing;
      w := w - spacing;
      If w > (margins.right-margins.left ) Then Begin
        w := w - (margins.right-margins.left );
        cols[ cols.Count-2 ] :=
          Pointer( Integer( cols[ cols.Count-2 ] ) - w );
      End; { If }      w:= 0;
      For i := 0 To Pred(cols.Count) Do
        w := w + Integer( cols[ i ] ) + spacing;
      margins.right := w - spacing + margins.left;
    End; { SetColumnWidth }  Procedure DoPrint;
    Var
      i: Integer;
      y: Integer;
    Procedure DoLine(lineno: Integer);
      Var
        x, n: Integer;
        r: TRect;
        th: Integer;
      Begin
        If Length(Grid.Cells[0,lineno]) = 0 Then Exit;        x:= margins.left;
        With Printer.Canvas Do Begin
          th := TextHeight( '膟' );
          For n := 0 To Pred( Cols.Count ) Do Begin
            r := Rect( 0, 0, Integer(Cols[ n ]), th);
            OffsetRect( r, x, y );
            TextRect( r, x, y, Grid.Cells[ n, lineno ] );
            x := r.right + spacing;
          End; { For }
        End; { With }
        y := y + th;
      End; { DoLine }
    Procedure DoHeader;
      Begin
        y:= margins.top;
        With Printer.Canvas Do Begin
          Font.Style := [ fsBold ];
          DoLine( 0 );
          Pen.Width := Font.PixelsPerInch div 72;
          Pen.Color := clBlack;
          MoveTo( margins.left, y );
          LineTo( margins.right, y );
          Inc( y, 2 * Pen.Width );
          Font.Style := [ ];
        End; { With }
      End; { DoHeader }
    Begin
      y:= 0;
      For i := 1 To Pred( Grid.RowCount ) Do Begin
        Dlg.Progress( i );
        Application.ProcessMessages;
        If FPrintAborted Then Exit;        If y = 0 Then
          DoHeader;
        DoLine( i );
        If y >= margins.bottom Then Begin
          Printer.NewPage;
          y:= 0;
        End; { If }
      End; { For }
    End; { DoPrint }  Begin
    FPrintAborted := False;
    Dlg := TPrintProgressDlg.Create( Application );
    With Dlg Do
    try
      OnAbort := PrintAborted;
      Display( cPrintPreparation );
      SetProgressRange( 0, Grid.RowCount );
      Show;
      Application.ProcessMessages;
      Printer.Orientation := poLandscape;      Printer.BeginDoc;
      Cols:= Nil;
      try
        Cols:= TLIst.Create;
        Printer.Canvas.Font.Assign( Grid.Font );
        SetColumnWidth;
        Display( cPrintProceeding );
        Application.ProcessMessages;
        DoPrint;
      finally
        Cols.Free;
        If FPrintAborted Then
          Printer.Abort
        Else
          Printer.EndDoc;
      end;
    finally
      Close;
    End; { With }
  End; { TACDListerMain.PrintTable