MESSAGE.MES
This message file provides a sampling of the
features demonstrated in the Messages application.

Note that all of these lines appearing before
the first text block header will be ignored.

This is the first text block in the MESSAGE.MES file.
Notice that the display window sizes automatically for
the dimensions of the message. 

Close this display window to proceed to the next text
block in this file. Click the Close button in the 
upper-right corner of this message.
~~~ P 10
This message should automatically disappear in 10 seconds.
You may close it manually before then if you want.
~~~ F 2
This message should be in a flashing window, with the 
flash rate set to 2 times per second.
~~~ F 5
This message should be in a flashing window, with the
flash rate set to 5 times per second.
~~~ P 20 F 1
This is the last message in this file. The flash rate is 1 
time per second, and the message will disappear automatically
in 20 seconds if you don't close it manually before then.

Option Explicit

Private Sub cmdMessages_Click()
    `Declare new Message object
    Dim msgOne As New Message

    `Prompt user for message file (*.MES)
    cdlOne.DialogTitle = "Message Files"
    cdlOne.Flags = cdlOFNHideReadOnly
    cdlOne.Filter = "Messages(*.mes)|*.mes"
    cdlOne.CancelError = True
    On Error Resume Next
    cdlOne.ShowOpen
    `Quit if user canceled or closed dialog box
    If Err Then Exit Sub
    On Error GoTo 0
    `Display message file
    With msgOne
        .FileName = cdlOne.FileName
        .Display
    End With
End Sub

Private Sub Form_Load()
    `Center this form
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
End Sub

Private Sub mnuAbout_Click()
    `Set properties
    About.Application = "Messages"
    About.Heading = _
        "Microsoft Visual Basic 6.0 Developer's Workshop"
    About.Copyright = "1998 John Clark Craig and Jeff Webb"
    About.Display
End Sub

Private Sub mnuExit_Click()
    Unload Me

End Sub

Private Sub mnuContents_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpContents
    cdlOne.ShowHelp
End Sub

Private Sub mnuSearch_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpPartialKey
    cdlOne.ShowHelp
End Sub

Option Explicit

`Property that defines message file to be displayed
Public FileName As String


`Method to display message file
Public Sub Display()
    Dim strH As String
    Dim strJ As String
    Dim strA As String
    Dim strB As String
    Dim strC As String
    Dim intFilNum As Integer
    Dim lngNdx As Long
    Dim lngFlashRate As Long
    Dim lngPauseTime As Long
    Dim lngHeight As Long
    Dim lngWidth As Long
    Dim lngMaxTextWidth As Long
    `Get next available file I/O number
    intFilNum = FreeFile
    `Trap error if filename is invalid
    On Error Resume Next
    Open FileName For Input As #intFilNum
    If Err Then
        MsgBox "File not found: " & FileName
        Exit Sub
    End If
    On Error GoTo 0
    `Find start of first text block
    Do Until EOF(intFilNum)
        Line Input #intFilNum, strH
        `Skip lines until three tilde characters are found
        If InStr(strH, "~~~") = 1 Then
            strJ = UCase$(strH)
            Exit Do
        End If
    Loop
    `Loop through all text blocks

    Do Until EOF(intFilNum)
        strB = ""
        strH = strJ
        lngWidth = 0
        lngHeight = 0
        `Load all of current text block
        Do Until EOF(intFilNum)
            Line Input #intFilNum, strA
            `End of this block is at start of next block
            If InStr(strA, "~~~") = 1 Then
                strJ = UCase$(strA)
                Exit Do
            End If
            `Keep track of widest line of text
            lngMaxTextWidth = frmMsg.TextWidth(strA & "XX")
            If lngMaxTextWidth > lngWidth Then
                lngWidth = lngMaxTextWidth
            End If
            `Keep track of total height of all lines
            lngHeight = lngHeight + 1
            `Accumulate block of text lines
            If lngHeight > 1 Then
                strB = strB & vbCrLf & strA

            Else
                strB = strA
            End If
        Loop
        `Check for flash rate in block header
        lngNdx = InStr(strH, "F")
        If lngNdx Then
            lngFlashRate = Val(Mid$(strH, lngNdx + 1))
        Else
            lngFlashRate = 0

        End If
        `Check for pause time in block header
        lngNdx = InStr(strH, "P")
        If lngNdx Then
            lngPauseTime = Val(Mid$(strH, lngNdx + 1))
        Else
            lngPauseTime = 0
        End If
        `Prepare message form's text box
        With frmMsg.txtMsg
            .Text = strB
            .Left = 0
            .Top = 0
            .Width = lngWidth
            .Height = (lngHeight + 1) * frmMsg.TextHeight("X")
        End With
        `Prepare message form
        With frmMsg
            .Width = .txtMsg.Width + (.Width - .ScaleWidth)
            .Height = .txtMsg.Height + (.Height - .ScaleHeight)
            .Left = (Screen.Width - .Width) \ 2
            .Top = (Screen.Height - .Height) \ 2
            `Set flash and pause properties if given
            If lngPauseTime > 0 Then .Pause = lngPauseTime
            If lngFlashRate > 0 Then .Flash = lngFlashRate
        End With
        `Show message and wait until it closes
        frmMsg.Show vbModal
    Loop
