479 lines
14 KiB
Plaintext
479 lines
14 KiB
Plaintext
subroutine OIPI_TESTPATTERN(bShowHeader, whichPrinter, whichPages, outputTo)
|
|
|
|
/*
|
|
|
|
OIPI TestPattern
|
|
|
|
|
|
|
|
This is an example program on how to use the OpenInsight Printer Interface.
|
|
|
|
|
|
*/
|
|
|
|
|
|
If Assigned(bShowHeader) Else bShowHeader = ""
|
|
If Assigned(whichPrinter) Else whichPrinter = ""
|
|
If Assigned(whichPages) Else whichPages = ""
|
|
If Assigned(outputTo) Else outputTo = ""
|
|
|
|
declare function Set_Printer, Get_Printer, RGB,Set_Property
|
|
|
|
declare function Msg, GET_PROPERTY
|
|
|
|
$insert OIPRINT_EQUATES
|
|
$Insert Ps_oipi_common
|
|
$Insert RTI_Postscript_Common
|
|
|
|
|
|
Equ Portrait$ To 0
|
|
Equ Landscape$ To 1
|
|
|
|
* print Setup Equate
|
|
Equ Print_Style$ To 1
|
|
Equ Print_Zoom$ To 2
|
|
|
|
Equ Print_ToPrinter$ To 0
|
|
Equ Display_PrintSetup$ To 1
|
|
Equ Preview_Normal$ To 2
|
|
Equ Print_Mazimized$ To 3
|
|
|
|
Equ Display_AllButtons$ To 0
|
|
Equ Hide_PrintButton$ To 1
|
|
Equ Hide_PrintSetupButton$ To 2
|
|
Equ Hide_AllButtons$ To 3
|
|
|
|
* Create the fonts for the OIPI report
|
|
|
|
* 14 point Arial font
|
|
Font1 = "Arial":@FM:14
|
|
|
|
* 14 point Times New Roman
|
|
Font2 = "Times New Roman":@FM:14
|
|
|
|
HeaderType = ""
|
|
FooterType = ""
|
|
HeaderText = ""
|
|
FooterText = ""
|
|
boxText = ""
|
|
|
|
If whichPages = "" Then whichpages = "1-3"
|
|
|
|
If bShowHeader = "CLICK" Then
|
|
* this came from the form - get all the required details from there
|
|
whichPrinterText = Get_Property(@Window:".CBO_PRINTER", "DEFPROP")
|
|
headerType = Get_Property(@Window:".CBO_HEADER", "DEFPROP")
|
|
footerType = Get_Property(@Window:".CBO_FOOTER", "DEFPROP")
|
|
boxText = Get_Property(@Window:".CBO_BOX_TEXT", "DEFPROP")
|
|
doPageLines = Get_Property(@Window:".CHK_PAGE_LINES", "DEFPROP")
|
|
numLines = Get_Property(@Window:".TXT_NO_LINES", "TEXT")
|
|
doPageMisc = Get_Property(@Window:".CHK_PAGE_MISC", "DEFPROP")
|
|
doPageXY = Get_Property(@Window:".CHK_PAGE_TEXTXY", "DEFPROP")
|
|
doPageSkipping = Get_Property(@Window:".CHK_PAGE_SKIPPING", "DEFPROP")
|
|
Begin Case
|
|
Case Index(whichPrinterText, "VSPRINTER1", 1)
|
|
whichPrinter = "1"
|
|
Case Index(whichPrinterText, "VSPRINTER2", 1)
|
|
whichPrinter = "2"
|
|
Case 1
|
|
whichPrinter = ""
|
|
End Case
|
|
Begin Case
|
|
Case indexc(headerType, "single", 1)
|
|
HeaderText = "The Header Text"
|
|
Case indexc(headerType, "multi", 1)
|
|
HeaderText = @VM:"'F'":@FM:"'DL'":@VM:@VM:"Page 'P'":@FM
|
|
Case indexc(headerType, "extra", 1)
|
|
HeaderText = @VM:"'F'":@FM:"'DL'":@VM:@VM:"Page 'P'":@FM:"Another line":@FM:"And Another":@FM:"Final Header":@FM
|
|
End Case
|
|
Begin Case
|
|
Case indexc(footerType, "single", 1)
|
|
FooterText = "The Footer Text"
|
|
Case indexc(footerType, "multi", 1)
|
|
FooterText = @VM:"'F'":@FM:"'DL'":@VM:@VM:"Page 'P'":@FM
|
|
End Case
|
|
whichPages = ""
|
|
delim = ""
|
|
If doPageMisc = "1" Then
|
|
whichPages = "1"
|
|
delim = ","
|
|
End
|
|
If doPageSkipping = "1" Then
|
|
whichPages := delim:"2"
|
|
delim = ","
|
|
End
|
|
If doPageXY = "1" Then
|
|
whichPages := delim:"3"
|
|
delim = ","
|
|
end
|
|
End
|
|
|
|
call set_vsprinter(whichPrinter) ;* either set the override, or clear it if whichPrinter not specified
|
|
|
|
* Start the OIPI report with the INIT message
|
|
FileName = "OIPI_TestPattern"
|
|
|
|
PrintTitle = "OIPI Test..."
|
|
PreviewTitle = "OIPI Print Preview"
|
|
|
|
deviceSetup = ""
|
|
|
|
Margins = .5:@FM:1:@FM:.5:@FM:1 ;* half inch margins On the sides, one inch margins On the top
|
|
Orientation = Portrait$
|
|
PrintSetup = ""
|
|
PrintSetup<Print_Style$, 2> = Display_AllButtons$
|
|
PrintSetup<2> = -1 ;* Set initial zoom to PageWidth
|
|
PrintSetup<3> = 5 ;* Set the Print Preview position at 5% from top and left
|
|
PrintSetup<4> = 5
|
|
PrintSetup<5> = 95
|
|
PrintSetup<6> = 95
|
|
|
|
If outputTo <> "" Then
|
|
If outputTo[1,1] = "!" Then
|
|
deviceSetup<1,2> = 1
|
|
End
|
|
deviceSetup<1,1> = outputTo
|
|
PrintSetup<Print_Style$, 1> = Print_ToPrinter$
|
|
End Else
|
|
PrintSetup<Print_Style$, 1> = Preview_normal$
|
|
end
|
|
|
|
VAL = Set_Printer("INIT", FileName, PrintTitle:@FM:PreviewTitle, Margins, Orientation, PrintSetup, deviceSetup)
|
|
if VAL < 0 then
|
|
* Always check the return value of the INIT message for error
|
|
ErrorMsg = "Fatal error with the INIT message:":VAL
|
|
goto fatalExit
|
|
end
|
|
|
|
* Set the font for all of the headers and footers
|
|
if Set_Printer("FONTHEADFOOT", "Arial":@FM:14:@FM:"L":@fm:1) < 0 then
|
|
ErrorMsg = "Error with the FONTHEADFOOT message"
|
|
goto fatalExit
|
|
end
|
|
*
|
|
|
|
X=0
|
|
Y=0
|
|
If headerText = "" And footerText = "" then
|
|
Begin Case
|
|
Case bShowHeader = "1"
|
|
* Print a simple one line header
|
|
HeaderText = "The Header Text"
|
|
Case bShowHeader = "2"
|
|
* Print the header with the file name centered on the first line and
|
|
* the Long format of the date left justified and the page number right justified
|
|
* on the second line.
|
|
HeaderText = @VM:"'F'":@FM:"'DL'":@VM:@VM:"Page 'P'":@FM:"Another line":@FM:"And Another":@FM:"Final Header":@FM
|
|
Case bShowHeader = "3"
|
|
FooterText = @VM:"This is a footer"
|
|
Case bShowHeader = "4"
|
|
HeaderText = "The Header Text"
|
|
FooterText = @VM:"This is a footer"
|
|
Case bShowHeader = "5"
|
|
HeaderText = @VM:"'F'":@FM:"'DL'":@VM:@VM:"Page 'P'":@FM
|
|
FooterText = @VM:"This is a footer"
|
|
End Case
|
|
End
|
|
If headerText <> "" Then
|
|
x = Set_Printer("HEADER", HeaderText)
|
|
If x < 0 then
|
|
ErrorMsg = "Error with the HEADER message"
|
|
goto fatalExit
|
|
End
|
|
End
|
|
If footerText <> "" Then
|
|
Y = Set_Printer("FOOTER", FooterText)
|
|
If y < 0 then
|
|
ErrorMsg = "Error with the FOOTER message"
|
|
goto fatalExit
|
|
End
|
|
End
|
|
|
|
If whichPages = "-1" Then
|
|
doPageLines = 1
|
|
NumLines = 300
|
|
boxText = "No"
|
|
End
|
|
|
|
|
|
If boxText _nec "no" Then
|
|
If Indexc(boxText, "all", 1) Then
|
|
* show on all pages
|
|
showOnAllPages = ""
|
|
End Else
|
|
* on first page only
|
|
showOnAllPages = 0
|
|
end
|
|
textstring = 'Text in a box':@fm:'More text in a box'
|
|
stat = Set_Printer("TEXTBOX", textstring, 1:@fm:1:@fm:1:@fm:1,"", showOnAllPages)
|
|
end
|
|
|
|
|
|
|
|
If doPageLines Then
|
|
If Not(Num(numLines)) Or numLines = "" Or NumLines < 0 Then
|
|
numLines = 300
|
|
end
|
|
For each.row = 1 To numlines
|
|
call Set_Printer("TEXT", "here at row ":each.row)
|
|
Next each.row
|
|
End
|
|
|
|
|
|
call Set_Printer("POS", 0:@FM:0)
|
|
|
|
num.sections = dcount(whichPages, ",")
|
|
For each.section = 1 To num.sections
|
|
this.section = Field(whichPages, ",", each.section)
|
|
beginPage = Field(this.section, "-", 1)
|
|
endPage = Field(this.section, "-", 2)
|
|
If endPage = "" Then endPage = beginPage
|
|
If Num(beginPage) And beginPage <> "" And Num(endPage) And endPage <> "" Then
|
|
If beginPage < 0 Then beginPage = 0
|
|
If endPage > 3 Then endPage = 3
|
|
For each.pg = beginPage To endPage
|
|
If each.pg <> 0 then
|
|
On each.pg Gosub doPage1, doPage2, doPage3
|
|
end
|
|
Next each.pg
|
|
End
|
|
Next each.section
|
|
Goto doTerm
|
|
|
|
doPage1:
|
|
|
|
if Set_Printer("FONT", Font1) < 0 then
|
|
ErrorMsg = "Error with the FONT message"
|
|
goto fatalExit
|
|
End
|
|
For each.row = 1 To 5
|
|
call Set_Printer("TEXT", "Arial 14 row ":each.row)
|
|
call Set_Printer("TEXT", @upper.Case:@lower.Case)
|
|
Next each.row
|
|
|
|
For each.row = 1 To 5
|
|
call Set_Printer("TEXT",".")
|
|
Next each.row
|
|
|
|
if Set_Printer("FONT", Font2) < 0 then
|
|
ErrorMsg = "Error with the FONT message"
|
|
goto fatalExit
|
|
End
|
|
For each.row = 1 To 5
|
|
call Set_Printer("TEXT", "Times Roman 14 row ":each.row)
|
|
call Set_Printer("TEXT", @upper.Case:@lower.Case)
|
|
Next each.row
|
|
Stat = Set_Printer('CALCTEXT',@Upper.Case)
|
|
AA = Get_Printer('CALCTEXT')
|
|
call Set_Printer("TEXT","CALCTEXT returns *":AA<1>:"x":AA<2>:"*")
|
|
|
|
CALL Set_Printer("POS", 2:@FM:6)
|
|
* Print pyramid
|
|
if Set_Printer("LINESTYLE", PS_NULL) < 0 then
|
|
ErrorMsg = "Error with the LINESTYLE message"
|
|
goto fatalExit
|
|
end
|
|
pos = Get_Printer("POS")
|
|
y = pos<2>
|
|
offset = 0
|
|
|
|
for c = 0 to 128 step 12.8
|
|
if Set_Printer("FILLSTYLE", BS_SOLID:@FM:RGB(0, 0, 128 + c)) < 0 then
|
|
ErrorMsg = "Error with the FILLSTYLE message"
|
|
goto fatalExit
|
|
end
|
|
R = 1+offset:@FM:y+offset:@FM:3-offset:@FM:y-offset+2
|
|
if Set_Printer("RECT", 1+offset:@FM:y+offset:@FM:3-offset:@FM:y-offset+2, 0) < 0 then
|
|
ErrorMsg = "Error with the RECT message"
|
|
goto fatalExit
|
|
end
|
|
offset = offset + 0.05
|
|
next c
|
|
for c = 0 to 128 step 12.8
|
|
if Set_Printer("FILLSTYLE", BS_SOLID:@FM:RGB(c, c, 255)) < 0 then
|
|
ErrorMsg = "Error with the FILLSTYLE message"
|
|
goto fatalExit
|
|
end
|
|
if Set_Printer("RECT", 1+offset:@FM:pos<2>+offset:@FM:3-offset:@FM:pos<2>+2-offset, 0) < 0 then
|
|
ErrorMsg = "Error with the RECT message"
|
|
|
|
goto fatalExit
|
|
end
|
|
offset = offset + 0.05
|
|
next c
|
|
if Set_Printer("LINESTYLE", PS_SOLID:@FM:1:@FM:RGB(0, 0, 0)) < 0 then
|
|
ErrorMsg = "Error with the LINESTYLE message"
|
|
goto fatalExit
|
|
end
|
|
if Set_Printer("FILLSTYLE", BS_HOLLOW) < 0 then
|
|
ErrorMsg = "Error with the FILLSTYLE message"
|
|
goto fatalExit
|
|
end
|
|
if Set_Printer("RECT", 1:@FM:pos<2>:@FM:3:@FM:pos<2>+2, 0) < 0 then
|
|
ErrorMsg = "Error with the RECT message"
|
|
goto fatalExit
|
|
end
|
|
|
|
if Set_Printer("LINE", 1:@FM:pos<2>:@FM:3:@FM:pos<2>+2, 0) < 0 then
|
|
|
|
ErrorMsg = "Error with the LINE message"
|
|
goto fatalExit
|
|
end
|
|
if Set_Printer("LINE", 3:@FM:pos<2>:@FM:1:@FM:pos<2>+2, 0) < 0 then
|
|
ErrorMsg = "Error with the LINE message"
|
|
goto fatalExit
|
|
end
|
|
|
|
* print 3D button
|
|
text = "3D Button"
|
|
if Set_Printer("FILLSTYLE", BS_SOLID:@FM:RGB(128, 128, 128)) < 0 then
|
|
ErrorMsg = "Error with the FILLSTYLE message"
|
|
goto fatalExit
|
|
end
|
|
if Set_Printer("FONT", "Arial":@FM:14) < 0 then
|
|
ErrorMsg = "Error with the FONT message"
|
|
|
|
goto fatalExit
|
|
end
|
|
|
|
if Set_Printer("CALCTEXT", text) < 0 then
|
|
ErrorMsg = "Error with the CALCTEXT message"
|
|
goto fatalExit
|
|
end
|
|
|
|
size = Get_Printer("CALCTEXT")
|
|
|
|
width = size<1>
|
|
height = size<2>
|
|
poly = ""
|
|
poly<1> = 3.5+width+.4:@VM:y
|
|
poly<2> = 3.5+width+.4:@VM:y+height+.4
|
|
poly<3> = 3.5:@VM:y+height+.4
|
|
poly<4> = 3.5+.1:@VM:y+height+.3
|
|
poly<5> = 3.5+width+.3:@VM:y+height+.3
|
|
poly<6> = 3.5+width+.3:@VM:y+.1
|
|
if Set_Printer("POLYGON", poly, 0) < 0 then
|
|
goto fatalExit
|
|
|
|
end
|
|
|
|
xxx = get_printer("font")
|
|
if Set_Printer("FILLSTYLE", BS_HOLLOW) < 0 then
|
|
ErrorMsg = "Error with the FILLSTYLE message"
|
|
goto fatalExit
|
|
end
|
|
|
|
xxx = get_printer("font")
|
|
if Set_Printer("RECT", 3.5:@FM:y:@FM:3.5+width+.4:@FM:y+height+.4, 0) < 0 then
|
|
ErrorMsg = "Error with the RECT message"
|
|
goto fatalExit
|
|
end
|
|
|
|
xxx = get_printer("font")
|
|
if Set_Printer("FILLSTYLE", BS_SOLID:@FM:RGB(192, 192, 192)) < 0 then
|
|
ErrorMsg = "Error with the FILLSTYLE message"
|
|
goto fatalExit
|
|
end
|
|
if Set_Printer("RECT", 3.5+.1:@FM:y+.1:@FM:3.5+width+.3:@FM:y+height+.3, 0) < 0 then
|
|
|
|
ErrorMsg = "Error with the RECT message"
|
|
goto fatalExit
|
|
end
|
|
|
|
xxx = get_printer("font")
|
|
if Set_Printer("TEXTXY", text, 3.7:@FM:y+.2, "", 0) < 0 then
|
|
ErrorMsg = "Error with the TEXTXY message"
|
|
goto fatalExit
|
|
end
|
|
|
|
call Set_Printer("PAGEBREAK")
|
|
Return
|
|
|
|
doPage2:
|
|
|
|
text = " * OIPI uses the newest VSPRINT or .NET control for the print engine.":@FM
|
|
text := " * OIPI was rewritten in Basic+ from Microsoft Visual Basic.":@FM
|
|
|
|
text := " * The ADDTABLE message was added to improve the quality of tables. This message should be used to replace all TABLE and TEXTCOL messages.":@FM
|
|
text := " * The Print Preview window can be scrolled with the mouse and all pages are viewable as soon as they are printed.":@FM
|
|
text := " * The IMIT message can be used to change the size of the paper without using the Printer Setup dialog box.":@FM
|
|
text := " * The CALCBMP and CALCTABLE messages were added.":@FM
|
|
|
|
text := " * The title of the Print Preview window can be customized.":@FM
|
|
|
|
x = Set_Printer("TEXT", "Text via 'Text' call: ":@FM:text)
|
|
p1 = Get_Printer("POS")
|
|
call Set_Printer("TEXT", "Position after 'Text': ":P1<1>:",":P1<2>)
|
|
For x = 1 To 3
|
|
call Set_Printer("TEXT", ".")
|
|
Next x
|
|
p1 = Get_Printer("POS")
|
|
call Set_Printer("TEXT", "Position after dots: ":P1<1>:",":P1<2>)
|
|
|
|
/*
|
|
x = Set_Printer("ADDTABLE", "9000":@FM, "", "Text via 'Addtable' call: ":@FM:text, "", "", "", TB_NONE)
|
|
|
|
p1 = Get_Printer("POS")
|
|
call Set_Printer("TEXT", "Position after 'AddTable' call: ":P1<1>:",":P1<2>)
|
|
|
|
header = "Year":@VM:"XYZ Co. Sales ($Mill)":@VM:"ABC Co. Sales ($Mill)":@FM
|
|
table = ""
|
|
for i = 0 to 6
|
|
table<i+1,1> = 2010+i
|
|
table<i+1,2> = 3.5+(i-1)*10
|
|
table<i+1,3> = 3.5+(i-1)*50+7
|
|
next i
|
|
if Set_Printer("FONT", "Arial":@FM:10:@FM:"L":@FM:1) < 0 then goto fatalExit
|
|
ColumnFormat = "_^770":@VM:"_>1080":@VM:"_>1080":@FM
|
|
if Set_Printer("ADDTABLE", ColumnFormat, header, table, RGB(0, 222, 0), "", "", TB_BOX_COLUMNS) < 0 then goto fatalExit
|
|
|
|
if Set_Printer("CALCTABLE", ColumnFormat:header:table) < 0 then goto fatalExit
|
|
|
|
size = Get_Printer("CALCTABLE")
|
|
|
|
call Set_Printer("TEXT", "Calctable returns *":size<1>:"x":size<2>:"*")
|
|
*/
|
|
|
|
For j=1 To 50
|
|
call Set_Printer("TEXT", "skipping...")
|
|
Next j
|
|
*CALL Set_Printer("PAGEBREAK")
|
|
Return
|
|
|
|
doPage3:
|
|
|
|
startX = 0
|
|
startY = 0
|
|
endX = 7
|
|
endY = 10
|
|
|
|
For Y = startY To endY step .5
|
|
For X = startX To endX step .5
|
|
If x<>int(x) Or y<>int(y) Then
|
|
if Set_Printer("TEXTXY", "*", X:@FM:Y, "Arial":@FM:10, 0) < 0 then
|
|
|
|
ErrorMsg = "Error with the TEXTXY message"
|
|
goto fatalExit
|
|
End
|
|
End else
|
|
if Set_Printer("TEXTXY", "(":X:",":y:")", X:@FM:Y, "Arial":@FM:10, 0) < 0 then
|
|
|
|
ErrorMsg = "Error with the TEXTXY message"
|
|
goto fatalExit
|
|
End
|
|
end
|
|
Next X
|
|
Next Y
|
|
Return
|
|
|
|
doTerm:
|
|
* End the report and tell the OIPI to completely shut down after the print preview is closed.
|
|
x = Set_Printer("TERM", 1)
|
|
return
|
|
|
|
* jump here if any Set_Printer returns a value < 0
|
|
fatalExit:
|
|
x = msg("", ErrorMsg)
|
|
x = Set_Printer("TERM", 1)
|
|
return
|