PC World Komputer 1997 February/PCWK0297.iso/envelop/envelop.5/Tools/Arsenal/tools/browsbmp/browsbmp.eto

Text File | 1996-07-08 | 10.5 KB | 367 lines

Type BrowserDisplayForm From Form
  Dim BrowserDisplayViewMenu As New PopupMenu
  Dim BrowserDisplayMenuBar As New MenuBar
  Dim imgViewer As New Image
  Dim BitmapFile As New Bitmap

  ' METHODS for object: BrowserDisplayForm
  Sub ClearMenuCheckMarks()
    ' Clear any existing checkboxes
    BrowserDisplayViewMenu.CheckItem("ScaleFit", 0)
    BrowserDisplayViewMenu.CheckItem("ScaleFull", 0)
  End Sub

  Sub ExitDisplay_Click()
    ' Hide the Bitmap viewer form
    Hide
  End Sub

  Sub Load()
    ' Clear existing checkmarks in the menu
    ClearMenuCheckMarks

    BrowserDisplayForm.Width = 3955
    BrowserDisplayForm.Height = 4530

  End Sub

  Sub Resize()
    ' Keep the size of the image control the same as the form
    imgViewer.Move(0, 0, BrowserDisplayForm.ScaleWidth, BrowserDisplayForm.ScaleHeight)
  End Sub

  Sub ScaleFit_Click()

    ' Clear exiting checkmarks
    ClearMenuCheckMarks
    ' Add a checkmark to the Fit entry
    BrowserDisplayViewMenu.CheckItem("ScaleFit", 1)

    ' Set the resize mode to keep a constant portion of bitmap visible.
    imgViewer.ResizeMode = "Fit"

    ' View the entire bitmap
    imgViewer.CropXOffset = 0
    imgViewer.CropYOffset = 0
    imgViewer.CropXSize = BitmapFile.Width
    imgViewer.CropYSize = BitmapFile.Height
  End Sub

  Sub ScaleFull_Click()

    ' Clear existing checkmarks
    ClearMenuCheckMarks
    ' Add a checkmark to the Fit entry
    BrowserDisplayViewMenu.CheckItem("ScaleFull", 1)

    ' Set the resize mode display bitmap at a constant scale
    imgViewer.ResizeMode = "Clip"

    ' View the bitmap at a 1:1 scale
    imgViewer.ScaleX = 1
    imgViewer.ScaleY = 1
  End Sub

  Sub UpdateDisplay()
    Application.DoEvents

    ' If the Fit mode is alreay checked
    If BrowserDisplayViewMenu.ItemIsChecked("ScaleFit") Then
      ScaleFit_Click
    Else
      ' Clear all checkmark entries in the menu
      ScaleFull_Click
    End If
  End Sub

End Type