End Sub

Option Explicit

Private Declare Function FlashWindow _
Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal bInvert As Long _
) As Long

Private Sub Form_Paint()
    `Remove focus from text box
    cmdDummy.Left = Screen.Width * 2
    cmdDummy.SetFocus
End Sub

Private Sub tmrTerminate_Timer()
    Unload Me
End Sub

Private Sub tmrFlash_Timer()
    `Toggle form flashing
    FlashWindow hwnd, CLng(True)
End Sub

Property Let Flash(PerSecond As Integer)
    `Set and activate form flashing rate

    tmrFlash.Interval = 1000 / PerSecond
    tmrFlash.Enabled = True
End Property

Property Let Pause(Seconds As Double)
    `Set and activate auto-unload timing
    tmrTerminate.Interval = 1000 * Seconds
    tmrTerminate.Enabled = True
End Property

Option Explicit

Private Sub cmdBrowse_Click()
    `Prompt user for filename
    cdlOne.DialogTitle = "Secret"
    cdlOne.Flags = cdlOFNHideReadOnly

    cdlOne.Filter = "All files (*.*)|*.*"
    cdlOne.CancelError = True
    On Error Resume Next
    cdlOne.ShowOpen
    `Grab filename
    If Err = 0 Then
        txtFile.Text = cdlOne.FileName
    End If
    On Error GoTo 0
End Sub

Private Sub cmdEncrypt_Click()
    `Make sure both passwords match exactly
    If txtPassword1.Text <> txtPassword2.Text Then
        MsgBox "The two passwords are not the same!", _
            vbExclamation, "Secret"
        Exit Sub
    End If
    `Encrypt file
    MousePointer = vbHourglass
    cmdEncrypt.Enabled = False
    cmdDecrypt.Enabled = False
    cmdView.Enabled = False
    cmdBrowse.Enabled = False
    Refresh
    Encrypt
    txtFile_Change
    MousePointer = vbDefault
End Sub

Private Sub cmdDecrypt_Click()
    MousePointer = vbHourglass
    cmdEncrypt.Enabled = False
    cmdDecrypt.Enabled = False

    cmdView.Enabled = False
    cmdBrowse.Enabled = False
    Refresh
    Decrypt
    txtFile_Change
    MousePointer = vbDefault
End Sub

