🚀 go-pugleaf

In article <30D1FDAC.1B38@seg.ndhm.gtegsc.com>
           dalessio@seg.ndhm.gtegsc.com "Chris DAlessio" writes:

> This MSWord 6.0 field code is supposed to print the text "DRAFT" 
> diagonally across the page from lower left to upper right.
> 
> 
>         { PRINT  "/Arial 100 scalefont setfont
>         wp$x 2.8 div wp$y 3.5 div translate
>         0 setlinewidth
>         52.3 rotate 0 0 moveto (DRAFT) true charpath
>         gsave 1 setgray fill grestore stroke" }
> 
> It is only good at printing garbage across the top of the page.
> 
> Any hints?

If you have a PostScript printer try putting the following
print field in your header (you may need to adjust the page
size figures):

[NB You MUST create the field with the Insert Field command. DO NOT
try entering the outer pair of curly braces { } from the keyboard.]  

{Print \p page "/Helvetica findfont  100 scalefont setfont 
/LM  0 def
/RM  595.44 def
/dlength {(DRAFT) stringwidth } def
/psize {RM LM sub} def
/printDraft {0 0 moveto (DRAFT) show } def 
/halflen { dlength pop 2 div} def
/adjmt {90  52 sub sin 80 mul 2 div} def
psize 2 div
 841.68 2 div translate
 52 rotate
0 halflen sub
adjmt add
0 translate
.95 -.05 .3 %start incr.end
{setgray printDraft -1 .5 translate} for
.9 setgray printDraft "}

Note: The Helvetica font which is built into all PostScript printers 
has been used rather than the Arial font which would have to be
downloaded in Type 1 format first if not present on the Printer.
There is a way of doing this with TrueType fonts but you have to
first retrieve the mangled name which TrueType has used to download
the font in PS format to the printer.

The following Word macro will enable you to automate the process:
================================================================
(This came from the NewMacro document that was shipped with
Word for Windows 2 and has been automatically updated by Word 6.
It should work in the Mac version of Word 6 too)  
===========================================================
Sub MAIN
Rem WORD MACRO TO CREATE POSTSCRIPT WATERMARK
Rem for PostScript printers only !!!
If SelInfo(27) Then
     MsgBox "Command not available in a macro window"
     Goto bye
End If

fViewFieldCodes = ViewFieldCodes()
fViewOutline = ViewOutline()
fViewPage = ViewPage()
ViewNormal
REM the following lists would be used with popup box
Dim mptextfont$(2)
Rem 'You can change these font names to the names of 
    ' any of the core PostScript Fonts
mptextfont$(0) = "Courier"
mptextfont$(1) = "Helvetica"
mptextfont$(2) = "Times-Roman"
maxsize = 127
minsize = 4

Begin Dialog UserDialog 493, 270
     Text 18, 4, 40, 13, "&Text:"
     TextBox 18, 18, 289, 18, .usertext
     Text 18, 43, 40, 13, "&Font:"
     ComboBox 18, 60, 147, 61, mptextfont$(), .userfont
     Text 178, 43, 100, 13, "&Size: (points)"
     TextBox 178, 60, 129, 18, .usersize
     Text 178, 88, 71, 13, "Rotatio&n:"
     TextBox 178, 103, 129, 18, .userrotate
     GroupBox 338, 74, 132, 49, "Page"
     OptionGroup  .userpage
          OptionButton 349, 87, 48, 16, "&All"
          OptionButton 349, 105, 105, 16, "First &Page"
     GroupBox 18, 128, 148, 100, "Format:"
     CheckBox 30, 142, 83, 16, "All &Cap", .usercap
     CheckBox 30, 164, 63, 16, "Bol&d", .userbold
     CheckBox 30, 186, 67, 16, "&Italic", .useritalic
     CheckBox 30, 208, 91, 16, "S&hading", .usershade
     GroupBox 178, 128, 293, 100, "Position:"
     GroupBox 193, 146, 119, 71, "Vertical"
     OptionGroup  .userver
          OptionButton 203, 158, 59, 16, "T&op"
          OptionButton 203, 177, 79, 16, "&Middle"
          OptionButton 203, 195, 81, 16, "&Bottom"
     GroupBox 338, 146, 117, 70, "Horizontal"
     OptionGroup  .userhor
          OptionButton 348, 159, 59, 16, "&Left"
          OptionButton 348, 178, 79, 16, "C&enter"
          OptionButton 348, 195, 69, 16, "&Right"
     OKButton 338, 11, 130, 21
     CancelButton 338, 39, 130, 21
     Text 18, 244, 401, 13, "A PostScript printer must be used to print the results."
End Dialog

REM message for size too big
msg$ = "Font size need to be between" + Str$(minsize) + " and " + Str$(maxsize) + " .  Do you want to make any changes?"
msg1$ = "Degree of rotation needs to be between 0 and 90 "
Dim dlg As UserDialog
REM set default (You can change these default values)
dlg.userfont = "Times-Roman"
dlg.usershade = 1
dlg.usercap = 1
dlg.userbold = 1
dlg.usersize = "90"
dlg.userrotate = "45"
dlg.userver = 1
dlg.userhor = 1
prompt: On Error Goto bye
Dialog dlg
On Error Goto 0

REM  get cur values & checking parameters
usize = Int(Val(dlg.usersize))
urotate = Int(Val(dlg.userrotate))
ufont$ = dlg.userfont
If dlg.usercap Then
     utext$ = UCase$(dlg.usertext)
Else
     utext$ = dlg.usertext
End If
ubold = dlg.userbold
uitalic = dlg.useritalic
ushade = dlg.usershade
uver = dlg.userver
uhor = dlg.userhor
upage = dlg.userpage
fgotoprompt = 0
fgotobye = 0
If usize < minsize Or usize > maxsize Then
     Select Case MsgBox(msg$, 3)
          Case - 1  REM yes, go back and change value
               fgotoprompt = 1
          Case 0    REM no, continue
          Case 1    REM cancel
               fgotobye = 1
      End Select
End If
If fgotoprompt <> 1 And fgotobye <> 1 Then
     If urotate < 0 Or urotate > 90 Then
          Select Case MsgBox(msg1$, 1)
               Case - 1REM yes, go back and change value
                    fgotoprompt = 1
               Case 0REM cancel
                    fgotobye = 1
          End Select
     End If
End If
If fgotoprompt Then Goto prompt
If fgotobye Then Goto bye

REM get page margins
Redim dlg As FilePageSetup
GetCurValues dlg
utop = Val(dlg.TopMargin)
uleft  = Val(dlg.LeftMargin)
uright = Val(dlg.RightMargin)
uwidth = Val(dlg.PageWidth)
uheight = Val(dlg.PageHeight)
ubottom = Val(dlg.BottomMargin)
     
REM setup printing
REM set the height of char
uhyp = usize - 10
If ushade  Then
     shade$ = ".9 "
Else
     shade$ = ".8 "
End If
text$ = "Print \p page " + Chr$(34)
REM setting font-format
If ufont$ = "Times-Roman" Then
     If ubold Then
          If uitalic Then
               text1$ = "/Times-BoldItalic"
          Else
               text1$ = "/Times-Bold"
          End If
     ElseIf uitalic Then
          text1$ = "/Times-Italic"
     Else
          text1$ = "/Times-Roman"
     End If
ElseIf ufont$ = "Helvetica" Then
     If ubold Then
          If uitalic Then
               text1$ = "/Helvetica-BoldOblique"
          Else
               text1$ = "/Helvetica-Bold"
          End If
     ElseIf uitalic Then
          text1$ = "/Helvetica-Oblique"
     Else
          text1$ = "/Helvetica"
     End If
ElseIf ufont$ = "Courier" Then
     If ubold Then
          If uitalic Then
               text1$ = "/Courier-BoldOblique"
          Else
               text1$ = "/Courier-Bold"
          End If
     ElseIf uitalic Then
          text1$ = "/Courier-Oblique"
     Else
          text1$ = "/Courier"
     End If
End If
REM setting left and right margin and print routine
text2$ = " findfont " + Str$(usize) + " scalefont setfont " + Chr$(13)
text3$ = "/LM " + Str$(0) + " def" + Chr$(13)
text4$ = "/RM " + Str$(uwidth  * 72) + " def" + Chr$(13)
text5$ = "/dlength {(" + utext$ + ") stringwidth } def" + Chr$(13)
text6$ = "/psize {RM LM sub} def" + Chr$(13)
text7$ = "/printDraft {0 0 moveto (" + utext$ + ") show } def " + Chr$(13)
text8$ = "/halflen { dlength pop 2 div} def" + Chr$(13)
text17$ = "/adjmt {90 " + Str$(urotate) + " sub sin 80 mul 2 div} def" + Chr$(13)
REM positioning: horizontal
Select Case uhor
     Case 0
          REM left align
          text9$ = "/ucos {" + Str$(urotate) + " cos} def" + Chr$(13)
          text9$ = text9$ + "/uadj{halflen ucos mul}def" + Chr$(13)
          text9$ = text9$ + "/ucos1 {90 " + Str$(urotate) + " sub cos } def" + Chr$(13)
          text9$ = text9$ + "/uadj1 {uhyp ucos1 mul}def" + Chr$(13)
          text9$ = text9$ + "uadj1 uadj add" + Chr$(13)
          text9$ = text9$ + Str$(uleft * 72) + " add" + Chr$(13)
          If urotate = 90 Then text9$ = text9$ + "8 sub" + Chr$(13)
     Case 1
          REM center
          text9$ = "psize 2 div" + Chr$(13)
     Case 2
          REM right align
          text9$ = "/ucos {" + Str$(urotate) + " cos } def" + Chr$(13)
          text9$ = text9$ + "/uadj {halflen ucos mul} def" + Chr$(13)
          text9$ = text9$ + "RM  uadj sub" + Chr$(13)
          text9$ = text9$ + Str$(uright * 72) + " sub" + Chr$(13)
End Select
REM positioning : vertical
Select Case uver
     Case 0
          REM top
          text10$ = "/uvcos { " + Str$(urotate) + " cos} def" + Chr$(13)
          text10$ = text10$ +  "/uvadj { uhyp  uvcos mul} def" + Chr$(13)
          text10$ = text10$ + "/uvsin1 { " + Str$(urotate) + " sin } def " + Chr$(13)
          text10$ = text10$ + "/uvopp { halflen uvsin1 mul} def" + Chr$(13)
          text10$ = text10$ + Str$((uheight - utop) * 72) + " uvadj uvopp add sub"
          If ushade Then text10$ = text10$ + " 6 sub "
          text10$ = text10$ + " translate" + Chr$(13)
     Case 1
          REM middle
          text10$ = Str$(uheight * 72) + " 2 div translate" + Chr$(13)
     Case 2
          REM bottom
          text10$ = "/uvsin { " + Str$(urotate) + " sin}def" + Chr$(13)
          text10$ = text10$ + "/uvopp { halflen uvsin mul} def" + Chr$(13)
          text10$ = text10$ + Str$(ubottom * 72) + " 8 uvopp add add"
          text10$ = text10$ + " translate" + Chr$(13)
End Select
text11$ = Str$(urotate) + " rotate" + Chr$(13)
text12$ = "0 halflen sub" + Chr$(13)
text18$ = "adjmt add" + Chr$(13)
text13$ = "0 translate" + Chr$(13)
text14$ = ".95 -.05 .3 %start incr.end" + Chr$(13)
text15$ = "{setgray printDraft -1 .5 translate} for" + Chr$(13)
text16$ = shade$ + "setgray printDraft " + Chr$(34)
Redim dlg As NormalViewHeaderArea
GetCurValues dlg
ffirst = dlg.FirstPage
fodd = dlg.OddAndEvenPages          
If fodd = 0 Then
     If ffirst = 0 Then
          fheader = 0
     Else
          fheader = 1
     End If
Else
     If ffirst = 0 Then
          fheader = 2
     Else
          fheader = 3
     End If
End If
fheaderagain = 0
If upage Then
     REM watermark only on first page
     Select Case fheader
          Case 0    REM same header for all pages
               NormalViewHeaderArea .Type = 0, .FirstPage = 0, .OddAndEvenPages = 0
               EditSelectAll
               EditCopy
               ClosePane
               NormalViewHeaderArea .Type = 2, .FirstPage = 1, .OddAndEvenPages = 0
               EditPaste
               StartOfDocument
          Case 1    REM different first page header
               NormalViewHeaderArea .Type = 2, .FirstPage = 1, .OddAndEvenPages = 0
          Case 2    REM different odd and even page header
               NormalViewHeaderArea .Type = 2, .FirstPage = 0, .OddAndEvenPages = 1
          Case 3    REM different first, odd and even page header
               NormalViewHeaderArea .Type = 0, .FirstPage = 1, .OddAndEvenPages = 1
     End Select
Else
     REM  on all pages
     Select Case fheader
          Case 0    REM same header for all pages
               NormalViewHeaderArea .Type = 0, .FirstPage = 0, .OddAndEvenPages = 0
          Case 1    REM different first page header
               ctype = 0
               cfirstpage = 1
               coddandevenpages = 0
               NormalViewHeaderArea .Type = ctype, .FirstPage = cfirstpage, \
               .OddAndEvenPages = coddandevenpages
               fheaderagain = 1
          Case 2    REM different odd and even page header
               ctype = 0
               cfirstpage = 0
               coddandevenpages = 1
               NormalViewHeaderArea .Type = ctype, .FirstPage = cfirstpage, \
               .OddAndEvenPages = coddandevenpages
               fheaderagain = 1
          Case 3    REM different first, odd and even page header
               ctype = 0
               cfirstpage = 1
               coddandevenpages = 1
               NormalViewHeaderArea .Type = ctype, .FirstPage = cfirstpage, \
               .OddAndEvenPages = coddandevenpages
               fheaderagain = 2
     End Select
End If    REM all or first page
While fdone = 0
     StartOfDocument
     InsertFieldChars
     REM insert definition
     WW2_Insert text$ + text1$ + text2$ + text3$ + text4$ + text5$ + text6$ + text7$ + text8$
     REM only for vertical center alignment
     If uver = 1 Then WW2_Insert text17$
     REM insert horizontal alignment
     WW2_Insert text9$
     REM insert vertical alignment
     WW2_Insert text10$
     REM instruction for rotation and translate
     WW2_Insert text11$ + text12$
     REM only for vertical center alignment
     If uver = 1 Then WW2_Insert text18$
     WW2_Insert text13$
     If ushade Then WW2_Insert text14$ + text15$
     WW2_Insert text16$
     If fheaderagain Then
          fheaderagain = fheaderagain - 1
          ctype = ctype + 2
          NormalViewHeaderArea .Type = ctype, .FirstPage = cfirstpage, \
          .OddAndEvenPages = coddandevenpages
     Else
          fdone = 1
     End If
Wend
ClosePane
If fViewOutline Then ViewOutline
If fViewPage Then ViewPage
ViewFieldCodes fViewFieldCodes
bye:
End Sub
======================================================================
You should be able to modify this macro for LaserJet Printers
by substituting appropriate PCL5 commands for the PostScript
commands.

Another easy way to create watermarks is to use the Word Art
Applet to greate a watermark which you place in your page 
header. Hint: if you want  a 1 inch margin at the top of 
your page set your top page margin to -1" (minus one inch). 

This method doesn't depend on a PostScript printer.

Hope this helps

- Chris 

-- 
Christopher J Fynn <cfynn@sahaja.demon.co.uk>