Type BrowserMasterForm From SampleMasterForm
  Dim lstBmpFiles As New ListBox
  Dim lstSelDirectory As New FileListBox
  Dim btnSearch As New Button
  Dim btnClear As New Button
  Dim cboSelDrive As New FileComboBox
  Dim Label1 As New Label
  Dim Label2 As New Label
  Dim Label3 As New Label
  Dim lblCurDirectory As New Label
  Dim lblSearchDirectory As New Label
  Dim tmrStopWatch As New StopClock

  ' METHODS for object: BrowserMasterForm
  Sub AddFileToList(ByVal path as string, ByVal attr as long)
    lstBmpFiles.AddItem path

    ' Process events to update display and/or Cancel
    App.DoEvents()
  End Sub

  Sub btnClear_Click()
    If btnClear.Caption = "Cancel" Then
      Throw AbortFlag()
    Else
      lstBmpFiles.Clear
      BrowserDisplayForm.BitmapFile.FileName = ""
    End If
  End Sub

  Sub btnSearch_Click()
    Dim searchstring As String
    Dim file_count As single
    Dim total_time As String

    ' Disable controls until after search
    lstBmpFiles.Enabled = 0
    lstSelDirectory.Enabled = 0
    cboSelDrive.Enabled = 0
    btnClear.Caption = "Cancel"
    btnSearch.Enabled = "False"

    ' Clear the bmp file list
    lstBmpFiles.Clear

    tmrStopWatch.Start

    ' Initiate the recursive search for matching files
    Try
      GenerateBmpList lstSelDirectory.Path
    catch AbortFlag()
      InfoBox.Message("", "Search operation cancelled.")
    End Try

    tmrStopWatch.Finish

    total_time = tmrStopWatch.ElapsedTime

    tmrStopWatch.Reset

    ' Disable controls until after search
    lstBmpFiles.Enabled = -1
    lstSelDirectory.Enabled = -1
    cboSelDrive.Enabled = -1
    btnClear.Caption = "Clear"
    btnSearch.Enabled = "True"

    file_count = lstBmpFiles.ListCount
    InfoBox.Message("", file_count & " bitmap files located in " & total_time & " time.")

  End Sub

  Sub cboSelDrive_Click()
    ' Set the path for the Select Directory list
    lstSelDirectory.Path = cboSelDrive.SelPath

    ' Update the Search Directory label
    lblCurDirectory.Caption = lstSelDirectory.Path

  End Sub

  Sub ExitApplication_Click()
    ' Set the contents of the titlebar of the YesNoPrompt object
    YesNoBox.title = "Quit?"

    ' Set the message of the YesNoPrompt object
    YesNoBox.Msg("Ok to quit application?")

    ' If the Yes entry was clicked, hide the textedit form
    If YesNoBox.result = 6 Then
      Dim F Strictly As SampleMasterForm
      F = Me
      BrowserDisplayForm.Hide
      F.ExitApplication_Click
    End If
  End Sub

  Sub GenerateBmpList(ByVal searchFrom As String)
    Dim dir As New Directory
    dir.Path = IIf(searchFrom <> "", searchFrom, dir.CurrentDir)
    dir.EnumContents(Me, "AddFileToList", "*.bmp", True)
  End Sub

  Sub lstBmpFiles_Click()
    Dim option As long
    Dim result As long
    Dim bmp_file As String

    ' Set a variable to be the name of sound file including absolute path
    bmp_file = lstBmpFiles.Text

    ' Display the selected bmp file
    BrowserDisplayForm.BitmapFile.FileName = bmp_file

    If BrowserDisplayForm.Visible = 0 Then
      BrowserDisplayForm.Show
    End If

    ' Update the correct display mode
    BrowserDisplayForm.UpdateDisplay

  End Sub

  Sub lstSelDirectory_DblClick()
    ' Set the Select Directory path to the one chosen
    lstSelDirectory.Path = lstSelDirectory.SelPath

    ' Update the Search Directory label
    lblCurDirectory.Caption = lstSelDirectory.Path
  End Sub

  Sub ResetApplication_Click()
    ' Preset the height of the combo drive box
    cboSelDrive.Height = 1500

    ' Initialize the Search Directory label
    lblCurDirectory.Text = lstSelDirectory.Path

    ' Preset the combo drive box
    cboSelDrive.SelectDrive(lstSelDirectory.Path)

    ' Initialize the bitmap filename
    BrowserDisplayForm.BitmapFile.FileName = ""

    ' Initize the default size of the form
    BrowserMasterForm.Width = 8385
    BrowserMasterForm.Height = 5040
  End Sub

  Sub Resize()
    Dim min_width As single
    Dim min_height As single
    Dim edge_margin As single
    Dim gap_margin As single

    edge_margin = 300
    gap_margin = 200

    min_height = 4000
    min_width = 6500

    If BrowserMasterForm.Width < min_width Then
      BrowserMasterForm.Width = min_width
    End If

    If BrowserMasterForm.Height < min_height Then
      BrowserMasterForm.Height = min_height
    End If

    lstBmpFiles.Width = BrowserMasterForm.ScaleWidth - lstBmpFiles.Left - edge_margin
    btnClear.Left = BrowserMasterForm.ScaleWidth - btnClear.Width - edge_margin
    btnSearch.Left = btnClear.Left - btnSearch.Width - gap_margin
    lblCurDirectory.Width = btnSearch.Left - gap_margin - lblCurDirectory.Left

    btnClear.Top = BrowserMasterForm.ScaleHeight - edge_margin - btnClear.Height
    lstBmpFiles.Height = btnClear.Top - gap_margin - lstBmpFiles.Top
    btnSearch.Top = btnClear.Top
    lblCurDirectory.Top = btnClear.Top + btnClear.Height - lblCurDirectory.Height
    lblSearchDirectory.Top = lblCurDirectory.Top - lblSearchDirectory.Height
    lstSelDirectory.Height = lstBmpFiles.Height - (lstSelDirectory.Top - lstBmpFiles.Top)

    BrowserMasterForm.Refresh
  End Sub