Private Sub cmdView_Click()
    Dim strA As String
    Dim lngZndx As Long
    MousePointer = vbHourglass
    `Get file contents
    Open txtFile.Text For Binary As #1
    strA = Space$(LOF(1))
    Get #1, , strA
    Close #1
    Do
        lngZndx = InStr(strA, Chr$(0))
        If lngZndx = 0 Or lngZndx > 5000 Then Exit Do
        Mid$(strA, lngZndx, 1) = Chr$(1)
    Loop
    `Display file contents
    MousePointer = vbDefault
    frmView.rtfView.Text = strA
    frmView.Caption = "Secret - " & txtFile.Text
    frmView.Show vbModal
End Sub

Private Sub Form_Load()
    `Center this form
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
    `Disable most command buttons

    cmdEncrypt.Enabled = False
    cmdDecrypt.Enabled = False
    cmdView.Enabled = False
    `Initialize filename field
    txtFile.Text = ""
End Sub

Private Sub mnuAbout_Click()
    `Set properties
    About.Application = "Secret"
    About.Heading = _
        "Microsoft Visual Basic 6.0 Developer's Workshop"
    About.Copyright = "1998 John Clark Craig and Jeff Webb"
    About.Display
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuContents_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpContents
    cdlOne.ShowHelp
End Sub

Private Sub mnuSearch_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpPartialKey
    cdlOne.ShowHelp
End Sub

Private Sub txtFile_Change()
    Dim lngFileLen As Long

    Dim strHead As String
    `Check to see whether file exists
    On Error Resume Next
    lngFileLen = Len(Dir(txtFile.Text))
    `Disable buttons if filename isn't valid
    If Err <> 0 Or lngFileLen = 0 Or Len(txtFile.Text) = 0 Then
        cmdEncrypt.Enabled = False
        cmdDecrypt.Enabled = False
        cmdView.Enabled = False
        lblPassword1.Enabled = False
        txtPassword1.Enabled = False
        lblPassword2.Enabled = False
        txtPassword2.Enabled = False
        txtPassword2.Text = ""
        Exit Sub
    End If
    `Get first 8 bytes of selected file
    Open txtFile.Text For Binary As #1
    strHead = Space(8)
    Get #1, , strHead
    Close #1
    `Check to see whether file is already encrypted
    If strHead = "[Secret]" Then
        cmdEncrypt.Enabled = False
        cmdDecrypt.Enabled = True
        lblPassword2.Enabled = False
        txtPassword2.Enabled = False
        txtPassword2.Text = ""
    Else
        cmdEncrypt.Enabled = True
        cmdDecrypt.Enabled = False
        lblPassword2.Enabled = True
        txtPassword2.Enabled = True
    End If

    lblPassword1.Enabled = True
    txtPassword1.Enabled = True
    cmdBrowse.Enabled = True
    cmdView.Enabled = True
End Sub

Sub Encrypt()
    Dim strHead As String
    Dim strT As String
    Dim strA As String
    Dim cphX As New Cipher
    Dim lngN As Long
    Open txtFile.Text For Binary As #1
    `Load entire file into strA
    strA = Space$(LOF(1))
    Get #1, , strA
    Close #1
    `Prepare header string with salt characters
    strT = Hash(Date & Str(Timer))
    strHead = "[Secret]" & strT & Hash(strT & txtPassword1.Text)
    `Do the encryption
    cphX.KeyString = strHead
    cphX.Text = strA
    cphX.DoXor
    cphX.Stretch
    strA = cphX.Text
    `Write header
    Open txtFile.Text For Output As #1
    Print #1, strHead
    `Write encrypted data
    lngN = 1
    Do
        Print #1, Mid(strA, lngN, 70)
        lngN = lngN + 70

    Loop Until lngN > Len(strA)
    Close #1
End Sub

Sub Decrypt()
    Dim strHead As String
    Dim strA As String
    Dim strT As String
    Dim cphX As New Cipher
    Dim lngN As Long
    `Get header (first 18 bytes of encrypted file)
    Open txtFile.Text For Input As #1
    Line Input #1, strHead
    Close #1
    `Check for correct password
    strT = Mid(strHead, 9, 8)
    If InStr(strHead, Hash(strT & txtPassword1.Text)) <> 17 Then
        MsgBox "Sorry, this is not the correct password!", _
            vbExclamation, "Secret"
        Exit Sub
    End If
    `Get file contents
    Open txtFile.Text For Input As #1
    `Read past the header
    Line Input #1, strHead
    `Read and build the contents string
    Do Until EOF(1)
        Line Input #1, strT
        strA = strA & strT
    Loop
    Close #1
    `Decrypted file contents
    cphX.KeyString = strHead
    cphX.Text = strA

    cphX.Shrink
    cphX.DoXor
    strA = cphX.Text
    `Replace file with decrypted version
    Kill txtFile.Text
    Open txtFile.Text For Binary As #1
    Put #1, , strA
    Close #1
