Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/vbasic/Data/Utils/glm2demo.exe/%MAINDIR%/HexEdit/HexSample.frm

Visual Basic Form | 2002-06-10 | 9.4 KB | 318 lines

VERSION 5.00
Object = "{684E631B-2953-11D1-B8F0-00001C500B3F}#1.0#0"; "dwHxEdtD.ocx"
Begin VB.Form frmHexSample
   Caption         =   "HexEditor - [Empty]"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   Icon            =   "HexSample.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin dwHexEditDemo.HexEdit HexEdit1
      Height          =   3255
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4695
      _ExtentX        =   8281
      _ExtentY        =   5741
      BytesPerLine    =   6
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew
         Caption         =   "&New"
      End
      Begin VB.Menu mnuFileOpen
         Caption         =   "&Open"
      End
      Begin VB.Menu mnuFileSave
         Caption         =   "&Save"
      End
      Begin VB.Menu mnuFileSaveAs
         Caption         =   "Save &As"
      End
      Begin VB.Menu mnuSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditCopy
         Caption         =   "&Copy"
      End
      Begin VB.Menu mnuEditCopyAscii
         Caption         =   "Copy &Ascii"
      End
   End
   Begin VB.Menu mnuOpt
      Caption         =   "&Options"
      Begin VB.Menu mnuOptAsc
         Caption         =   "&AsciiDisplay"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuOptAddr
         Caption         =   "A&ddressDisplay"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuOptReadOnly
         Caption         =   "&ReadOnly"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuOptExt
         Caption         =   "&ExtendedSelection"
      End
      Begin VB.Menu mnuOptEnabled
         Caption         =   "E&nabled"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuOptColor
         Caption         =   "&Change Color"
      End
      Begin VB.Menu mnuOptSelColor
         Caption         =   "Change &Selected Color"
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout
         Caption         =   "&About This Program..."
      End
      Begin VB.Menu mnuHelpOther
         Caption         =   "&Other Desaware Products..."
      End
   End
Attribute VB_Name = "frmHexSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private FileChanged As Boolean
Private FileOpened As Boolean
Private tFileName As String
Private tFullFileName As String
Private FileUntitled As Boolean
Private cmdDlg2 As dwFileOpenSave
Private Sub HexEdit1_Change()
    FileChanged = True
End Sub
Private Sub Form_Load()
    Me.Show
    Set cmdDlg2 = New dwFileOpenSave
    HexEdit1.Enabled = False

    Call DoOpenFile

End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not CheckForSave() Then Cancel = True
End Sub
Private Sub Form_Resize()
    HexEdit1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Set cmdDlg2 = Nothing
End Sub
Private Sub mnuEditCopy_Click()
    HexEdit1.CopyHex
End Sub
Private Sub mnuEditCopyAscii_Click()
    HexEdit1.CopyAscii
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
Private Function DoOpenFile() As Boolean
    cmdDlg2.DlgWindowOwner = Me.hWnd
    cmdDlg2.DialogTitle = "Open File"
    cmdDlg2.Filter = "All Files|*.*"
    cmdDlg2.Flags = glmcdOFNExplorer Or glmcdOFNFileMustexist
    cmdDlg2.ShowOpen
    If cmdDlg2.filename = "" Then Exit Function
    If Dir$(cmdDlg2.filename) = "" Then Exit Function
    If Not DoLoadFile(cmdDlg2.filename) Then Exit Function
    FileChanged = False
    FileOpened = True
    tFileName = cmdDlg2.FileTitle
    If (cmdDlg2.Flags And glmcdOFNReadOnly) Then
        mnuOptReadOnly.Checked = True
        HexEdit1.ReadOnly = True
    Else
        mnuOptReadOnly.Checked = False
        HexEdit1.ReadOnly = False
    End If
    tFullFileName = cmdDlg2.filename
    HexEdit1.Enabled = True
    FileUntitled = False
    Me.Caption = "HexEditor - " & tFileName
    DoOpenFile = True