End Type

Begin Code
' Reconstruction commands for object: BrowserDisplayForm
'
  With BrowserDisplayForm
    .Caption := "Bitmap Viewer"
    .Move(10275, 6495, 3960, 4530)
    .Outlined := True
    .MenuBar := BrowserDisplayForm.BrowserDisplayMenuBar
    With .BrowserDisplayViewMenu

      .InsertItem("ScaleFit", "&Fit", -1)
      .InsertItem("ScaleFull", "F&ull", -1)
      .InsertSeparator(-1)
      .InsertItem("ExitDisplay", "&Exit", -1)
    End With  'BrowserDisplayForm.BrowserDisplayViewMenu
    With .BrowserDisplayMenuBar

      .InsertPopup(BrowserDisplayForm.BrowserDisplayViewMenu, "&View", -1)
    End With  'BrowserDisplayForm.BrowserDisplayMenuBar
    With .imgViewer
      .BackColor := 16777215
      .ZOrder := 1
      .Move(0, 0, 3840, 3840)
      .AutoInitCropRect := False
      .Picture := BrowserDisplayForm.BitmapFile
      .CropXSize := 32
      .CropYSize := 32
    End With  'BrowserDisplayForm.imgViewer
    With .BitmapFile
    End With  'BrowserDisplayForm.BitmapFile
  End With  'BrowserDisplayForm
' Reconstruction commands for object: BrowserMasterForm
'
  With BrowserMasterForm
    .Caption := "Bitmap Displayer"
    .Move(4065, 2400, 8385, 5040)
    .SampleDir := "C:\ENVELOP\arsenal\tools\browsbmp\"
    .SampleName := "browsbmp"
    With .lstBmpFiles
      .Caption := "lstBmpFiles"
      .ZOrder := 1
      .Move(2700, 525, 5325, 2910)
    End With  'BrowserMasterForm.lstBmpFiles
    With .lstSelDirectory
      .Caption := "lstSelDirectory"
      .ZOrder := 2
      .Move(300, 1500, 1950, 1950)
      .ShowDirs := True
      .ShowFiles := False
    End With  'BrowserMasterForm.lstSelDirectory
    With .btnSearch
      .Caption := "Search"
      .ZOrder := 3
      .Move(6000, 3750, 900, 375)
    End With  'BrowserMasterForm.btnSearch
    With .btnClear
      .Caption := "Clear"
      .ZOrder := 4
      .Move(7095, 3750, 900, 375)
    End With  'BrowserMasterForm.btnClear
    With .cboSelDrive
      .ZOrder := 5
      .Move(300, 525, 1950, 360)
      .ShowDrives := True
      .ShowFiles := False
    End With  'BrowserMasterForm.cboSelDrive
    With .Label1
      .Caption := "Drives:"
      .ForeColor := 13107200
      .ZOrder := 6
      .Move(150, 150, 825, 240)
    End With  'BrowserMasterForm.Label1
    With .Label2
      .Caption := "Directories:"
      .ForeColor := 13107200
      .ZOrder := 7
      .Move(150, 1125, 1500, 240)
    End With  'BrowserMasterForm.Label2
    With .Label3
      .Caption := "Bitmap Files:   (Click to show)"
      .ForeColor := 13107200
      .ZOrder := 8
      .Move(2475, 150, 2880, 240)
    End With  'BrowserMasterForm.Label3
    With .lblCurDirectory
      .Caption := "W:\Examples"
      .ZOrder := 9
      .Move(450, 3825, 5315, 300)
    End With  'BrowserMasterForm.lblCurDirectory
    With .lblSearchDirectory
      .Caption := "Search Directory:"
      .ForeColor := 13107200
      .ZOrder := 10
      .Move(150, 3525, 1950, 300)
    End With  'BrowserMasterForm.lblSearchDirectory
    With .tmrStopWatch
    End With  'BrowserMasterForm.tmrStopWatch
    With .helpfile
      .FileName := "C:\ENVELOP\arsenal\tools\browsbmp\browsbmp.hlp"
    End With  'BrowserMasterForm.helpfile
  End With  'BrowserMasterForm
End Code