modmain.bas

一个把VB原代码转换为VC原代码的软件代码。

Attribute VB_Name = "ModMain"
' -------------------------------------
' VB2Cpp - Visual Basic to C++ translator.
' Copyright (C) 2002-2003 Franck Charlet.
'
' VB2Cpp is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2, or (at your option)
' any later version.
'
' VB2Cpp is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with VB2Cpp; see the file Copying.txt.  If not, write to
' the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
' Boston, MA 02111-1307, USA.
' -------------------------------------
' Example 5
' Test our lousy parser with some garbage.
' -------------------------------------

Option Explicit
Option Private Module
Option Compare Text

Enum someEnum       ' comment...
    enum1
    enum2
    enum4 = 8       ' wrap to 8
    enum5           ' Should be 9
End Enum            ' comment here too...

Type testtype               ' test for comment 1
    member1 As Boolean      ' test for comment 2
    member2 As Long
    member3 As Integer
    member4 As Byte
    member5 As Single
    member6 As Double
    member7(1) As String
    member8(3) As Boolean
    member9(3) As Long
    member10(3) As Integer
    member11(3) As Byte
    member12(3) As Single
    member13(3) As Double
End Type                    ' test for comment 3

Const testcont1 As Long = 10
Global Const testcont2 = 20
Const testcont3 As String = "test constant"         ' a comment again

Public mytype As testtype
Public myarray1(0) As testtype
Public myarray2() As Long
Public myarray3(0) As Single
Public myarray4(1 + 8) As Long
Public myarray5(0 To 1) As Long
Public myarray6(0 To 10 + 4, 0 To 10) As Long        ' another one
Public myarray7(1, 10, 20) As Single

Public Type yyy

    y1 As Long
    y2 As String
End Type

Public Sub Main()
    Randomize
    Dim tt As Single
    Dim RandomNumber As Integer
    Dim ggg As String
    MsgBox Anotherfunction(ggg) & " " & Anotherfunctions3
    ' Atgument Should be modified inside the previous function
    ' Displayed value should be "1234" and not "7771234"
    MsgBox ggg
    ' Generate a random number from 1 to 6 (looks familiar ?)
    tt = Rnd
    RandomNumber = Int((6 * tt) + 1)
    GoSub TestGosub1
TestGosub1:
    MsgBox RandomNumber & " " & tt
    GoSub 1000
    End
1000:
    Dim StrVar As String
    Dim StrVar2 As String
    Dim LngVar As Long
    GoTo 10
10    LngVar = vbObjectError
30  ' comment test
40  ReDim myarray2(0)
    myarray2(0) = 10
    myarray6(0, 0) = 123456
    myarray3(0) = 1.12345678978979
    myarray7(1, 10, 20) = myarray3(0)
    Dim yy As String
    yy = 10
    myarray5(1) = Afunction$(1888, , yy)
    mytype.member1 = True
    mytype.member7(1) = True
    mytype.member7(1) = mytype.member1
    mytype.member1 = myarray1(0).member2
    #Const DBG = 2
    #If DBG Then
    #ElseIf Not DBG Then
    #End If
label:
If 1# = 10 Then     ' comment
    End If
label2: Rem command
    Rem a comment
    ' another comment
    Select Case "0165"
        Case StrVar
    End Select
    Select Case StrVar2
        Case "test1"
        Case Is <> "test2"
            Select Case StrVar2
                Case "0165"
                Case "01.65"
                Case Is <> "test3"
                    Select Case StrVar
                        Case "test4"
                        Case "test5"
                        Case "test6"
                            If StrVar = "44" And "42" = StrVar2 Then If "42.4" = StrVar2 Then If "test9" <> StrVar2 Or "test10" <> StrVar2 Then If LngVar <> 10 Then LngVar = 42
                        Case "01.65"
                            StrVar2 = 42 & StrVar2 & LngVar
                            Mid(StrVar2, 2, 1) = 42 & StrVar2 & LngVar
                        Case "test7"
                            Select Case StrVar
                                Case LngVar
                            End Select
                        Case "test8"
                            Select Case StrVar
                                Case "0165"
                            End Select
                    End Select
                Case "123456"
            End Select
        Case "toto8"
        Case Else
    End Select
    Select Case LngVar
        Case 0
        Case vbObjectError
            If "42" = StrVar2 Then If "42.4" = StrVar2 Then If "test9" <> StrVar2 Or "test10" <> StrVar2 Then If LngVar <> 10 Then LngVar = 42
        Case 2
        Case 3
        Case 4
    End Select
    Dim tttt As yyy
    tttt.y1 = 77
    tttt.y2 = "1111"
    ASub "1234" & "ddd", tttt, 11, 12, 13, 55, False
    If LngVar = 42 Then
        If StrVar2 = "42" Then
        End If
        If "42" = StrVar2 Then If "42.4" = StrVar2 Then If "test9" <> StrVar2 Or "test10" <> StrVar2 Then If LngVar <> 10 Then LngVar = 42
    End If
    Dim x As Boolean
    Dim toto As String
    toto = "1.1"
    x = IsNumeric("0,000000011")
    MsgBox LngVar & vbNewLine & x & vbNewLine & myarray3(0) & vbNewLine & myarray7(1, 10, 20), vbInformation + vbOKOnly, "Test"
    x = IsNumeric(toto)
    MsgBox x, vbInformation + vbOKOnly, "Test"
    toto = "1,1" & "4"
    x = IsNumeric(toto)
    GoTo 100
    MsgBox x, vbInformation + vbOKOnly, "Test"
    toto = --------&H1234&      ' should be positive
100:    toto = 1.1!       'comment #42354680
    x = IsNumeric(toto)
    MsgBox x, vbInformation + vbOKOnly, "Test" 'comment #42354681
    x = IsNumeric(1.1)
    Dim tot As Double
    tot = 3#
    x = tot
    MsgBox App.Title & MsgBox(x) & vbNewLine & Afunction(-------5.5) & vbCr & IsNumeric(x)
    x = MsgBox(x, vbInformation + vbOKOnly, "Test")
    MsgBox x, vbInformation + vbOKOnly
    x = "false"
    MsgBox x, vbInformation + vbOKOnly, "Test"
    Return
End Sub

Public Function Afunction(arg0 As Single, Optional Arg1 As Long = -1, Optional Arg2 As String = "optional test") As String
    
    Afunction = Arg2
    Arg2 = "toto"
End Function

' String passed by reference
Public Function Anotherfunction(tt As String) As String
    If tt = "777" Then
        tt = tt & "1234"
        Exit Function
    End If
    tt = "1234"
    Anotherfunction = tt
    Anotherfunction "777"
End Function

' String passed by value
Public Function Anotherfunction2(ByVal tt As String) As String
    tt = "5678"
End Function

Public Sub ASub(ASub As String, ByRef toto As yyy, ByRef toto2 As Byte, ByRef toto3 As Double, ByRef toto4 As Single, ByRef toto5 As Integer, ByRef toto6 As Boolean)
    MsgBox ASub
    ASub = "fffff"
    toto5 = True
    toto.y1 = 888
End Sub

Public Function Anotherfunctions3() As String
    Dim RetSec As String
    RetSec = Space(1284)
    Anotherfunctions3 = Mid(RetSec, 1, Len(RetSec))
End Function