cpp4vb.frm

The code for this article was written for version 1.0 of the Active Template Library (ATL). The cu

VERSION 4.00
Begin VB.Form FCppForVB 
   AutoRedraw      =   -1  'True
   Caption         =   "C++ For Visual Basic"
   ClientHeight    =   7836
   ClientLeft      =   1092
   ClientTop       =   1608
   ClientWidth     =   11088
   BeginProperty Font 
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   7.8
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   8160
   Icon            =   "Cpp4VB.frx":0000
   Left            =   1044
   LinkTopic       =   "Form1"
   ScaleHeight     =   7836
   ScaleWidth      =   11088
   Top             =   1332
   Width           =   11184
   Begin VB.CommandButton cmdFind 
      Caption         =   "String Find"
      Height          =   495
      Left            =   132
      TabIndex        =   11
      Top             =   5520
      Width           =   1335
   End
   Begin VB.CommandButton cmdExist 
      Caption         =   "Exist File"
      Height          =   495
      Left            =   132
      TabIndex        =   10
      Top             =   4920
      Width           =   1335
   End
   Begin VB.CommandButton cmdSA 
      Caption         =   "SAFEARRAY"
      Height          =   495
      Left            =   132
      TabIndex        =   9
      Top             =   3720
      Width           =   1335
   End
   Begin VB.CommandButton cmdBSTR 
      Caption         =   "BSTR"
      Height          =   495
      Left            =   132
      TabIndex        =   8
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton cmdVariant 
      Caption         =   "Variant"
      Height          =   495
      Left            =   132
      TabIndex        =   7
      Top             =   2520
      Width           =   1335
   End
   Begin VB.CommandButton cmdArray 
      Caption         =   "Safe Array"
      Height          =   495
      Left            =   132
      TabIndex        =   6
      Top             =   3120
      Width           =   1335
   End
   Begin VB.CommandButton cmdParamArray 
      Caption         =   "ParamArray"
      Height          =   495
      Left            =   132
      TabIndex        =   5
      Top             =   4320
      Width           =   1335
   End
   Begin VB.CommandButton cmdBString 
      Caption         =   "BString"
      Height          =   495
      Left            =   132
      TabIndex        =   4
      Top             =   1320
      Width           =   1335
   End
   Begin VB.TextBox txtTest 
      BeginProperty Font 
         name            =   "Courier"
         charset         =   0
         weight          =   700
         size            =   9.6
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   6492
      Left            =   1560
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Top             =   108
      Width           =   9372
   End
   Begin VB.CommandButton cmdWin32 
      Caption         =   "Win32"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   1335
   End
   Begin VB.CommandButton cmdBits 
      Caption         =   "Bits"
      Height          =   495
      Left            =   132
      TabIndex        =   1
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   495
      Left            =   132
      TabIndex        =   0
      Top             =   6120
      Width           =   1335
   End
End
Attribute VB_Name = "FCppForVB"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdArray_Click()
    Dim aiInOut() As Integer
    ReDim Preserve aiInOut(1 To 8) As Integer
    Dim asOut() As String
    Dim va As Variant, i As Integer, s As String
    s = "Before:" & sCrLf & _
         "aiInOut(" & LBound(aiInOut) & " To " & UBound(aiInOut, 1) & ") As " & _
                      TypeName(aiInOut(LBound(aiInOut))) & sCrLf
    For i = LBound(aiInOut) To UBound(aiInOut)
        aiInOut(i) = i * i
        s = s & CStr(aiInOut(i)) & " "
    Next
    s = s & sCrLf
    BugMessage s
    va = TestSafeArray(aiInOut(), asOut())
    s = s & "After:" & sCrLf & _
         "aiInOut(" & LBound(aiInOut) & " To " & UBound(aiInOut) & ") As " & _
                      TypeName(aiInOut(LBound(aiInOut))) & sCrLf
    For i = LBound(aiInOut) To UBound(aiInOut)
        s = s & CStr(aiInOut(i)) & " "
    Next
    s = s & sCrLf
    s = s & "asOut(" & LBound(asOut()) & " To " & UBound(asOut()) & ") As " & _
            TypeName(asOut(LBound(asOut))) & sCrLf
    For i = LBound(asOut) To UBound(asOut)
        s = s & CStr(asOut(i)) & " "
    Next
    s = s & sCrLf
    s = s & "va(" & LBound(va) & " To " & UBound(va) & ") As " & _
            TypeName(va(LBound(va))) & sCrLf
    For i = LBound(va) To UBound(va)
        s = s & CStr(va(i)) & " "
    Next
    BugMessage s
    txtTest = s
