OutCanvas.TextOut

timk5020

Hello Julian,
I am drawing on the canvas of my wpRichText. I am drawing sound rounded rectangles and using TextOut to put some words within these boxes. I am setting the font size and I have to set it rather large to get it to look right on my monitor (on the computer). 50. But thats fine and doesn't hurt anything. But when I print the document out while my rectangles appear correctly my textout is huge. I have countered this issue with changing the font of the textout down to 8 just before I print.

I was wondering if there was a simpler way to do this or even just an explanation of why it is this way.

Thank you Julian,
Timk

support

Hi,

Check out the demo Watermark. Drawing to the "canvas" directly will not be prited.

Code

procedure TWaterM2Demo.WPRichText1MeasureTextPage(Sender: TObject;
  PageInfo: TWPMeasurePageParam);
begin
  // We want to make sure the first page has a bottom margin which is
  // large enough for our form
  if PageInfo.pagenr = 1 then
  begin
    PageInfo.marginbottom := WPCentimeterToTwips(PR_Form_Height);
    PageInfo.changed := TRUE;
  end;
end;


procedure TWaterM2Demo.WPRichText1PaintWatermark(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas; PageRect: TRect;
  PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject; XRes,
  YRes: Integer; CurrentZoom: Single; PaintMode: TWPPaintModes);
  // ~~~~~~~~~~~~~~~~~~~~~ Convert CM values into pixel ~~~~~~~~~~~~~
  function XP(cm: Double): Integer;
  begin
    Result := MulDiv(WPCentimeterToTwips(cm), Xres, 1440);
  end;
  function YP(cm: Double): Integer;
  begin
    Result := MulDiv(WPCentimeterToTwips(cm), Yres, 1440);
  end;
  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var r, r2: TRect;
  off, w: Integer;
  i, j : Integer;
begin
  if PaintPageNr = 0 then
  begin
    r := PageRect;
    r.Top := r.Bottom - YP(PR_Form_Height);
    toCanvas.Pen.Color := clBlack;
    toCanvas.Pen.Style := psSolid;
    toCanvas.Pen.Width := XRes div 60; // width = 1/60 INCH


    // WPDrawDashes draws a dashed line with a distance of 1/8 inch (inchdivisor)
    // between dashes (Reason to use WPDrawDashes(): psDash is not printed well)
    WPDrawDashes( toCanvas, XRes, r.TopLeft, Point(r.Right, r.Top));


    // Draw the form at the right bottom border
    r.Left := r.Right - XP(PR_Form_Width);


    // Draw line
    WPDrawDashes( toCanvas, XRes, r.TopLeft, Point(r.Left, r.Bottom));


    // Reset Pen Width
    toCanvas.Pen.Width := 0;


    // Draw the sizzors
    toCanvas.Font.Name := 'WingDings';
    toCanvas.Font.Height := -YP(0.5);
    toCanvas.TextOut( PageRect.Left + XP(0.9), r.Top-
       toCanvas.TextHeight(#$22) div 2 , #$22 );


     // This is background of the form, we do not draw this when
     // we are printing!
    if wppInPaintDesktop in PaintMode then
    begin
      r2 := r;
      inc(r2.Left,XP(0.1));
      inc(r2.Top,YP(0.1));
      toCanvas.Brush.Color := clYellow;
      toCanvas.FillRect(r2);
    end;


     // This are the form text
    toCanvas.Brush.Color := clWhite;
    toCanvas.Font.Name := 'Courier New';
    toCanvas.Font.Height := -YP(0.5);
    toCanvas.Font.Style := [fsBold];
    off := YP(0.1);


     // NAME
    r2.Left := r.Left + XP(1.0);
    r2.Top := r.Top + YP(2);
    r2.Right := r2.Left + XP(10);
    r2.Bottom := r2.Top + YP(0.7);
    toCanvas.FillRect(r2);
    toCanvas.TextOut(r2.Left + off, r2.Top + off, NameE.Text);


     // ADR
    r2.Left := r.Left + XP(1.0);
    r2.Top := r.Top + YP(5.5);
    r2.Right := r2.Left + XP(10);
    r2.Bottom := r2.Top + YP(0.7);
    toCanvas.FillRect(r2);
    toCanvas.TextOut(r2.Left + off, r2.Top + off, AdrE.Text);


     // COST, right aligned
    r2.Left := r.Left + XP(8.5);
    r2.Top := r.Top + YP(4.5);
    r2.Right := r2.Left + XP(5);
    r2.Bottom := r2.Top + YP(0.7);
    toCanvas.FillRect(r2);
    w := toCanvas.TextWidth(CostE.Text);
    toCanvas.TextOut(r2.Right - off - w, r2.Top + off, CostE.Text);


    // For Debugging
    // Draw a Line at 10,10 CM
    if DrawDebugCross.Checked then
    begin
    toCanvas.TextOut( PageRect.Left+XP(10), PageRect.Top, '10');
    toCanvas.TextOut( PageRect.Left, PageRect.Top+YP(10), '10');
    toCanvas.MoveTo( PageRect.Left, PageRect.Top + YP(10));
    toCanvas.LineTo( PageRect.Right, PageRect.Top + YP(10));
    toCanvas.MoveTo( PageRect.Left+XP(10), PageRect.Top);
    toCanvas.LineTo( PageRect.Left+XP(10), r.Top);
    end;
  end else
  // Draw and Print a Grid
  if PaintPageNr = 1 then
  begin
    toCanvas.Pen.Width := 0;
    toCanvas.Pen.Color := $00FAD5AF;
    toCanvas.Pen.Style := psSolid;
    for i:=1 to 1000 do
    begin
      j := PageRect.Left + MulDiv(WPCentimeterToTwips(0.5 * i), Xres, 1440);
      if j>= PageRect.Right then break;
      toCanvas.MoveTo(j, PageRect.Top);
      toCanvas.LineTo(j, PageRect.Bottom);
    end;


    for i:=1 to 1000 do
    begin
      j := PageRect.Top + MulDiv(WPCentimeterToTwips(0.5 * i), Yres, 1440);
      if j>= PageRect.Bottom then break;
      toCanvas.MoveTo(PageRect.Left, j);
      toCanvas.LineTo(PageRect.Right, j);
    end;
  end
  // Display a tiled background only on screen
  else if wppInPaintDesktop in PaintMode then
      PrintTiledBackground(toCanvas,PageRect, XRes / Screen.PixelsPerInch); 
end;

Alles anzeigen