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

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.