End Sub

Private Sub cmdBSTR_Click()
    ' Must test in C++ debugger
    TestBStr
    Dim sIn As String, sInOut As String, sOut As String, sRet As String
    Dim s As String
    sIn = "Send me in"
    sInOut = "I'm in and out"
    s = s & "Before: " & sCrLf & _
            "   In parameter: " & sIn & sCrLf & _
            "   In/Out parameter: " & sInOut & sCrLf & _
            "   Out parameter: N/A" & sCrLf & _
            "   Return value: " & sRet & sCrLf
    sRet = TestBStrArgs(sIn, sInOut, sOut)
    s = s & "After: " & sCrLf & _
            "   In parameter: " & sIn & sCrLf & _
            "   In/Out parameter: " & sInOut & sCrLf & _
            "   Out parameter: " & sOut & sCrLf & _
            "   Return value: " & sRet & sCrLf
    txtTest = s
End Sub

Private Sub cmdBString_Click()
    Dim sIn As String, sInOut As String, sOut As String, sRet As String
    Dim s As String
    sIn = "Send me in"
    sInOut = "I'm going in..."
    s = s & "Before: " & sCrLf & _
            "   In parameter: " & sIn & sCrLf & _
            "   In/Out parameter: " & sInOut & sCrLf & _
            "   Out parameter: " & sOut & sCrLf & _
            "   Return value: " & sRet & sCrLf
    sRet = TestString(sIn, sInOut, sOut)
    s = s & "After: " & sCrLf & _
            "   In parameter: " & sIn & sCrLf & _
            "   In/Out parameter: " & sInOut & sCrLf & _
            "   Out parameter: " & sOut & sCrLf & _
            "   Return value: " & sRet & sCrLf
    BugMessage s
    txtTest = s
End Sub

Private Sub cmdExist_Click()

    Dim sName As String, s As String
    ' Test ExistFile
    s = "Test ExistFile" & sCrLf & sCrLf
    sName = Environ$("COMSPEC")
    s = s & "File " & sName & " exists: " & ExistFile(sName) & sCrLf
    sName = "nosuch.txt"
    s = s & "File " & sName & " exists: " & ExistFile(sName) & sCrLf
    txtTest = s
End Sub

Private Sub cmdFind_Click()
    Dim sTarget As String, sFind As String, s As String, i As Long, vPos As Variant
    sTarget = "A string In a String in a String in a string."
    vPos = 1
    s = s & sTarget & sCrLf
      s = s & "12345678901234567890123456789012345678901234567890" & sCrLf
    i = InStr(sTarget, "S")
    s = s & "i = InStr(sTarget, ""S"")              ' Found at position: " & i & sCrLf
    i = InStrR(sTarget, "S")
    s = s & "i = InStrR(sTarget, ""S"")             ' Found at position: " & i & sCrLf
    ' InStr can't use default position if Compare argument given
    i = InStr(1, sTarget, "S", 1)
    s = s & "i = InStr(1, sTarget, ""S"", 1)        ' Found at position: " & i & sCrLf
    ' InStrR can use default position if Compare argument given
    i = InStrR(sTarget, "S", 1)
    s = s & "i = InStrR(sTarget, ""S"", 1)          ' Found at position: " & i & sCrLf
    i = InStr(5, sTarget, "S", 1)
    s = s & "i = InStr(5, sTarget, ""S"", 1)        ' Found at position: " & i & sCrLf
    i = InStrR(42, sTarget, "S", 1)
    s = s & "i = InStrR(42, sTarget, ""S"", 1)      ' Found at position: " & i & sCrLf
    i = InStrR(sTarget, "Z")
    s = s & "i = InStrR(sTarget, ""Z"")             ' Found at position: " & i & sCrLf
    i = InStr(sTarget, "String")
    s = s & "i = InStr(sTarget, ""String"")         ' Found at position: " & i & sCrLf
    i = InStrR(sTarget, "String")
    s = s & "i = InStrR(sTarget, ""String"")        ' Found at position: " & i & sCrLf
    ' InStr can't use default position if Compare argument given
    i = InStr(1, sTarget, "String", 1)
    s = s & "i = InStr(1, sTarget, ""String"", 1)   ' Found at position: " & i & sCrLf
    ' InStrR can use default position if Compare argument given
    i = InStrR(sTarget, "String", 1)
    s = s & "i = InStrR(sTarget, ""String"", 1)     ' Found at position: " & i & sCrLf
    i = InStr(5, sTarget, "string", 1)
    s = s & "i = InStr(5, sTarget, ""string"", 1)   ' Found at position: " & i & sCrLf
    i = InStrR(42, sTarget, "String", 1)
    s = s & "i = InStrR(42, sTarget, ""String"", 1) ' Found at position: " & i & sCrLf
    i = InStrR(sTarget, "Ztring")
    s = s & "i = InStrR(sTarget, ""Ztring"")        ' Found at position: " & i & sCrLf
   
    txtTest = s
    
