home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 2.00 Begin Form foptions BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "Replacement for the Printer Object" ClientHeight = 5100 ClientLeft = 630 ClientTop = 1470 ClientWidth = 7200 ControlBox = 0 'False Height = 5565 Left = 570 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5100 ScaleWidth = 7200 Top = 1065 Width = 7320 Begin CommandButton Command2 Caption = "Command2" Height = 315 Left = 60 TabIndex = 13 Top = 60 Width = 315 End Begin CheckBox Check2 BackColor = &H00C0C0C0& Caption = "Landscape" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Left = 240 TabIndex = 12 Top = 1680 Width = 1155 End Begin CommandButton Command1 BackColor = &H00C0C0C0& Caption = "Hello" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Index = 5 Left = 190 TabIndex = 11 Top = 3800 Width = 1300 End Begin ComboBox cmbDev FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Left = 240 Style = 2 'Dropdown List TabIndex = 8 Top = 1260 Width = 1300 End Begin CheckBox Check1 BackColor = &H00C0C0C0& Caption = "Preview" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 195 Left = 240 TabIndex = 7 Top = 780 Value = 1 'Checked Width = 1035 End Begin vsInForm vsInForm1 BarHeight = 23 Caption = "vsPrinter: A Smart Replacement for the Printer Object" ConvInfo = FOPTIONS.FRX:0000 CustomFrame = -1 'True FontBold = 0 'False FontItalic = 0 'False FontName = "Arial" FontSize = 9 FontStrikethru = 0 'False FontUnderline = 0 'False FrameCorners = 0 'False FrameSizing = 0 'None FrameStyle = 4 'Raised Frame Left = 60 PictLeft0 = FOPTIONS.FRX:000B Top = -1800 End Begin vsViewPort vsViewPort1 BackColor = &H00C0C0FF& ConvInfo = FOPTIONS.FRX:00DD Height = 4890 LargeChangeHorz = 900 LargeChangeVert = 900 Left = 1695 SmallChangeHorz = 300 SmallChangeVert = 300 Top = 105 VirtualHeight = 0 VirtualWidth = 0 Width = 5355 Begin vsPrinter VSPrinter1 AbortCaption = "This is the abort caption" BackColor = &H00FFFFFF& BrushStyle = 1 'Transparent ConvInfo = FOPTIONS.FRX:00E8 FontName = "Times New Roman" FontSize = 14 Footer = "||Page %d" HdrFontBold = -1 'True HdrFontName = "Arial" HdrFontSize = 18 Header = "VSPrinter||VideoSoft's Visual Printer" Height = 3585 Left = 200 MarginBottom = 1440 MarginLeft = 1440 MarginTop = 1440 PenWidth = 3 PhysicalPage = -1 'True PreviewMode = 2 'Force Monochrome TableBorder = 9 'Box Columns Top = 200 Width = 2850 End Begin Image Image2 Height = 795 Index = 2 Left = 3600 Picture = FOPTIONS.FRX:00F3 Stretch = -1 'True Top = 1320 Visible = 0 'False Width = 795 End Begin Image Image2 Height = 795 Index = 1 Left = 3600 Picture = FOPTIONS.FRX:03F5 Stretch = -1 'True Top = 2280 Visible = 0 'False Width = 795 End Begin Image Image2 Height = 795 Index = 0 Left = 3540 Picture = FOPTIONS.FRX:0BB9 Stretch = -1 'True Top = 300 Visible = 0 'False Width = 795 End End Begin ComboBox cmbZoom FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Left = 240 Style = 2 'Dropdown List TabIndex = 6 Top = 405 Width = 1300 End Begin CommandButton Command1 BackColor = &H00C0C0C0& Caption = "Graphics" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Index = 4 Left = 190 TabIndex = 5 Top = 3500 Width = 1300 End Begin CommandButton Command1 BackColor = &H00C0C0C0& Caption = "Multi-Column" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Index = 3 Left = 190 TabIndex = 3 Top = 2900 Width = 1300 End Begin CommandButton Command1 BackColor = &H00C0C0C0& Caption = "Tables" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Index = 2 Left = 190 TabIndex = 2 Top = 3200 Width = 1300 End Begin CommandButton Command1 BackColor = &H00C0C0C0& Caption = "Paragraph" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Index = 1 Left = 190 TabIndex = 1 Top = 2600 Width = 1300 End Begin CommandButton Command1 BackColor = &H00C0C0C0& Caption = "Line by Line" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 300 Index = 0 Left = 190 TabIndex = 0 Top = 2300 Width = 1300 End Begin Image Image1 BorderStyle = 1 'Fixed Single Height = 1035 Left = 240 Stretch = -1 'True Top = 4140 Width = 795 End Begin Label Label1 Alignment = 2 'Center AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Options" ForeColor = &H00000000& Height = 195 Index = 2 Left = 195 TabIndex = 10 Top = 2040 Width = 675 End Begin Label Label1 Alignment = 2 'Center AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Device" ForeColor = &H00000000& Height = 195 Index = 0 Left = 240 TabIndex = 9 Top = 1020 Width = 645 End Begin Label Label1 Alignment = 2 'Center AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Zoom" ForeColor = &H00000000& Height = 195 Index = 1 Left = 240 TabIndex = 4 Top = 195 Width = 495 End Option Explicit ' ------------------------------------ ' ** VSView Printer Control Utility: ' ------------------------------------ ' This routine prints a boxed paragraph at the specified ' position (x, y), with a specified width (wid). The text ' wraps as needed to fit the desired width. ' Define the appearance of the box using the Pen* and Brush* ' properties, and the font with the Font* properties. ' You can also use the TextAlign property to format the ' paragraph. ' Then call this routine to print boxed paragraphs. ' Note: This routine actually prints the text twice: once ' only to measure it, then to actually show it. This is ' not terribly efficient, but it's easy and works well. Sub BoxedPara (vsPrnt As Control, X&, Y&, wid&, s$) Dim ml&, mr&, mb&, cl& ' save current settings ml = vsPrnt.MarginLeft mr = vsPrnt.MarginRight mb = vsPrnt.MarginBottom cl = vsPrnt.TextColor ' set temporary margins vsPrnt.MarginLeft = X vsPrnt.MarginRight = vsPrnt.PageWidth - X - wid vsPrnt.MarginBottom = -10000 ' measure the text (inefficient but easy...) vsPrnt.CurrentX = X vsPrnt.CurrentY = Y vsPrnt.TextColor = RGB(255, 255, 255) vsPrnt = s ' draw a box vsPrnt.x1 = X vsPrnt.y1 = Y vsPrnt.x2 = X + wid vsPrnt.y2 = vsPrnt.CurrentY vsPrnt.Draw = 2 ' draw the text vsPrnt.CurrentX = X vsPrnt.CurrentY = Y vsPrnt.TextColor = cl vsPrnt = s ' restore settings vsPrnt.MarginLeft = ml vsPrnt.MarginRight = mr vsPrnt.MarginBottom = mb End Sub ' ------------------------------------ ' ** VSView Printer Control Utility: ' ------------------------------------ ' This routine prints single-line text inside a box at a ' specified position (x, y). ' Define the appearance of the box using the Pen* and Brush* ' properties, and the font with the Font* properties. ' Then call this routine to print single-line boxed text. Sub BoxedText (vsPrnt As Control, X&, Y&, s$) Dim mr& ' save right margin mr = vsPrnt.MarginRight ' draw box vsPrnt.Measure = s vsPrnt.x1 = X vsPrnt.y1 = Y vsPrnt.x2 = X + vsPrnt.TextWid vsPrnt.y2 = Y + vsPrnt.TextHei vsPrnt.Draw = 2 ' box ' draw text, no breaks vsPrnt.MarginRight = -1000 vsPrnt.CurrentX = X vsPrnt.CurrentY = Y vsPrnt.Text = s ' restore margin vsPrnt.MarginRight = mr End Sub Sub Check2_Click () ' adjust orientation to match If check2.Value Then vsprinter1.Orientation = 1 Else vsprinter1.Orientation = 0 End If ' reset page size cmbZoom_Click Command1_Click (Val(tag)) End Sub Sub cmbDev_Click () If vsprinter1.Device = cmbDev Then Exit Sub vsprinter1.Device = cmbDev End Sub Sub cmbZoom_Click () mousePointer = 11 vsprinter1.Width = vsprinter1.PageWidth * Val(cmbZoom) / 100 vsprinter1.Height = vsprinter1.PageHeight * Val(cmbZoom) / 100 vsViewPort1.VirtualWidth = vsprinter1.Width + 400 vsViewPort1.VirtualHeight = vsprinter1.Height + 400 mousePointer = 0 End Sub Sub Command1_Click (index%) Dim s$, nl$, i%, X%, Y% Dim rc As RECT tag = Str(index) mousePointer = 11 On Error Resume Next ' init printer control vsprinter1.Preview = Check1 vsprinter1.Columns = 1 vsprinter1.PageBorder = 3 vsprinter1.TextAlign = 0 vsprinter1.FontName = "Times New Roman" vsprinter1.FontSize = 12 vsprinter1.FontBold = False vsprinter1.Header = "GDI resources: " & vsInform1.FreeGDI & "%% free" vsprinter1.Action = 3 ' DoEvents SetDlgItemText GetActiveWindow(), 1, "Papa Doc" ' demo depends on button Select Case index ' line by line --------------------------------------- Case 0 vsprinter1.Footer = "||Line by line" vsprinter1.Columns = 2 For i = 0 To Printer.FontCount - 1 s = Printer.Fonts(i) vsprinter1.FontName = s If vsprinter1.FontName = s Then vsprinter1.Text = "This is " & s & Chr(13) Else vsprinter1.Text = "Can't set " & s & Chr(13) End If Next vsprinter1.Columns = 1 ' paragraph --------------------------------------- Case 1 vsprinter1.PageBorder = 7 vsprinter1.Footer = "||Paragraph" vsprinter1.FontSize = 10 vsprinter1.FontName = "Script" s = "Wrapping and font test. This should work now that I'm using my own font routines... Current font is " & vsprinter1.FontName & Str(vsprinter1.FontSize) & ". " s = s & s & s & s & s & s & s & s vsprinter1 = s vsprinter1.FontName = "MS Sans Serif" s = "Wrapping and font test. This should work now that I'm using my own font routines... Current font is " & vsprinter1.FontName & Str(vsprinter1.FontSize) & ". " s = s & s & s & s & s & s & s & s vsprinter1 = s Case 666 ' draw and print all pens vsprinter1.PenWidth = 1 For i = 0 To 6 vsprinter1 = "Pen #" & Str(i) vsprinter1.PenStyle = i vsprinter1.X1 = vsprinter1.CurrentX vsprinter1.Y1 = vsprinter1.CurrentY vsprinter1.X2 = vsprinter1.X1 + 3000 vsprinter1.Y2 = vsprinter1.Y1 vsprinter1.Draw = 1 Next ' draw some text in boxes If True Then vsprinter1.FontName = "Arial" vsprinter1.FontSize = 18 vsprinter1.FontBold = True vsprinter1.BrushStyle = 0 vsprinter1.BrushColor = RGB(60, 60, 60) vsprinter1.TextColor = RGB(255, 255, 255) BoxedText vsprinter1, 2440, 4440, "I can do text in boxes" BoxedText vsprinter1, 3440, 3440, "It's easy" BoxedText vsprinter1, 3440, 5440, "But no wrapping here..." vsprinter1.TextAlign = 1 BoxedPara vsprinter1, 2000, 6440, 3440, "This one, on the other hand, has wrapping and everything" vsprinter1.TextAlign = 2 BoxedPara vsprinter1, 3000, 7440, 3440, "This one, on the other hand, has wrapping and everything" vsprinter1.TextAlign = 0 BoxedPara vsprinter1, 4000, 8440, 3440, "This one, on the other hand, has wrapping and everything" vsprinter1.TextColor = 0 End If ' tables --------------------------------------- Case 2 vsprinter1.PageBorder = 0 vsprinter1.Footer = "||Tables" nl = Chr(13) + Chr(10) s = "This is some text that I will put in here... " s = s & s & s & s & s & s vsprinter1 = s vsprinter1 = s vsprinter1 = "" s = "1500|1640|>1440|^1880;" 's = s + "Country|Capital|Population|Comments" + nl + "Are always" + nl + "WELCOME;" s = s + "Long Title will probably wrap in cell" & nl & "Now this was a hard break|Capital" & nl & "hard-broken|Population|Comments" + nl + "Are always Welcome;" vsprinter1.FontBold = True vsprinter1.Table = s vsprinter1.FontBold = False s = "1500|1640|>1440|^1880;" s = s + "Argentina|Buenos Aires|50|Tango land;" s = s + "Brazil|Brasilia|150|Lambada, anyone?;" s = s + "Chile|Santiago|25|This has nothing to do with beans!;" vsprinter1.Table = s vsprinter1 = "" vsprinter1.TableBorder = 7 vsprinter1.Table = "^1440|^1440|^1440;Line|Quan|Part;" vsprinter1.Table = ">1440|>1440|<1440;1|2|ABC123;" vsprinter1.Text = "After table...1" vsprinter1.Text = "After table...2" vsprinter1.Text = "After table...3" ' columns --------------------------------------- Case 3 vsprinter1.Footer = "||Columns" s = "VSPrinter can also print in multiple columns. " s = s + "You have control over column breaks, and you can save " s = s + "a whole lot of paper by using multiple columns." vsprinter1.Columns = 2 vsprinter1.TextColor = RGB(90, 90, 90) For i = 0 To 36 vsprinter1 = s vsprinter1 = "" Next vsprinter1.TextColor = 0 For i = 0 To 36 vsprinter1 = s vsprinter1 = "" Next ' graphics --------------------------------------- Case 4 vsprinter1.Footer = "||Graphics" rc.left = 2000 rc.top = 2000 rc.right = 3000 rc.bottom = 4000 Debug.Print DrawText(vsprinter1.hdc, "Hellow, world", 13, rc, 0) Debug.Print TextOut(vsprinter1.hdc, 1000, 1000, "Lello borlds", 12) Debug.Print MoveTo(vsprinter1.hdc, 0, 0) Debug.Print LineTo(vsprinter1.hdc, 2000, 2000) ' simple graphics If False Then vsprinter1.X2 = vsprinter1.PageWidth vsprinter1.Y2 = vsprinter1.PageHeight vsprinter1.X1 = 0 vsprinter1.Y1 = 0 vsprinter1.BrushColor = &HFF& 'Red vsprinter1.BrushStyle = 6 'Cross vsprinter1.Draw = 3 'Circle End If ' Text vsprinter1.CurrentX = vsprinter1.PageWidth / 2 vsprinter1.CurrentY = vsprinter1.PageHeight / 2 vsprinter1.TextAlign = 1 ' Center vsprinter1.TextColor = &H800000 'Blue vsprinter1 = "Add graphics to your reports!" vsprinter1.TextColor = &H0& 'Black vsprinter1 = "With VSPrinter, it's easy!" vsprinter1.TextAlign = 0 ' Left ' complex graphics s = "" For X = vsprinter1.MarginLeft To vsprinter1.PageWidth - vsprinter1.MarginRight Step 20 Y = 6000 + Cos(X * 3.1416 / 180) * (X - vsprinter1.PageWidth / 2) / 10 s = s + Str(X) + Str(Y) Next vsprinter1.PenWidth = 10 vsprinter1.PolyLine = s vsprinter1.PenWidth = 0 ' pictures vsprinter1.X1 = 1440 vsprinter1.Y1 = 1440 vsprinter1.X2 = 3000 vsprinter1.Y2 = 3000 vsprinter1.Picture = Image2(0) vsprinter1.X1 = vsprinter1.X1 + 1440 vsprinter1.Y1 = vsprinter1.Y1 + 1440 vsprinter1.X2 = vsprinter1.X2 + 1440 vsprinter1.Y2 = vsprinter1.Y2 + 1440 vsprinter1.Picture = Image2(1) vsprinter1.X1 = vsprinter1.X1 + 1440 vsprinter1.Y1 = vsprinter1.Y1 + 1440 vsprinter1.X2 = vsprinter1.X2 + 1440 vsprinter1.Y2 = vsprinter1.Y2 + 1440 For i = 1 To 6 vsprinter1.X2 = vsprinter1.X2 - 240 vsprinter1.Y2 = vsprinter1.Y2 - 240 vsprinter1.Picture = Image2(2) Next ' picture from draw control vsprinter1.X1 = vsprinter1.X1 + 1440 vsprinter1.Y1 = vsprinter1.Y1 + 1440 vsprinter1.X2 = vsprinter1.X1 + 3440 vsprinter1.Y2 = vsprinter1.Y1 + 3440 vsprinter1.Picture = fMenu!vsDraw1.Picture 'fMenu!vsDraw1.Action = 5 'vsPrinter1.Picture = Clipboard.GetData(3) ' rotated text --------------------------------------- Case 5 vsprinter1.Footer = "||Bull" vsprinter1.FontSize = 24 vsprinter1.TextColor = RGB(70, 70, 70) For i = 0 To 3600 Step 900 vsprinter1.CurrentX = 2000 vsprinter1.CurrentY = 5500 vsprinter1.TextAngle = i vsprinter1.Text = "VSView" Next vsprinter1.CurrentX = 2000 vsprinter1.CurrentY = 5500 s = "VSView by VideoSoft" vsprinter1 = s vsprinter1.CurrentX = 2010 vsprinter1.CurrentY = 5510 vsprinter1.TextColor = 0 vsprinter1 = s ' show address too nl = Chr(13) s = "2625 Alcatraz Ave." + nl + "Suite 271" + nl + "Berkeley, CA 94705" vsprinter1.CurrentX = 2010 vsprinter1.CurrentY = 5810 vsprinter1.FontSize = 11 vsprinter1 = s ' draw a polygon on draw control vsprinter1.PenColor = RGB(70, 70, 70) s = "" For X = vsprinter1.MarginLeft To vsprinter1.PageWidth - vsprinter1.MarginRight Step 100 Y = 6000 + Cos(X) * (X - vsprinter1.PageWidth / 2) / 3 s = s + Str(X) + Str(Y) Next vsprinter1.PolyLine = s vsprinter1.PenColor = 0 End Select '------------------------------------------------------- ' all done vsprinter1.Action = 6 'End Document mousePointer = 0 End Sub Sub Command2_Click () Dim i%, j%, t& t = Timer For j = 0 To 5 For i = 1 To 4 Command1_Click (i) Next Next Debug.Print "Elapsed: "; Timer - t End Sub Sub Form_Load () Dim i% vsprinter1.Preview = True vsprinter1.PreviewPage = 1 vsprinter1.Orientation = 0 vsprinter1.FileName = "This is really the job name" cmbZoom.AddItem "35" cmbZoom.AddItem "50" cmbZoom.AddItem "75" cmbZoom.AddItem "100" cmbZoom.AddItem "150" cmbZoom.AddItem "200" cmbZoom.ListIndex = 0 cmbDev.Clear For i = 0 To vsprinter1.NDevices - 1 cmbDev.AddItem vsprinter1.Devices(i) Next For i = 0 To vsprinter1.NDevices - 1 If cmbDev.List(i) = vsprinter1.Device Then cmbDev.ListIndex = i Exit For End If Next End Sub Sub vsInForm1_ClickLButton (Button As Integer) Unload Me End Sub Sub VSPrinter1_DblClick () vsprinter1.Action = 10 vsprinter1.Action = 9 End Sub Sub VSPrinter1_NewTableCell (Row As Integer, Column As Integer, Cell As String) Exit Sub If Column = 2 Then vsprinter1.FontBold = True vsprinter1.FontItalic = True vsprinter1.TextColor = RGB(255, 0, 0) Else vsprinter1.FontBold = False vsprinter1.FontItalic = False vsprinter1.TextColor = 0 End If End Sub