End Sub

Function Hash(strA As String) As String
    Dim cphHash As New Cipher
    cphHash.KeyString = strA & "123456"
    cphHash.Text = strA & "123456"
    cphHash.DoXor
    cphHash.Stretch
    cphHash.KeyString = cphHash.Text
    cphHash.Text = "123456"
    cphHash.DoXor
    cphHash.Stretch
    Hash = cphHash.Text
End Function

Option Explicit

Dim mblnBeenHereDoneThis As Boolean

Private Sub Form_Load()

    mblnBeenHereDoneThis = False

Private Sub Form_Resize()
    `Center this form, but only the first time
    If mblnBeenHereDoneThis = False Then
        Me.Left = (Screen.Width - Me.Width) \ 2
        Me.Top = (Screen.Height - Me.Height) \ 2
        mblnBeenHereDoneThis = True
    End If
    `Size RichTextBox to fill form
    rtfView.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

;BitPack.def
LIBRARY BitPack

EXPORTS
    BitGet
    BitSet
    BitClr

// BitPack.cpp : Defines the entry point for the DLL application
//

#include "stdafx.h"
#include "BitPack.h"

BOOL APIENTRY DllMain( HANDLE hModule, 
                       DWORD  ul_reason_for_call, 
                       LPVOID lpReserved
                     )
{
    switch (ul_reason_for_call)
    {
        case DLL_PROCESS_ATTACH:
        case DLL_THREAD_ATTACH:
        case DLL_THREAD_DETACH:
        case DLL_PROCESS_DETACH:
            break;
    }
    return TRUE;
}
BITPACK_API int _stdcall BitGet(LPBYTE bytes, int bitpos)
{
    return( bytes[bitpos >> 3] & (1 << (bitpos % 8)) ? 1: 0);
}

BITPACK_API int _stdcall BitSet(LPBYTE bytes, int bitpos)
{
    return( bytes[bitpos >> 3] |= (1 << (bitpos % 8)));
}

BITPACK_API int _stdcall BitClr(LPBYTE bytes, int bitpos)
{
    return( bytes[bitpos >> 3] &= ~(1 << (bitpos % 8)));
}

// The following ifdef block is the standard way of creating 
// macros that make exporting from a DLL simpler. All files 
// within this DLL are compiled with the BITPACK_EXPORTS
// symbol defined on the command line. This symbol should not 
// be defined on any project that uses this DLL. In this way, any 
// other project whose source files include this file see 
// BITPACK_API functions as being imported from a DLL, whereas 
// this DLL sees symbols defined with this macro as being exported.
#ifdef BITPACK_EXPORTS
#define BITPACK_API __declspec(dllexport)
#else
#define BITPACK_API __declspec(dllimport)
#endif

BITPACK_API int _stdcall BitGet(LPBYTE bytes, int bitpos);
BITPACK_API int _stdcall BitSet(LPBYTE bytes, int bitpos);
BITPACK_API int _stdcall BitClr(LPBYTE bytes, int bitpos);

Option Explicit

Private Declare Function BitGet _
Lib "BitPack.dll" ( _
    ByRef bytB As Byte, _
    ByVal lngN As Long _
) As Long

