打印stringgrid内容.txt

大量Delphi开发资料

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( '?y' );

          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 }