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;
{ This procedure draws a tiled background.
Optionally a w/h multiplicator can be provided. This is required to see the same
display on different resolutions }
procedure TWaterM2Demo.PrintTiledBackground(toCanvas : TCanvas; PageRect : TRect; Mult : Double = 1);
var x,y : Integer;
bit : TBitmap;
begin
x := PageRect.Left;
bit := Image1.Picture.Bitmap;
if Abs(Mult-1)<0.01 then
while x<PageRect.Right do
begin
y := PageRect.Top;
while y<PageRect.Bottom do
begin
toCanvas.Draw(x,y,bit);
inc(y, bit.Height);
end;
inc(x, bit.Width);
end else
while x<PageRect.Right do
begin
y := PageRect.Top;
while y<PageRect.Bottom do
begin
toCanvas.StretchDraw(Rect(x,y, Round(x + bit.Width * mult), Round(y + bit.Height * mult)),bit);
inc(y, Round(bit.Height*mult));
end;
inc(x, Round(bit.Width*mult));
end
end; |