End Sub

Private Sub cmdParamArray_Click()
    Dim s As String
    s = s & "AddEmUp(7, 9.4, ""24"")  = "
    s = s & AddEmUp(7, 9.4, "24") & sCrLf
    s = s & "AddEmUp(, 9.4, , ""24"") = "
    s = s & AddEmUp(, 9.4, , "24") & sCrLf
    s = s & "AddEmUp(7, ""24"")       = "
    s = s & AddEmUp(7, "24") & sCrLf
    BugMessage s
    txtTest = s
End Sub

Private Sub cmdSA_Click()
    Dim va As Variant
    Dim aiInOut() As Integer
    ReDim Preserve aiInOut(1 To 4, 1 To 4) As Integer
    Dim asOut() As String
    Dim x As Integer, y As Integer, s As String
    s = s & "Before:" & sCrLf & _
            "aiInOut(" & LBound(aiInOut) & " To " & UBound(aiInOut, 1) & ", " & _
                         LBound(aiInOut, 2) & " To " & UBound(aiInOut, 2) & ") As " & _
                         TypeName(aiInOut(LBound(aiInOut, 1), LBound(aiInOut, 2))) & sCrLf
    For x = LBound(aiInOut, 1) To UBound(aiInOut, 1)
        For y = LBound(aiInOut, 2) To UBound(aiInOut, 2)
            aiInOut(x, y) = x * y
            s = s & CStr(aiInOut(x, y)) & " "
        Next
        s = s & sCrLf
    Next
    BugMessage s
    va = TestSA(aiInOut(), asOut())
    s = s & "After:" & sCrLf & _
            "aiInOut(" & LBound(aiInOut, 1) & " To " & UBound(aiInOut, 1) & ", " & _
                         LBound(aiInOut, 2) & " To " & UBound(aiInOut, 2) & ") As " & _
                         TypeName(aiInOut(LBound(aiInOut, 1), LBound(aiInOut, 2))) & sCrLf
    For x = LBound(aiInOut, 1) To UBound(aiInOut, 1)
        For y = LBound(aiInOut, 2) To UBound(aiInOut, 2)
            s = s & CStr(aiInOut(x, y)) & " "
        Next
        s = s & sCrLf
    Next
    s = s & "asOut(" & LBound(asOut()) & " To " & UBound(asOut()) & ") As " & _
            TypeName(asOut(LBound(asOut))) & sCrLf
    For x = LBound(asOut) To UBound(asOut)
        s = s & CStr(asOut(x)) & " "
    Next
    s = s & sCrLf
    s = s & "va(" & LBound(va) & " To " & UBound(va) & ") As " & _
            TypeName(va(LBound(va))) & sCrLf
    For x = LBound(va) To UBound(va)
        s = s & CStr(va(x)) & " "
    Next
    BugMessage s
    txtTest = s
    
End Sub

Private Sub cmdVariant_Click()
    Dim vRet As Variant, vIn As Variant, vInOut As Variant, vOut As Variant
    Dim s As String, sIn As String
    Dim obj As Object
    txtTest = "Send me in"
    vIn = cmdWin32
    vIn = "Send me in"
    sIn = "Send me in"
    vInOut = "I'm going in..."
    s = s & "Before: " & sCrLf & _
            "   In parameter: " & vIn & sCrLf & _
            "   In/Out parameter: " & vInOut & sCrLf & _
            "   Out parameter: " & vOut & sCrLf & _
            "   Return value: " & vRet & sCrLf
    vRet = TestVariant(sIn, vInOut, vOut)
    s = s & "After: " & sCrLf & _
            "   In parameter: " & vIn & sCrLf & _
            "   In/Out parameter: " & vInOut & sCrLf & _
            "   Out parameter: " & vOut & sCrLf & _
            "   Return value: " & vRet & sCrLf