added sysprog entities
This commit is contained in:
478
SYSPROG/STPROC/OIPI_TESTPATTERN.txt
Normal file
478
SYSPROG/STPROC/OIPI_TESTPATTERN.txt
Normal file
@ -0,0 +1,478 @@
|
||||
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
|
Reference in New Issue
Block a user