ImgProc: Visual Basic Version
'*****************************************************************************
' *
' ImgProc.frm *
' *
' This program demonstrates several of the Fastgraph for Windows image *
' processing functions. *
' *
'*****************************************************************************
Dim hPal As Long
Dim hVB As Long, hVBoriginal As Long, hVBundo As Long
Dim cxClient As Long, cyClient As Long
Dim cxBuffer As Long, cyBuffer As Long
Dim nColors As Long
Dim FileHeader(128) As Byte
Dim FileName As String
Dim mbString As String
Private Sub Form_Activate()
Call fg_realize(hPal)
Refresh
End Sub
Private Sub Form_Load()
ScaleMode = 3
Call fg_setdc(hDC)
hPal = fg_defpal()
Call fg_realize(hPal)
' initialize the virtual buffer environment
Call fg_vbinit
Call fg_vbdepth(24)
' create the main virtual buffer for the working copy of the image
cxBuffer = 32
cyBuffer = 32
hVB = fg_vballoc(cxBuffer, cyBuffer)
Call fg_vbopen(hVB)
' create two additional virtual buffers -- one for a copy of the original
' image, and one used for the undo operation
hVBoriginal = fg_vballoc(cxBuffer, cyBuffer)
hVBundo = fg_vballoc(cxBuffer, cyBuffer)
' start with a window full of white pixels
Call fg_setcolor(-1)
Call fg_fillpage
End Sub
Private Sub Form_Paint()
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
cxClient = ScaleWidth
cyClient = ScaleHeight
Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call fg_vbclose
Call fg_vbfree(hVB)
Call fg_vbfree(hVBoriginal)
Call fg_vbfree(hVBundo)
Call fg_vbfin
End Sub
'*****************************************************************************
' *
' Event handlers for the items on the File menu. *
' *
'*****************************************************************************
Private Sub mnuFileItem_Click(Index As Integer)
Select Case Index
Case 0 ' Open
Call Open_Click
Case 1 ' Save As
Call SaveAs_Click
Case 2 ' Details
Call Details_Click
Case 3 ' Exit
Unload Me
End Select
End Sub
Private Sub Open_Click()
On Error GoTo ErrHandler
' open the bmp, jpeg, or pcx image file
CommonDialog1.CancelError = True
CommonDialog1.FileName = ""
CommonDialog1.Filter = _
"All image files (*.bmp,*.jpg,*.pcx)|*.BMP;*.JPG;*.PCX|" + _
"BMP files (*.bmp)|*.BMP|" + _
"JPEG files (*.jpg)|*.JPG|" + _
"PCX files (*.pcx)|*.PCX"
CommonDialog1.Flags = cdlOFNReadOnly
CommonDialog1.InitDir = App.Path
CommonDialog1.ShowOpen
FileName = CommonDialog1.FileName
' check for a bmp file
If fg_bmphead(FileName, FileHeader(0)) = 0 Then
Screen.MousePointer = 11
nColors = fg_bmppal(FileName, ByVal 0)
Call fg_bmpsize(FileHeader(0), cxBuffer, cyBuffer)
Call SwitchBuffers
Call fg_showbmp(FileName, 0)
CommonDialog1.DefaultExt = "bmp"
' check for a jpeg file
ElseIf fg_jpeghead(FileName, FileHeader(0)) = 0 Then
Screen.MousePointer = 11
nColors = 0
Call fg_jpegsize(FileHeader(0), cxBuffer, cyBuffer)
Call SwitchBuffers
Call fg_showjpeg(FileName, 0)
CommonDialog1.DefaultExt = "pcx"
' check for a pcx file
ElseIf fg_pcxhead(FileName, FileHeader(0)) = 0 Then
Screen.MousePointer = 11
nColors = fg_pcxpal(FileName, ByVal 0)
Call fg_pcxsize(FileHeader(0), cxBuffer, cyBuffer)
Call SwitchBuffers
Call fg_move(0, 0)
Call fg_showpcx(FileName, FG_AT_XY)
CommonDialog1.DefaultExt = "pcx"
' the file is not a valid bmp, jpeg, or pcx file
Else
mbString = FileName + vbCr + _
"is not a recognized image file."
Call MsgBox(mbString, vbCritical, "Error")
Exit Sub
End If
' make a copy of the original image
Call fg_copypage(hVB, hVBoriginal)
' display the image
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
Screen.MousePointer = 0
' enable remaining items on the File menu, and the image processing
' items on the Edit menu
mnuFileItem(1).Enabled = True
mnuFileItem(2).Enabled = True
mnuEditItem(0).Enabled = False
mnuEditItem(1).Enabled = False
mnuEditItem(3).Enabled = True
mnuEditItem(4).Enabled = True
mnuEditItem(5).Enabled = True
mnuEditItem(6).Enabled = True
ErrHandler: ' user pressed Cancel button
End Sub
Private Sub SaveAs_Click()
' set the file save dialog options
On Error GoTo ErrHandler
CommonDialog1.CancelError = True
CommonDialog1.FileName = Left(FileName, InStr(FileName, ".") - 1) + _
"." + CommonDialog1.DefaultExt
CommonDialog1.Flags = cdlOFNHideReadOnly + cdlOFNOverwritePrompt + _
cdlOFNPathMustExist
CommonDialog1.InitDir = App.Path
' save image as a bmp file (original image was bmp)
If CommonDialog1.DefaultExt = "bmp" Then
CommonDialog1.Filter = "BMP files (*.bmp)|*.BMP"
CommonDialog1.ShowSave
Screen.MousePointer = 11
FileName = CommonDialog1.FileName
Call fg_makebmp(0, cxBuffer - 1, 0, cyBuffer - 1, 24, FileName)
nColors = 0
Screen.MousePointer = 0
' save image as a pcx file (original image was jpeg or pcx)
ElseIf CommonDialog1.DefaultExt = "pcx" Then
CommonDialog1.Filter = "PCX files (*.pcx)|*.PCX"
CommonDialog1.ShowSave
Screen.MousePointer = 11
FileName = CommonDialog1.FileName
Call fg_makepcx(0, cxBuffer - 1, 0, cyBuffer - 1, FileName)
nColors = 0
Screen.MousePointer = 0
End If
ErrHandler:
End Sub
Private Sub Details_Click()
' display the original image resolution and color depth
mbString = FileName + vbCr + _
Str(cxBuffer) + " x" + Str(cyBuffer) + " pixels" + vbCr
If nColors > 0 Then
mbString = mbString + Str(nColors) + " colors"
Else
mbString = mbString + "24-bit RGB"
End If
Call MsgBox(mbString, vbInformation, "Information")
End Sub
'*****************************************************************************
' *
' Event handlers for the items on the Edit menu. *
' *
'*****************************************************************************
Private Sub mnuEditItem_Click(Index As Integer)
Select Case Index
Case 0 ' Undo
Call Undo_Click
Case 1 ' Restore Original
Call RestoreOriginal_Click
Case 3 ' Contrast Enhancement
Call ContrastEnhancement_Click
Case 4 ' Gamma Correction
Call GammaCorrection_Click
Case 5 ' Grayscale
Call Grayscale_Click
Case 6 ' Photo-Inversion
Call PhotoInversion_Click
End Select
End Sub
Private Sub Undo_Click()
' undo the previous image processing operation
Call fg_copypage(hVBundo, hVB)
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
mnuEditItem(0).Enabled = False
mnuEditItem(1).Enabled = True
End Sub
Private Sub RestoreOriginal_Click()
' restore the original image
Call fg_copypage(hVB, hVBundo)
Call fg_copypage(hVBoriginal, hVB)
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
mnuEditItem(0).Enabled = True
mnuEditItem(1).Enabled = False
End Sub
Private Sub ContrastEnhancement_Click()
' perform a contrast enhancement transform on the active virtual buffer
Call fg_copypage(hVB, hVBundo)
Call fg_move(0, cyBuffer - 1)
Call fg_contvb(63, 192, cxBuffer, cyBuffer)
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
mnuEditItem(0).Enabled = True
mnuEditItem(1).Enabled = True
End Sub
Private Sub GammaCorrection_Click()
' perform a gamma correction transform on the active virtual buffer
Call fg_copypage(hVB, hVBundo)
Call fg_move(0, cyBuffer - 1)
Call fg_gammavb(0.45, cxBuffer, cyBuffer)
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
mnuEditItem(0).Enabled = True
mnuEditItem(1).Enabled = True
End Sub
Private Sub Grayscale_Click()
' perform a grayscale transform on the active virtual buffer
Call fg_copypage(hVB, hVBundo)
Call fg_move(0, cyBuffer - 1)
Call fg_grayvb(cxBuffer, cyBuffer)
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
mnuEditItem(0).Enabled = True
mnuEditItem(1).Enabled = True
End Sub
Private Sub PhotoInversion_Click()
' perform a photo-inversion transform on the active virtual buffer
Call fg_copypage(hVB, hVBundo)
Call fg_move(0, cyBuffer - 1)
Call fg_photovb(cxBuffer, cyBuffer)
Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
mnuEditItem(0).Enabled = True
mnuEditItem(1).Enabled = True
End Sub
'*****************************************************************************
' *
' SwitchBuffers() *
' *
' Close the and release the virtual buffers for the current image, then *
' create and open new virtual buffers for the new image file. *
' *
'*****************************************************************************
Private Sub SwitchBuffers()
Call fg_vbclose
Call fg_vbfree(hVB)
Call fg_vbfree(hVBoriginal)
Call fg_vbfree(hVBundo)
hVB = fg_vballoc(cxBuffer, cyBuffer)
Call fg_vbopen(hVB)
hVBoriginal = fg_vballoc(cxBuffer, cyBuffer)
hVBundo = fg_vballoc(cxBuffer, cyBuffer)
End Sub
|