vbAccelerator - Contents of code file: frmMain.frm

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "vbAccelerator Modal Form Emulation Demonstration"
   ClientHeight    =   4395
   ClientLeft      =   2820
   ClientTop       =   3045
   ClientWidth     =   7860
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4395
   ScaleWidth      =   7860
   Begin VB.Timer tmrInfo 
      Interval        =   200
      Left            =   2700
      Top             =   3840
   End
   Begin VB.ListBox lstInfo 
      Height          =   2985
      Left            =   3240
      TabIndex        =   5
      Top             =   1260
      Width           =   4455
   End
   Begin VB.CommandButton cmdNewMain 
      Caption         =   "&New Form"
      Height          =   555
      Left            =   180
      TabIndex        =   2
      Top             =   2280
      Width           =   1215
   End
   Begin VB.CommandButton cmdEmulated 
      Caption         =   "Emulated..."
      Height          =   555
      Left            =   1440
      TabIndex        =   1
      Top             =   1260
      Width           =   1215
   End
   Begin VB.CommandButton cmdVB 
      Caption         =   "VB..."
      Height          =   555
      Left            =   180
      TabIndex        =   0
      Top             =   1260
      Width           =   1215
   End
   Begin VB.Label lblLogInfo 
      BackColor       =   &H80000010&
      Caption         =   " Shown Forms and Dialogs"
      Height          =   255
      Left            =   3240
      TabIndex        =   7
      Top             =   900
      Width           =   4455
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmMain.frx":1272
      Height          =   675
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   7515
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000010&
      Caption         =   " Instance Creation"
      Height          =   255
      Left            =   180
      TabIndex        =   4
      Top             =   1980
      Width           =   2955
   End
   Begin VB.Label lblModalDemo 
      BackColor       =   &H80000010&
      Caption         =   " Show Modal Form"
      Height          =   255
      Left            =   180
      TabIndex        =   3
      Top             =   900
      Width           =   2955
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdNewMain_Click()
   Dim candLeft As Long
   Dim candTop As Long
   candLeft = Me.Left + Screen.TwipsPerPixelX * 16
   candTop = Me.Top + Screen.TwipsPerPixelY * 16
   Dim f As New frmMain
   f.Left = IIf(candLeft + Me.Width > Screen.Width, 0, candLeft)
   f.Top = IIf(candTop + Me.Height > Screen.Height, 0, candTop)
   f.Show
End Sub

Private Sub cmdVB_Click()
Dim f As New frmDialog
   f.Label = "Shown Modally from frmMain (&H" & Hex(hwnd) & ") using VB Show
    Modal"
   f.Show vbModal, Me
   If Not f.Cancelled Then
      'MsgBox "OK"
   Else
      'MsgBox "CANCELLED"
   End If
End Sub

Private Sub cmdEmulated_Click()
   Dim f As New frmDialog
   Dim c As New cShowModal
   f.Label = "Shown Modally from frmMain (&H" & Hex(hwnd) & ") using cShowModal
    Emulation"
   c.ShowModal f, Me
   If Not f.Cancelled Then
      'MsgBox "OK"
   Else
      'MsgBox "CANCELLED"
   End If
End Sub

Private Sub Form_Load()
   Me.Caption = "(&H" & Hex(hwnd) & ") " & Me.Caption
End Sub

Private Sub tmrInfo_Timer()
   '
   Dim i As Long
   If (lstInfo.ListCount > 0) Then
      ReDim hWndOrig(0 To lstInfo.ListCount - 1) As Long
      ReDim bStillThere(0 To lstInfo.ListCount - 1) As Boolean
      For i = 0 To lstInfo.ListCount - 1
         hWndOrig(i) = lstInfo.ItemData(i)
      Next i
   End If
   
   Dim frm As Form
   Dim bFound As Boolean
   Dim hWndNew() As Long
   Dim capNew() As String
   Dim lNewCount As Long
   For Each frm In Forms
      For i = 0 To lstInfo.ListCount - 1
         bFound = False
         If (hWndOrig(i) = frm.hwnd) Then
            bStillThere(i) = True
            bFound = True
            Exit For
         End If
      Next i
      If Not (bFound) Then
         lNewCount = lNewCount + 1
         ReDim Preserve hWndNew(0 To lNewCount - 1) As Long
         ReDim Preserve capNew(0 To lNewCount - 1) As String
         hWndNew(lNewCount - 1) = frm.hwnd
         capNew(lNewCount - 1) = frm.Caption
      End If
   Next
   
   If (lstInfo.ListCount > 0) Then
      For i = UBound(hWndOrig) To 0 Step -1
         If Not (bStillThere(i)) Then
            lstInfo.RemoveItem i
         End If
      Next i
   End If
   For i = 0 To lNewCount - 1
      lstInfo.AddItem capNew(i)
      lstInfo.ItemData(lstInfo.NewIndex) = hWndNew(i)
   Next i
   '
End Sub