addimage
Public Function load_addimage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = addimage(myimage1, myimage2, myimage2)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_addimage_save = rcode
End Function
andimage
Public Function load_andimage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = andimage(myimage1, myimage2, myimage2)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_andimage_save = rcode
End Function
blur
Public Function load_blur_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = blur(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_blur_save = rcode
End Function
blurthresh
Public Function load_blurthresh_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = blurthresh(43, myimage, myimage) ' Blur threshold is 43
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_blurthresh_save = rcode
End Function
brightenmidrange
Public Function load_brightenmidrange_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = brightenmidrange(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_brightenmidrange_save = rcode
End Function
changebright
Public Function load_changebright_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = changebright(43, myimage, myimage) ' Increase brightness by 43
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_changebright_save = rcode
End Function
cover
Public Function load_cover_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = cover(15, myimage1, myimage2, myimage2) ' Any values between 0 and 15 are transparent
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_cover_save = rcode
End Function
coverclear
Public Function load_coverclear_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = coverclear(128, myimage1, myimage2, myimage2) ' 128 is the transparent color
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_coverclear_save = rcode
End Function
dibtoimage
Private Sub mnuPaste_Click_dibtoimage()
Dim dummy As Long
Dim rcode As Long
Dim tempimage As imgdes
Dim hmem As Long
Dim dibaddr As Long
If Clipboard.GetFormat(vbCFDIB) Then
rcode = OpenClipboard(hWnd)
hmem = GetClipboardData(vbCFDIB)
dibaddr = GlobalLock(hmem)
If dibaddr Then
rcode = dibtoimage(dibaddr, tempimage)
End If
GlobalUnlock (hmem)
dummy = CloseClipboard
End If
If (rcode = NO_ERROR) Then
' Replace current globally defined image
' with the new image from the clipboard
freeimage vimage
copyimgdes tempimage, vimage
End If
End Sub
dilate
Public Function load_dilate_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = dilate(43, myimage, myimage) ' Set dilation level to 43
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_dilate_save = rcode
End Function
divide
Public Function load_divide_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = divide(4, myimage, myimage) ' Divisor equals 4, makes a very dark picture
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_divide_save = rcode
End Function
erode
Public Function load_erode_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = erode(43, myimage, myimage) ' Set erosion level to 43
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_erode_save = rcode
End Function
exchangelevel
Public Function load_exchangelevel_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = exchangelevel(43, 120, 255, myimage, myimage) ' Turn every pixel between 43 and 120 to white
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_exchangelevel_save = rcode
End Function
expandcontrast
Public Function load_expandcontrast_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = expandcontrast(40, 240, myimage, myimage) ' Expand contrast so 40 thru 240 becomes 0 to 255
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_expandcontrast_save = rcode
End Function
flipimage
Public Function load_flipimage_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = flipimage(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_flipimage_save = rcode
End Function
gammabrighten
Public Function load_gammabrighten_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = gammabrighten(.5, myimage, myimage) ' Gamma of .5 brightens the image
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_gammabrighten_save = rcode
End Function
histobrighten
Public Function load_histobrighten_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = histobrighten(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_histobrighten_save = rcode
End Function
histoequalize
Public Function load_histoequalize_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = histoequalize(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_histoequalize_save = rcode
End Function
imagetodib
Public Function load_to_clipboard_imagetodib() As Long
Dim myimage As imgdes
Dim filedata As TiffData
Dim dibaddr As Long
Dim rcode As Long
Dim hmem As Long
Dim dummy As Long
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
If OpenClipboard(hWnd) Then
dummy = EmptyClipboard
rcode = imagetodib(myimage, dibaddr)
If (rcode = NO_ERROR) Then
hmem = GlobalHandle(dibaddr)
dummy = GlobalUnlock(hmem)
dummy = SetClipboardData(vbCFDIB, hmem)
dummy = CloseClipboard
End If
Else
dummy = MsgBox("Could not open clipboard")
End If
freeimage myimage
End If
End If
End If
load_to_clipboard_imagetodib = rcode
End Function
kodalith
Public Function load_kodalith_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = kodalith(128, myimage, myimage) ' Turn the image to black and white, where threshold is 128
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_kodalith_save = rcode
End Function
limitlevel
Public Function load_limitlevel_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = limitlevel(250, myimage, myimage) ' Sets any pixels brighter than 250 to 250
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_limitlevel_save = rcode
End Function
loadbif
Public Function loadbif_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, 256, 256, 8)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadbif("test.bif", myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
' Release the image buffer
freeimage myimage
End If
loadbif_savejpg = rcode
End Function
bmpinfo
loadbmp
Public Function loadbmp_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As BITMAPINFOHEADER
filename = "test.bmp"
' Get the image dimensions
rcode = bmpinfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.biWidth, filedata.biHeight, filedata.biBitCount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadbmp(filename, myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.biBitCount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.biWidth, filedata.biHeight, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
loadbmp_savejpg = rcode
End Function
gifinfo
loadgif
Public Function loadgif_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As GifData
filename = "test.gif"
' Get the image dimensions
rcode = gifinfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadgif(filename, myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
loadgif_savejpg = rcode
End Function
jpeginfo
loadjpg
Public Function loadjpg_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As TgaData
filename = "test.jpg"
' Get the image dimensions
rcode = jpeginfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadjpg(filename, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test2.jpg", myimage, 75)
End If
' Release the image buffer
freeimage myimage
End If
End If
loadjpg_savejpg = rcode
End Function
pcxinfo
loadpcx
Public Function loadpcx_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As PcxData
filename = "test.pcx"
' Get the image dimensions
rcode = pcxinfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadpcx(filename, myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
loadpcx_savejpg = rcode
End Function
loadpng
Public Function loadpng_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As PngData
filename = "test.png"
' Get the image dimensions
rcode = pnginfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadpng(filename, myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
loadpng_savejpg = rcode
End Function
tgainfo
loadtga
Public Function loadtga_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As TgaData
filename = "test.tga"
' Get the image dimensions
rcode = tgainfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtga(filename, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
' Release the image buffer
freeimage myimage
End If
End If
loadtga_savejpg = rcode
End Function
allocimage
freeimage
copyimgdes
convert1bitto8bit
loadtif
savejpg
tiffinfo
Public Function loadtif_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
' Release the image buffer
freeimage myimage
End If
End If
loadtif_savejpg = rcode
End Function
matrixconv
Public Function matrixconv_diagonaledge1(ByRef myimage As imgdes) As Long
Dim rcode As Long
Dim kernel(0 To 9) As Byte ' 3 x 3 kernel, divisor is the last element
Dim kernelvalues As Variant
Dim j As Integer
Dim divisor As Long
divisor = 0
' Kernel values:
' -5 0 0
' 0 0 0
' 0 0 5
kernelvalues = Array(-5, 0, 0, 0, 0, 0, 0, 0, 5)
For j = 0 To 8
If (kernelvalues(j) >= 0) Then
kernel(j) = kernelvalues(j)
Else
kernel(j) = kernelvalues(j) + 256 ' Negative values have to be converted to corresponding positive values
' -1 becomes 255
End If ' -2 becomes 254, and so on
divisor = divisor + kernelvalues(j)
Next j
If (divisor = 0) Then divisor = 1 ' Make sure divisor is not zero
kernel(9) = divisor
rcode = matrixconv(kernel(0), myimage, myimage)
matrixconv_diagonaledge1 = rcode
End Function
matrixconvex
Public Function matrixconvex_diagonaledge2(ByRef myimage As imgdes) As Long
Dim rcode As Long
Dim kernel(0 To 8) As Byte ' 3 x 3 kernel
Dim kernelvalues As Variant
Dim j As Integer
Dim divisor As Long
divisor = 0
' Kernel values:
' -5 0 0
' 0 0 0
' 0 0 5
kernelvalues = Array(-5, 0, 0, 0, 0, 0, 0, 0, 5)
For j = 0 To 8
If (kernelvalues(j) >= 0) Then
kernel(j) = kernelvalues(j)
Else
kernel(j) = kernelvalues(j) + 256 ' Negative values have to be converted to corresponding positive values
' -1 becomes 255
End If ' -2 becomes 254, and so on
divisor = divisor + kernelvalues(j)
Next j
If (divisor = 0) Then divisor = 1 ' Make sure divisor is not zero
rcode = matrixconvex(3, kernel(0), divisor, myimage, myimage)
matrixconvex_diagonaledge2 = rcode
End Function
medianfilter
Public Function load_medianfilter_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = medianfilter(5, myimage, myimage) ' Local area 5 x 5 pixels
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_medianfilter_save = rcode
End Function
mirrorimage
Public Function load_mirrorimage_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = mirrorimage(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_mirrorimage_save = rcode
End Function
multiply
Public Function load_multiply_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = multiply(4, myimage, myimage) ' Brighten the image a lot by multiplying by 4
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_multiply_save = rcode
End Function
multiplyimage
Public Function load_multiplyimage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = multiplyimage(myimage1, myimage2, myimage2)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_multiplyimage_save = rcode
End Function
negative
Public Function load_negative_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = negative(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_negative_save = rcode
End Function
orimage
Public Function load_orimage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = orimage(myimage1, myimage2, myimage2)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_orimage_save = rcode
End Function
outline
Public Function load_outline_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = outline(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_outline_save = rcode
End Function
pixellize
Public Function load_pixellize_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = pixellize(3, myimage, myimage) ' Turn image into blocks of color, each 3 x 3 pixels
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_pixellize_save = rcode
End Function
printimage
Public Function load_printimage() As Long
Dim rcode As Long
Dim myimage As imgdes
Dim filedata As TiffData
Dim prtrect As RECT
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
prtrect.left = 2000 ' two inches
prtrect.top = 1000 ' one inch
prtrect.right = prtrect.left + 3000 - 1 ' three inches wide
prtrect.bottom = prtrect.top + (prtrect.right - prtrect.left + 1) * (myimage.endy - myimage.sty + 1) / (vimage.endx - vimage.stx + 1) ' Maintain aspect ratio
rcode = printimage(hwnd, Printer.hdc, 0, myimage, prtrect, 0, 0)
freeimage myimage
End If
End If
End If
load_printimage = rcode
End Function
printimagenoeject
Public Function load_printimageandtext() As Long
Dim rcode As Long
Dim myimage As imgdes
Dim filedata As TiffData
Dim prtrect As RECT
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
prtrect.left = 2000 ' two inches
prtrect.top = 1000 ' one inch
prtrect.right = prtrect.left + 3000 - 1 ' three inches wide
prtrect.bottom = prtrect.top + (prtrect.right - prtrect.left + 1) * (myimage.endy - myimage.sty + 1) / (vimage.endx - vimage.stx + 1) ' Maintain aspect ratio
' Print some text
Printer.ScaleMode = 5 ' Inches
Printer.CurrentX = 2 ' One inch from left
Printer.CurrentY = (prtrect.bottom + 1000 / 4) / 1000 ' 1/4 inch below picture
Printer.Print "This is a Victor Library Image"
rcode = printimagenoeject(hwnd, Printer.hdc, 0, myimage, prtrect, 0, 0)
Printer.EndDoc
freeimage myimage
End If
End If
End If
load_printimage = rcode
End Function
removenoise
Public Function load_removenoise_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = removenoise(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_removenoise_save = rcode
End Function
resize
resizeex
Public Function resizeex_enlarge_or_reduce(ByRef image1 As imgdes) As Long
Dim timage As imgdes
Dim dx As Integer
Dim dy As Integer
Dim rcode As Integer
Dim pct As Integer
Dim bmh1 As BITMAPINFOHEADER
pct = 83 '83% percent of original size
' Calculate the width and length of the new image
dx = (image1.endx - image1.stx + 1) * pct / 100
dy = (image1.endy - image1.sty + 1) * pct / 100
' Get the bitmapinfoheader data for the image, contains the pixel depth as biBitCount
getbmhfromimage bmh1, image1
' Allocate space for the new DIB
rcode = allocimage(timage, dx, dy, bmh1.biBitCount)
If (rcode = NO_ERROR) Then
rcode = resizeex(image1, timage, 1)
'..........................
' or:
'
' rcode = resize(image1, timage) ' same as rcode = resizeex(image1, timage, 0)
'
'..........................
If (rcode = NO_ERROR) Then
freeimage image1
copyimgdes timage, image1
Else
freeimage timage
End If
End If
resizeex_enlarge_or_reduce = rcode
End Function
rotate
Private Sub mnuloadandrotate_Click()
Dim rcode As Long
Dim tdata As TiffData
Dim myimage As imgdes
Dim myimagerot As imgdes
Dim angle As Double
Dim angleradians As Double
Dim costheta As Double
Dim sintheta As Double
Dim newwidth As Long
Dim newlength As Long
Dim dw As Double
Dim dl As Double
angle = 34.75921
angleradians = angle * 3.14159265358979 / 180 ' For sin and cos functions
costheta = Cos(angleradians)
If (costheta < 0) Then costheta = -costheta
sintheta = Sin(angleradians)
If (sintheta < 0) Then sintheta = -sintheta
rcode = tiffinfo("test.tif", tdata)
If (rcode = NO_ERROR) Then
rcode = allocimage(myimage, tdata.width, tdata.length, tdata.vbitcount)
If (rcode = NO_ERROR) Then
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
dw = costheta * tdata.width + sintheta * tdata.length
dl = sintheta * tdata.width + costheta * tdata.length
newwidth = Round(dw, 0)
newlength = Round(dl, 0)
rcode = allocimage(myimagerot, newwidth, newlength, tdata.vbitcount)
If (rcode = NO_ERROR) Then
rcode = zeroimage(255, myimagerot) ' Set background to white
rcode = rotate(angle, myimage, myimagerot)
If (rcode = NO_ERROR) Then
rcode = savetif("testrotated.tif", myimagerot, 0)
End If
End If
freeimage myimagerot
End If
freeimage myimage
End If
End If
End Sub
rotate90
Private Sub mnuloadandrotate90_Click()
Dim rcode As Long
Dim tdata As TiffData
Dim myimage As imgdes
Dim myimage90 As imgdes
rcode = tiffinfo("test.tif", tdata)
If (rcode = NO_ERROR) Then
rcode = allocimage(myimage, tdata.width, tdata.length, tdata.vbitcount)
If (rcode = NO_ERROR) Then
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
rcode = allocimage(myimage90, tdata.length, tdata.width, tdata.vbitcount)
If (rcode = NO_ERROR) Then
rcode = rotate90(0, myimage, myimage90)
If (rcode = NO_ERROR) Then
rcode = savetif("test90.tif", myimage90, 0)
End If
End If
freeimage myimage90
End If
freeimage myimage
End If
End If
End Sub
savetif
Public Function loadgif_savetif() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As GifData
Dim compression As Long
filename = "test.gif"
' Get the image dimensions from the tiff file
rcode = gifinfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadgif(filename, myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image we can use very high compression
compression = 4 ' Tiff Group 4
Else
compression = 0 ' No compression = 0, lzw = 1, packbits = 2
End If
If (rcode = NO_ERROR) Then
' And save it to a new tiff file
rcode = savetif("test.tif", myimage, compression)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
loadgif_savetif = rcode
End Function
sharpen
Public Function load_sharpen_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = sharpen(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_sharpen_save = rcode
End Function
sharpengentle
Public Function load_sharpengentle_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = sharpengentle(myimage, myimage)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_sharpengentle_save = rcode
End Function
subimage
Public Function load_subimage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = subimage(myimage1, myimage2, myimage2)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_subimage_save = rcode
End Function
threshold
Public Function load_threshold_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage
copyimgdes tempimage, myimage
End If
End If
End If
' Now do the image processing
rcode = threshold(43, myimage, myimage) ' Set any pixel values below 43 to 43
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage, 75)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_threshold_save = rcode
End Function
TWsetfeeder
TWgetfeeder
Private Sub mnuTWgetfeeder_test()
rcode = TWselectsource(hWnd)
rcode = TWopen(hWnd)
If rcode <> 0 Then
MsgBox "Error Code TWopen = " & rcode
Exit Sub
End If
rcode = TWsetfeeder(hWnd, True)
If rcode <> 0 Then
MsgBox "Return value from TWsetfeeder = " & rcode
TWclose
Exit Sub
End If
rcode = TWgetfeeder(hWnd, feederEnabled, feederLoaded)
If rcode <> 0 Then
MsgBox "Return value from TWgetfeeder = " & rcode
TWclose
Exit Sub
End If
MsgBox "FeederEnabled = " & feederEnabled
MsgBox "FeederLoaded = " & feederLoaded
TWclose
End Sub
TWgetsourcenames
TWselectsourcebyname
Public Function dothescannernames(hWnd As Long) As Long
Dim rcode As Long
Dim count As Long
Dim name As String
Dim ds() As String
Dim j As Integer
Dim k As Integer
Dim namelist() As TW_STR32
' Count the number of twain data source names
' Declare Function TWgetsourcencount Lib "VICTW32.DLL" Alias "TWgetsourcenames" (ByVal hWnd As Long, ByVal nullval As Long, ByRef nameCount As Long) As Long
rcode = TWgetsourcencount(hWnd, 0, count)
' Get all the twain data source names
If count > 0 Then
' namelist will get names from the twain manager
ReDim namelist(0 To count - 1) As TW_STR32
' ds array will hold our list of names as VB strings
ReDim ds(0 To count - 1) As String
rcode = TWgetsourcenames(hWnd, namelist(0), count)
End If
' Extract the names from the namelist and put into our ds array
For k = 0 To count - 1
For j = 0 To 33
name = name & Chr(namelist(k).items(j))
If namelist(k).items(j) = 0 Then Exit For
Next j
ds(k) = name
name = ""
Next k
rcode = TWselectsourcebyname(hWnd, "HP PrecisionScan Pro 2.0")
rcode = TWselectsourcebyname(hWnd, "KODAK DC220/DC260 Zoom Acquire")
rcode = TWselectsourcebyname(hWnd, ds(1))
dothscannernames = rcode
End Function
copyimage
TWscanimage
TWsetproductname
Private Sub mnuScantoPictureBox_Click()
Dim rcode As Long
Dim gsimage As imgdes
Dim my_boximage As imgdes
Dim bmh As BITMAPINFOHEADER
Dim hMemDC As Long
Dim hOldBitmap As Long
Const SRCCOPY = &HCC0020
On Error Resume Next
Screen.MousePointer = 11 ' Change mouse pointer to hourglass
' Store App name to display in Source dialog box. String may contain up to 32 chars.
TWsetproductname ("Victor Library")
' Acquire image from selected/default source
rcode = TWscanimage(hWnd, gsimage)
' Last image captured becomes the one to display
Screen.MousePointer = 0 ' Reset the mouse pointer.
' Handle any errors
If rcode <> NO_ERROR Then
MainWnd.error_handler rcode, ""
End If
Picture1.Visible = True
Picture1.AutoRedraw = True
getbmhfromimage bmh, gsimage
rcode = allocimage(Boximage, bmh.biWidth, bmh.biHeight, bmh.biBitCount)
rcode = copyimage(gsimage, Boximage)
' Use Picture1, picture box control
hMemDC = CreateCompatibleDC(hdc)
hOldBitmap = SelectObject(hMemDC, Boximage.hBitmap)
rcode = BitBlt(Picture1.hdc, 0, 0, bmh.biWidth, bmh.biHeight, hMemDC, 0, 0, SRCCOPY)
Picture1.Refresh
' When finished with the image . . . do these
'hOldBitmap = SelectObject(hMemDC, hOldBitmap)
'rcode = DeleteDC(hMemDC)
'freeimage Boximage
End Sub
savetifpage
TWclose
TWopen
TWsetbrightness
TWsetcontrast
TWsetduplex
TWsetmeasureunit
TWsetpagesize
TWsetpixeltype
TWsetproductname
TWsetxresolution
TWsetyresolution
TWscancountimages
Public Function TWscancountimages_withADF(hWnd As Long) As Long
Dim rcode As Long
Dim gsimage As imgdes
Dim srect As RECT
Dim showUI As Long
Dim maxpages As Long
Dim unit_data As TWAIN_CAP_DATA
Dim reso_data As TWAIN_CAP_DATA
Dim pixel_data As TWAIN_CAP_DATA
Dim bright_data As TWAIN_CAP_DATA
Dim feederIsEnabled As Long
Dim feederHasPaper As Long
rcode = TWopen(hWnd)
If (rcode = NO_ERROR) Then
unit_data.oneValue.val = TWUN_INCHES
unit_data.conType = TWON_ONEVALUE
'
reso_data.oneValue.val = 200 ' 200 dpi
reso_data.conType = TWON_ONEVALUE
'
'pixel_data.oneValue.val = TWPT_GRAY 'Grayscale
pixel_data.oneValue.val = TWPT_BW '1-bit b/w
pixel_data.conType = TWON_ONEVALUE
bright_data.oneValue.val = 0 ' Range is usually -1000 to 1000
bright_data.conType = TWON_ONEVALUE
rcode = TWsetmeasureunit(hWnd, unit_data) ' To set the device units
rcode = TWsetxresolution(hWnd, reso_data) ' To set the device resolution
rcode = TWsetyresolution(hWnd, reso_data) ' To set the device resolution
rcode = TWsetbrightness(hWnd, bright_data) ' To set brightness
rcode = TWsetcontrast(hWnd, bright_data) ' To set contrast
rcode = TWsetpixeltype(hWnd, pixel_data) ' To set the pixel type
srect.left = 1000 ' Scan bed coordinates in 1000th inch
srect.top = 1000
srect.right = srect.left + 3000 ' 3 inches wide
srect.bottom = srect.top + 2000 ' 2 inch high
showUI = 0 ' Don't show User Interface
pageno = 0 ' Global variable to count pages scanned and saved
maxpages = 5 ' Don't scan any more than 5 pages
feederIsEnabled = 1 ' Enable automatic document feeder
rcode = TWsetfeeder(hWnd, feederIsEnabled)
rcode = TWgetfeeder(hWnd, feederIsEnabled, feederHasPaper)
If (feederIsEnabled <> 0) Then
If (feederHasPaper <> 0) Then
rcode = TWscancountimages(hWnd, gsimage, srect, showUI, maxpages, AddressOf savescanedpagetotiff) ' see function below
End If
End If
TWclose
End If
scanwithADF = rcode
End Function
'
'
'
Public Function savescanedpagetotiff(jimage As imgdes) As Long
' TWscancountimages() callback function
Dim rcode As Long
Dim filename As String
' Save the image
'
filename = "testadf.tif"
rcode = savetifpage(filename, jimage, 0, pageno) ' pageno is global variable of type long
If (rcode = NO_ERROR) Then
pageno = pageno + 1
freeimage jimage ' Done with image, release the memory
End If
savescanedpagetotiff = rcode
End Function
TWscanimage
Public Function TWscanimage_and_savetif() As Long
Dim rcode As Long
Dim myimage As imgdes
Dim pixel, newpixel As Long
Dim x, y As Long
Dim red As Byte
Dim grn As Byte
Dim blu As Byte
rcode = TWscanimage(hWnd, myimage)
If (rcode = NO_ERROR) Then
rcode = savetif("test.tif", myimage, 0)
freeimage myimage
End If
TWscanimage_and_savetif = rcode
End Function
TWscanimageex
Public Function TWscanimageex_and_savetif(Fname As String) As Long
Dim image1 As imgdes
Dim rcode As Long
Dim compression As Long
Dim showUI As Long
Dim pixel_data As TWAIN_CAP_DATA
Dim reso_data As TWAIN_CAP_DATA
Dim brightness As TWAIN_CAP_DATA
Dim contrast As TWAIN_CAP_DATA
Dim unit_data As TWAIN_CAP_DATA
Dim srect As RECT
rcode = TWopen(hWnd)
If (rcode <> NO_ERROR) Then
scan_and_savetif_1 = rcode
Return
End If
unit_data.oneValue.val = TWUN_INCHES
unit_data.conType = TWON_ONEVALUE
reso_data.oneValue.val = 150 ' 150 dpi
reso_data.conType = TWON_ONEVALUE
pixel_data.oneValue.val = TWPT_BW '1-bit b/w
pixel_data.conType = TWON_ONEVALUE
compression = 4 ' Save 1-bit image with Tiff G4 compression
brightness.oneValue.val = 0 ' Range is usually -1000 to 1000
brightness.conType = TWON_ONEVALUE
contrast.oneValue.val = 0 ' Range is usually -1000 to 1000
contrast.conType = TWON_ONEVALUE
rcode = TWsetmeasureunit(hWnd, unit_data) ' To set the device units
rcode = TWsetxresolution(hWnd, reso_data) ' To set the device resolution
rcode = TWsetyresolution(hWnd, reso_data) ' To set the device resolution
rcode = TWsetbrightness(hWnd, brightness) ' Set brightness
rcode = TWsetcontrast(hWnd, contrast) ' Set contrast
rcode = TWsetpixeltype(hWnd, pixel_data) ' To set the pixel type
srect.left = 1000 ' Scan bed coordinates in 1000th inch
srect.top = 1000
srect.right = srect.left + 3000 - 1 ' 3 inches wide
srect.bottom = srect.top + 2000 - 1 ' 2 inch high
showUI = 0 ' Don't show User Interface
pageno = 0
' To hide the user interface and capture a single image
rcode = TWscanimageex(hWnd, image1, srect, showUI)
If (rcode = NO_ERROR) Then
rcode = savetif(Fname, image1, compression)
freeimage image1
End If
TWclose
TWscanimageex_and_savetif = rcode
End Function
unlockLZW
Public Function loadgifLZW_savejpg() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filename As String
Dim filedata As GifData
Dim compression As Long
filename = "test.gif"
' Get the image dimensions from the tiff file
rcode = gifinfo(filename, filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadgif(filename, myimage)
If (rcode = -53) Then
unlockLZ(12345) Not the real key
rcode = loadgif(filename, myimage)
End If
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image we can use very high compression
compression = 4 ' Tiff Group 4
Else
compression = 0 ' No compression = 0, lzw = 1, packbits = 2
End If
If (rcode = NO_ERROR) Then
' And save it to a new tiff file
rcode = savetif("test.tif", myimage, compression)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
loadgif_savejpg = rcode
End Function
wtaverage
Public Function load_wtaverage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = wtaverage(40, myimage1, myimage2, myimage2) ' Use 40% myimage1, 60% myimage2
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_wtaverage_save = rcode
End Function
xorimage
Public Function load_xorimage_save()
Dim rcode As Long
Dim myimage1 As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim filedata As TiffData
Dim myimage2 As imgdes ' Image descriptor for the original image
' Get the image dimensions from the first tiff file
rcode = tiffinfo("test1.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage1, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test1.tif", myimage1)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage1, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage1
copyimgdes tempimage, myimage1
End If
End If
End If
' Get the image dimensions from the second tiff file
rcode = tiffinfo("test2.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage2, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test2.tif", myimage2)
If (rcode = NO_ERROR) Then
' Test for pixel depth
If (filedata.vbitcount = 1) Then ' If it's a 1-bit image, convert to grayscale
' Allocate the temporary image buffer
rcode = allocimage(tempimage, filedata.width, filedata.length, 8)
If (rcode = NO_ERROR) Then
' Convert the 1-bit image into an 8-bit grayscale
rcode = convert1bitto8bit(myimage2, tempimage)
If (rcode = NO_ERROR) Then
' Replace the original 1-bit image with the 8-bit grayscale image
freeimage myimage2
copyimgdes tempimage, myimage2
End If
End If
End If
If (rcode = NO_ERROR) Then
' Now do the image processing, put the result in myimage2
rcode = xorimage(myimage1, myimage2, myimage2)
If (rcode = NO_ERROR) Then
' And save it to a new jpeg file
rcode = savejpg("test.jpg", myimage2, 75)
' Release the image buffers
freeimage myimage2
End If
End If
freeimage myimage1
End If
End If
End If
End If
End If
End If
load_xorimage_save = rcode
End Function
zeroimage
Public Function load_zeroimage_save() As Long
Dim myimage As imgdes ' Image descriptor for the original image
Dim tempimage As imgdes ' Temp image descriptor, in case we need to convert from 1-bit
Dim rcode As Long
Dim filedata As TiffData
' Get the image dimensions from the tiff file
rcode = tiffinfo("test.tif", filedata)
If (rcode = NO_ERROR) Then
' Allocate an image buffer to hold the image
rcode = allocimage(myimage, filedata.width, filedata.length, filedata.vbitcount)
If (rcode = NO_ERROR) Then
' Load the image from the file
rcode = loadtif("test.tif", myimage)
If (rcode = NO_ERROR) Then
' Now do the image processing
rcode = zeroimage(255, myimage) ' Fills the image with white pixels
If (rcode = NO_ERROR) Then
' And save it to a new tiff file
rcode = savetif("test2.tif", myimage, 0)
End If
End If
' Release the image buffer
freeimage myimage
End If
End If
load_zeroimage_save = rcode
End Function