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 = 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_ToPrinter$ End Else PrintSetup = 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 = 2010+i table = 3.5+(i-1)*10 table = 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