Private Declare Function BitSet _
Lib "BitPack.dll" ( _
    ByRef bytB As Byte, _
    ByVal lngN As Long _
) As Long

Private Declare Function BitClr _
Lib "BitPack.dll" ( _
    ByRef bytB As Byte, _
    ByVal lngN As Long _
) As Long

`Change output path or filename here
Const FileName = "C:\Windows\Desktop\Primes.txt"

Private Sub cmdPrimes_Click()
    Dim lngN As Long
    Dim lngI As Long
    Dim lngJ As Long
    Dim lngK As Long

    Dim lngNext As Long
    Dim lngLast As Long
    Dim bytAry() As Byte
    Dim strP As String
    `Show hourglass while busy
    MousePointer = vbHourglass
    cmdPrimes.Visible = False
    prgOne.Visible = True
    prgOne.Value = 0
    `Get largest prime number specified
    lngN = Abs(Val(txtMaxPrime.Text))
    `Match only odd numbers to bits in byte array
    ReDim bytAry(lngN \ 16)
    `Keep user informed of progress
    lblStatus.Caption ="Generating prime numbers tableDear John, How Do I... "
    Refresh
    `Process byte array; 0 bits represent prime numbers
    lngK = (lngN - 3) \ 2
    For lngI = 0 To lngK
        `If next number is primeDear John, How Do I... 
        If BitGet(bytAry(0), lngI) = 0 Then
            `Dear John, How Do I... set bits that are multiples
            For lngJ = 3 * lngI + 3 To lngK Step 2 * lngI + 3
                BitSet bytAry(0), lngJ
            Next lngJ
            `Update progress bar, but not too often
            lngNext = Int(100 * lngI / lngK)
            If lngNext <> lngLast Then
                lngLast = lngNext
                prgOne.Value = lngNext
            End If
        End If
    Next lngI
    `Keep user informed

    lblStatus.Caption = "Writing prime numbers fileDear John, How Do I... "
    lngLast = 0
    prgOne.Value = 0
    Refresh
    `Write primes to file on desktop
    Open FileName For Output As #1
    `Bit table starts at 3, so output 2 as prime
    Print #1, "Prime numbers up to" & Str$(lngN) & vbCrLf
    strP = "2"
    For lngI = 0 To lngK
        `If prime numberDear John, How Do I... 
        If BitGet(bytAry(0), lngI) = 0 Then
            `Concatenate number to string for output
            strP = strP & Str$(lngI + lngI + 3)
            `If string is long enoughDear John, How Do I... 
            If Len(strP) > 65 Then
                `Output string to file
                Print #1, LTrim$(strP)
                `Prepare for next line of output
                strP = ""
                `Update progress bar, but not too often
                lngNext = Int(100 * lngI / lngK)
                If lngNext > lngLast Then
                    lngLast = lngNext
                    prgOne.Value = lngNext
                End If
            End If
        End If
    Next lngI
    `Print any last-line primes
    Print #1, LTrim$(strP)
    Close #1
    `Set form to original visible state
    lblStatus.Caption = ""

    cmdPrimes.Visible = True
    prgOne.Visible = False
    MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    txtMaxPrime.Text = ""
    lblStatus.Caption = ""
    prgOne.Visible = False
End Sub