End Function
Private Function DoLoadFile(fName As String) As Boolean
    Dim fSize As Long
    Dim fBuffer() As Byte
    Dim fNum As Long
    fSize = FileLen(fName)
    If fSize <= 1 Or fSize > 50000 Then
        MsgBox "File '" & fName & "' is either empty or over 50k", vbExclamation, "HexEditSample - Error"
        DoLoadFile = False
        Exit Function
    End If
    ReDim fBuffer(fSize) As Byte
    fNum = FreeFile
    Open fName For Binary Access Read As fNum
    fBuffer = InputB(fSize, #fNum)
    Close #fNum
    HexEdit1.SetMemoryBlockByByte fBuffer(0), fSize
    DoLoadFile = True
End Function
Private Function CheckForSave() As Boolean
    Dim msgAns As VbMsgBoxResult
    If FileChanged Then
        msgAns = MsgBox("The file '" & tFileName & "' has been modified. Would you like to save changes?", vbYesNoCancel + vbInformation, "File Modified")
        If msgAns = vbCancel Then
            Exit Function
        ElseIf msgAns = vbYes Then
            Call DoSaveFile
        End If
    End If
    CheckForSave = True
End Function
Private Sub DoSaveFile()
    If FileUntitled = True Then
        Call DoSaveAs
        Exit Sub
    End If
    Call WriteFile
End Sub
Private Sub WriteFile()
    Dim fSize As Long
    Dim fBuffer() As Byte
    Dim fNum As Long
    fSize = HexEdit1.BufferSize
    ReDim fBuffer(1 To fSize) As Byte
    HexEdit1.CopyBufferByByte fBuffer(1)
    fNum = FreeFile
    Open tFullFileName For Binary Access Write As fNum
    Put #fNum, , fBuffer

    Close #fNum
    FileChanged = False
    FileUntitled = False
End Sub
Private Sub mnuFileNew_Click()
    If CheckForSave() Then Call CreateNewFile
End Sub
Private Function DoSaveAs() As Boolean
    cmdDlg2.DlgWindowOwner = Me.hWnd
    cmdDlg2.DialogTitle = "Save As"
    cmdDlg2.Filter = "All Files|*.*"
    cmdDlg2.Flags = glmcdOFNExplorer Or glmcdOFNHideReadOnly

    cmdDlg2.ShowSave
    If cmdDlg2.filename = "" Then Exit Function

    tFileName = cmdDlg2.FileTitle
    tFullFileName = cmdDlg2.filename
    Me.Caption = "HexEditor - " & tFileName
    Set cmdDlg2 = Nothing
    DoSaveAs = True
    Call WriteFile
End Function
Private Function CreateNewFile() As Boolean
    Dim nfSize&
    Dim fBuffer() As Byte
    On Error GoTo HandleInputError
    nfSize = CInt(InputBox("Enter the size, in bytes, of the file you want created.", "New File", "1024"))
    On Error GoTo 0
    If nfSize < 1 Or nfSize > 50000 Then
        MsgBox "That file size is invalid or above 50k.", vbCritical, "Error: New File"
        Exit Function
    End If
    ReDim fBuffer(1 To nfSize)
    HexEdit1.SetMemoryBlockByByte fBuffer(1), nfSize
    FileChanged = True
    FileUntitled = True
    CreateNewFile = True
    tFileName = ""
    tFullFileName = ""
    Me.Caption = "HexEditor - [Untitled]"
    Exit Function
HandleInputError:
    Exit Function
End Function
Private Sub mnuFileOpen_Click()
    If CheckForSave() Then Call DoOpenFile
End Sub
Private Sub mnuFileSave_Click()
    Call DoSaveFile
End Sub
Private Sub mnuFileSaveAs_Click()
    Call DoSaveAs
End Sub
Private Sub mnuHelpAbout_Click()
    frmAbout.Show 1
End Sub
Private Sub mnuHelpOther_Click()
    sdother.Show 1
End Sub
Private Sub mnuOptAddr_Click()
    mnuOptAddr.Checked = Not mnuOptAddr.Checked
    HexEdit1.AddressDisplay = mnuOptAddr.Checked
End Sub
Private Sub mnuOptAsc_Click()
    mnuOptAsc.Checked = Not mnuOptAsc.Checked
    HexEdit1.AsciiDisplay = mnuOptAsc.Checked
End Sub
Private Sub mnuOptColor_Click()
    With HexEdit1
        If .BackColor = vbWhite Then
            .BackColor = vbBlack
        Else
            .BackColor = vbWhite
        End If

        If .ForeColor = vbBlack Then
            .ForeColor = vbWhite
        Else
            .ForeColor = vbBlack
        End If
    End With
End Sub
Private Sub mnuOptEnabled_Click()
    mnuOptEnabled.Checked = Not mnuOptEnabled.Checked
    HexEdit1.Enabled = mnuOptEnabled.Checked
End Sub
Private Sub mnuOptExt_Click()
    mnuOptExt.Checked = Not mnuOptExt.Checked
    HexEdit1.ExtendedSelection = mnuOptExt.Checked
End Sub
Private Sub mnuOptReadOnly_Click()
    mnuOptReadOnly.Checked = Not mnuOptReadOnly.Checked
    HexEdit1.ReadOnly = mnuOptReadOnly.Checked
End Sub
Private Sub mnuOptSelColor_Click()
    With HexEdit1
        If .SelectedBackColor = vbBlue Then
            .SelectedBackColor = vbRed
        Else
            .SelectedBackColor = vbBlue
        End If

        If .SelectedForeColor = vbWhite Then
            .SelectedForeColor = vbBlue
        Else
            .SelectedForeColor = vbWhite
        End If
    End With
End Sub