Re: print large triangular outline using multiple sheets, possible?

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance


"Mike Williams" <mikea@xxxxxxxxxxxxxxxxx> wrote
The only other thing you need is to detect the blank pages so that you do
not print them. You can easily do that by scanning each "page" of the
drawing looking for the first pixel that is "not white" (if you're drawing
onto a white background which I assume you will be) and printing only those
pages where you find one. This can either be done very simply by scanning
across and down in "pixels" ScaleMode using the VB Point method (or the
slightly faster GetPixel API function) or very quickly by transferring the
drawn bitmap data of the page to a VB array of Longs (GetDIBits) and
scanning the array.


A quick way of determining if some part of a page is not white is to
(in essence) fold it in half repeatedly; ANDing half of the image to the
other half. White pixels will stay white but any other colors will be
something other than white.

10 to 15 folds will bring an image down so that the test grid need not
be very big at all. You could go down to 1 X 1 pixel to make the test
just one call to Point(0, 0).

For a demo, add 2 command buttons and a picturebox to a new form
and paste in the code below. Each click of the Fold button does one
fold. In practice you would repeatedly fold the image until the determination
was made....

LFS

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Page As RECT

Private Sub Command1_Click()
Set Picture1.Picture = Nothing
Picture1.BackColor = vbWhite
Picture1.Picture = Picture1.Image
Page.Right = Picture1.ScaleWidth
Page.Bottom = Picture1.ScaleHeight
End Sub

Private Sub Command2_Click()
Fold
End Sub

Private Sub Form_Load()
Command1.Caption = "Reset"
Command2.Caption = "Fold"
Picture1.AutoRedraw = True
Command1.Value = True
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.PSet (X, Y), vbBlack
End Sub

Sub Fold()
Dim wid!, hgt!
If FindInk Then Exit Sub
Set Picture1.Picture = Picture1.Image
wid = Page.Right \ 2 + 1
hgt = Page.Bottom \ 2 + 1
If wid > hgt Then
' fold sideways
Picture1.PaintPicture Picture1.Picture, 0, 0, wid, Page.Bottom, wid, 0, wid, Page.Bottom, vbSrcAnd
' Yellow added for demo (comment out to test for no ink)
Picture1.Line (wid + 1, 0)-Step(wid, Page.Bottom), vbYellow, BF
Page.Right = wid + 1

Else
' fold vertically
Picture1.PaintPicture Picture1.Picture, 0, 0, Page.Right, hgt, 0, hgt, Page.Right, hgt, vbSrcAnd
' Yellow added for demo (comment out to test for no ink)
Picture1.Line (0, hgt + 1)-Step(Page.Right, hgt), vbYellow, BF
Page.Bottom = hgt + 1
End If

End Sub


Function FindInk() As Boolean
Dim found As Boolean
Dim small As Boolean
' Catch ink
If Picture1.Point(0, 0) <> vbWhite Then
MsgBox "Ink was found on this page"
found = True
End If
' Avoid going too small
If Picture1.ScaleX(Page.Right, Picture1.ScaleMode, vbPixels) < 2 Then
small = True
End If
If Picture1.ScaleY(Page.Bottom, Picture1.ScaleMode, vbPixels) < 2 Then
small = True
End If

If Not found Then
If small Then
MsgBox "No ink was found on this page"
End If
End If
FindInk = found Or small

End Function




.

Quantcast