Private Sub mnuAbout_Click()
    `Set properties
    About.Application = "BitPack"
    About.Heading = _
        "Microsoft Visual Basic 6.0 Developer's Workshop"
    About.Copyright = "1998 John Clark Craig and Jeff Webb"
    About.Display
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuContents_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpContents
    cdlOne.ShowHelp
End Sub

Private Sub mnuSearch_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpPartialKey
    cdlOne.ShowHelp
End Sub

Option Explicit

Dim mvntX, mvntY
Dim mvntLastSec
Dim mvntEggX(1 To 4)
Dim mvntEggY(1 To 4)

Private Sub Form_Click()
    Dim intI As Integer
    `Keep track of last four clicks on form
    For intI = 1 To 3
        mvntEggX(intI) = mvntEggX(intI + 1)
        mvntEggY(intI) = mvntEggY(intI + 1)
    Next intI
    mvntEggX(4) = mvntX
    mvntEggY(4) = mvntY
    `Check for correct sequence and position
    If Abs(mvntEggX(1) - 70) < 30 And _
        Abs(mvntEggY(1) - 60) < 30 And _
        Abs(mvntEggX(2) - 360) < 30 And _
        Abs(mvntEggY(2) - 60) < 30 And _
        Abs(mvntEggX(3) - 360) < 30 And _

        Abs(mvntEggY(3) - 290) < 30 And _
        Abs(mvntEggX(4) - 70) < 30 And _
        Abs(mvntEggY(4) - 290) < 30 Then
        `Display hidden message
        dlgEgg.Show vbModal
    End If
End Sub

Private Sub Form_Load()
    `Center this form
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
    `Adjust button bar height
    picTop.Height = cmdOpen.Height + _
        (picTop.Height - picTop.ScaleHeight)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
    `Signal timer to update status bar
    mvntLastSec = -1
    `Keep track of mouse location
    mvntX = X

    mvntY = Y
End Sub

Private Sub Form_Paint()
    Dim lngN As Long
    With Me
        .ScaleMode = vbPixels
        .DrawStyle = 5 `Transparent
        .DrawWidth = 1
    End With

    `Draw sunset background (fade from red to yellow)
    For lngN = 0 To ScaleHeight Step ScaleHeight \ 16
        Line (-1, lngN - 1) -
(ScaleWidth, lngN + ScaleHeight \ 16), _
            RGB(255, lngN * 255 \ ScaleHeight, 0), BF
    Next lngN
End Sub

Private Sub mnuAbout_Click()
    `Set properties for the About dialog
    About.Application = "Dialogs"
    About.Heading = _
        "Microsoft Visual Basic 6.0 Developer's Workshop"
    About.Copyright = "1998 John Clark Craig and Jeff Webb"
    About.Display
End Sub

Private Sub mnuAbout2_Click()
    `Display the About2 dialog
    frmAbout2.Display
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuContents_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpContents
    cdlOne.ShowHelp
End Sub

Private Sub mnuSearch_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"

    cdlOne.HelpCommand = cdlHelpPartialKey
    cdlOne.ShowHelp
End Sub

Private Sub picScreen_Click()
    Dim vntXpct
    Dim vntYpct
    `Determine mouse's relative position in picture
    vntXpct = 100 * mvntX \ picScreen.ScaleWidth
    vntYpct = 100 * mvntY \ picScreen.ScaleHeight
    `Move form's center to same relative position on screen
    Me.Left = Screen.Width * vntXpct \ 100 - Me.Width \ 2
    Me.Top = Screen.Height * vntYpct \ 100 - Me.Height \ 2
    `Set timer to move form back later
    tmrRelocate.Enabled = True
End Sub

Private Sub picScreen_MouseMove(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)
    `Keep track of mouse location
    mvntX = X
    mvntY = Y
    `Update status message at bottom of form
    stbBottom.SimpleText = "Click to temporarily relocate " & _
        "center of this form on desktop"
    `Signal timer not to display date and time in status bar
    mvntLastSec = -2
End Sub

Private Sub cmdColor_Click()
    `Set flags for Color dialog box
    cdlOne.Flags = cdlCCRGBInit
    `Show Color dialog box
    cdlOne.ShowColor

    `Display selected color value
    MsgBox "&H" & Hex$(cdlOne.Color), , _
        "Selected colorDear John, How Do I... "
End Sub

Private Sub cmdFont_Click()
    Dim strTab2 As String
    strTab2 = vbTab & vbTab
    `Set flags for Font dialog box
    cdlOne.Flags = cdlCFWYSIWYG + cdlCFBoth + cdlCFScalableOnly
    `Show Font dialog box
    cdlOne.ShowFont
    `Display selected font values
    MsgBox _
        "Font Name:" & vbTab & cdlOne.FontName & vbCrLf & _
        "Font Size:" & strTab2 & cdlOne.FontSize & vbCrLf & _
        "Bold:" & strTab2 & cdlOne.FontBold & vbCrLf & _
        "Italic:" & strTab2 & cdlOne.FontItalic, , _
        "Selected fontDear John, How Do I... "
