Print a TListView (2)

Problem/Question/Abstract:

I have 3 columns in my TListView (1 main item, 2 sub-items) and I've tried to print the text with the use of TPrintDialog but I've had no luck. I was thinking about using the TextRect Canvas property to accomplish this. I'm not using a TMemo so what would be the TListView text property to use here. I would like to print them out in the same format that they appear in the list view.

Answer:

There is a bit more to this than a single textrect call. The printer and your screen have very different resolutions, so the positions and sizes you get from the listview need to be scaled for the printer. For which you need the printers resolution. Some other pieces like printable area are also of interest:

{ ... }
type
  TPageInfo = record
    width, height: Integer; {physical width and height, in dots}
    offsetX, offsetY: Integer; {non-printable margin, in dots}
    resX, resY: Integer; {logical resolution, dots per inch}
  end;

procedure GetPageinfo(var info: TPageInfo; index: Integer = -1);
begin
  if index > -1 then
    Printer.PrinterIndex := index;
  with Printer do
  begin
    info.resX := GetDeviceCaps(handle, LOGPIXELSX);
    info.resY := GetDeviceCaps(handle, LOGPIXELSY);
    info.offsetX := GetDeviceCaps(handle, PHYSICALOFFSETX);
    info.offsetY := GetDeviceCaps(handle, PHYSICALOFFSETY);
    info.width := GetDeviceCaps(handle, PHYSICALWIDTH);
    info.height := GetDeviceCaps(handle, PHYSICALHEIGHT);
  end;
end;

Note that the following example assumes that the listview columns widths are > 0 (autosize = true or explicit column width set).

procedure TForm1.PrintButtonClick(Sender: TObject);
const
  colspacing = 12; {12 dots between columns}
var
  item: TListItem;
  info: TPageInfo;
  X, Y, leftMargin, TopMargin, BottomMargin: Integer;
  screenres: Integer;

  function ScreenToPrint(dim: Integer): Integer;
  begin
    result := (dim * info.resX) div screenres;
  end;

  procedure printHeader;
  var
    r: Trect;
    i: Integer;
  begin
    r.Left := X;
    r.top := Y;
    printer.canvas.Font.style := [fsBold];
    r.Bottom := r.Top + printer.canvas.TextHeight('�y');
    for i := 0 to listview1.columns.count - 1 do
    begin
      r.Right := r.Left + ScreenToPrint(listview1.column[i].Width);
      printer.canvas.TextRect(r, r.left, r.Top, listview1.Column[i].Caption);
      r.Left := r.Right + colspacing;
    end;
    printer.canvas.Font.style := [];
    printer.Canvas.Pen.Width := ScreenToPrint(2);
    printer.canvas.MoveTo(X, r.Bottom);
    printer.Canvas.Lineto(r.Right, r.Bottom);
    Y := r.Bottom + colspacing;
  end;

  procedure PrintItem;
  var
    r: Trect;
    i: Integer;
    s: string;
  begin
    if Y >= BottomMargin then
    begin
      printer.NewPage;
      Y := TopMargin;
      PrintHeader;
    end;
    r.Left := X;
    r.top := Y;
    r.Bottom := r.Top + printer.canvas.TextHeight('�y');
    for i := 0 to listview1.columns.count - 1 do
    begin
      r.Right := r.Left + ScreenToPrint(listview1.columns[i].Width);
      if i = 0 then
        S := item.caption
      else
        S := item.SubItems[i - 1];
      printer.canvas.TextRect(r, r.left, r.Top, S);
      r.Left := r.Right + colspacing;
    end;
    Y := r.Bottom + colspacing div 2;
  end;

var
  i: Integer;
begin
  if PrintDialog1.Execute then
  begin
    GetPageInfo(info);
    screenres := Screen.PixelsPerInch;
    try
      Printer.BeginDoc;
      Printer.Canvas.Font := listview1.Font;
      leftMargin := info.resX - info.offsetX; {1 inch left}
      topMargin := info.resY - info.offsetY; {1 inch top}
      bottomMargin := info.height - info.resY - info.offsetY; {1 inch}
      X := leftMargin;
      Y := topMargin;
      PrintHeader;
      for i := 0 to listview1.Items.Count - 1 do
      begin
        item := listview1.Items[i];
        PrintItem;
      end;
    finally
      Printer.EndDoc;
    end;
  end;
end;