End Sub

Private Sub cmdOpen_Click()
    `Set up sample filter for Open dialog box
    Dim strBat As String
    Dim strTxt As String
    Dim strAll As String
    strBat = "Batch Files (*.bat)|*.bat"
    strTxt = "Text Files (*.txt)|*.txt"
    strAll = "All Files (*.*)|*.*"
    cdlOne.Filter = strBat & "|" & strTxt & "|" & strAll
    `Set default filter to third one listed
    cdlOne.FilterIndex = 3
    `Hide "ReadOnly" check box

    cdlOne.Flags = cdlOFNHideReadOnly
    `Deselect previously selected file, if any
    cdlOne.FileName = ""
    `Show Open dialog box
    cdlOne.ShowOpen
    `Display selected filename
    If cdlOne.FileName = "" Then Exit Sub
    MsgBox cdlOne.FileName, , "Selected fileDear John, How Do I... "
End Sub

Private Sub cmdPrint_Click()
    Dim strPrintToFile As String
    `Set flags for Print dialog box
    cdlOne.Flags = cdlPDAllPages + cdlPDNoSelection
    `Set imaginary page range
    cdlOne.Min = 1
    cdlOne.Max = 100
    cdlOne.FromPage = 1
    cdlOne.ToPage = 100
    `Show Print dialog box
    cdlOne.ShowPrinter
    `Extract some printer data
    If cdlOne.Flags And cdlPDPrintToFile Then
        strPrintToFile = "Yes"
    Else
        strPrintToFile = "No"
    End If
    `Display selected print values
    MsgBox _
        "Begin Page:" & vbTab & cdlOne.FromPage & vbCrLf & _
        "End Page:" & vbTab & cdlOne.ToPage & vbCrLf & _
        "No. Copies:" & vbTab & cdlOne.Copies & vbCrLf & _
        "Print to File:" & vbTab & strPrintToFile _

        , , "Selected print informationDear John, How Do I... "
End Sub

Private Sub cmdSave_Click()
    `Set up filter for Save As dialog box
    Dim strBat As String
    Dim strTxt As String
    Dim strAll As String
    strBat = "Batch Files (*.bat)|*.bat"
    strTxt = "Text Files (*.txt)|*.txt"
    strAll = "All Files (*.*)|*.*"
    cdlOne.Filter = strBat & "|" & strTxt & "|" & strAll
    `Set default filter to third one listed
    cdlOne.FilterIndex = 3
    `Hide ReadOnly check box
    cdlOne.Flags = cdlOFNHideReadOnly
    `Deselect previously selected file, if any
    cdlOne.FileName = ""
    `Show the Save As dialog box
    cdlOne.ShowSave
    `Display the selected file
    If cdlOne.FileName = "" Then Exit Sub
    MsgBox cdlOne.FileName, , "`Save As' fileDear John, How Do I... "
End Sub

Private Sub tmrRelocate_Timer()
    `Relocate form once per move
    tmrRelocate.Enabled = False
    `Center this form
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
End Sub

Private Sub tmrClock_Timer()

    Dim vntSec
    vntSec = Second(Now)
    If vntSec = mvntLastSec Then Exit Sub
    If mvntLastSec = -2 Then Exit Sub
    mvntLastSec = vntSec
    `Update date and time in status line
    stbBottom.SimpleText = Format(Date, "Long Date") & _
        Space$(5) & Format(Time, "hh:mm AMPM")
End Sub

Option Explicit

Private Sub tmrQuit_Timer()
    Unload Me
End Sub