modhigui.bas

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

Attribute VB_Name = "ModHiGUI"
' -------------------------------------
' 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.
' -------------------------------------
' Graphical User Interface
' -------------------------------------

Option Explicit

' --- Constants --- '
Global Const MENU_OPENVB = 1000
Global Const MENU_PREFS = 1001
Global Const MENU_ABOUT = 1002
Global Const MENU_EXIT = 1003

Global Const MODULES_CONVERT = 1
Global Const MODULES_CANCEL = 2

' --- Create main dialog --- '
Public Sub InitGUI()
    VertSBOn = False
    HorzSBOn = False
    MaxTextWidth = 0
    CurrentColX = 0
    CurrentLineY = 0
    ReDim TextLines(0)
    InitGUIContext AddressOf WindowProc
    hWndDialog = CreateDialog(-1, -1, 500, 400, 0, 0, 0, "VB2Cpp v" & APPVersion, 0, WS_SYSMENU Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SIZEBOX, SW_SHOWMAXIMIZED)
    WaitEvents 0, hWndDialog
    ReleaseGUIContext
End Sub

' --- Main Window proc --- '
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim TempProjectName As String
    Dim wParam_MenuSelect As Long
    Dim PaintS As PAINTSTRUCT
    Dim MaxCurrentLine As Long
    Select Case uMsg
        Case WM_CREATE
            hWndMain = hwnd
            CreateMenuBar hwnd
            hStatusBar = CreateStatusBar(hwnd, 0)
            CharHeight = GDIGetFontHeight(hwnd, CourierFont)
            CharWidth = GDIGetFontWidth(hwnd, CourierFont)
            hWndDumpBox = CreateDumpBox(-1, -1, -1, -1, hwnd, 0, CourierFont, 0, 0, 10, 10, 0, WS_VSCROLL, WS_EX_STATICEDGE)
            WriteText "VB2Cpp v" & APPVersion & " - Visual Basic to Visual C++ 6 converter.\n" & _
                      "Copyright (C) 2002-2003 Franck Charlet.\n\n" & _
                      "VB2Cpp is free software; you can redistribute it and/or modify\n" & _
                      "it under the terms of the GNU General Public License as published by\n" & _
                      "the Free Software Foundation; either version 2, or (at your option)\nany later version.\n\n" & _
                      "Read VB2Cpp.txt before crying.\n\n"
            WindowProc = 0
            CreateDump
            Exit Function
        Case WM_SIZE
            If wParam <> SIZE_MINIMIZED Then
                SendMessage hStatusBar, uMsg, wParam, ByVal lParam
                If ControlIsVisible(hWndDumpBox) <> 0 Then
                    DumpBoxResize hWndDumpBox, 0, 0, lParam And &HFFFF&, ((lParam And &HFFFF0000) \ &H10000) - GetControlHeight(hStatusBar)
                    SetVertScrollBar
                    SetHorzScrollBar
                    RemoveDump
                    CreateDump
                    If VertSBOn = True Then
                        If CharHeight <> 0 Then
                            If CurrentLineY > (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
                                If (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) > 0 Then
                                    CurrentLineY = (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1))
                                Else
                                    CurrentLineY = 0
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Case WM_CLOSE
            If VBMsgBox(hwnd, "Really want to quit ?", MB_YESNO Or MB_ICONQUESTION, "VB2Cpp") = IDYES Then
                RemoveDump
                DestroyWindow hwnd
                PostQuitMessage 0
            End If
            WindowProc = 0
            Exit Function
        Case WM_MENUSELECT
            wParam_MenuSelect = (wParam And &H7FFF&)
            If wParam_MenuSelect >= MENU_OPENVB And wParam_MenuSelect <= MENU_EXIT Then
                StatusBarSetText hStatusBar, MenuComments(wParam_MenuSelect - MENU_OPENVB)
            Else
                StatusBarSetText hStatusBar, ""
            End If
            WindowProc = 0
            Exit Function
        Case WM_EXITMENULOOP
            StatusBarSetText hStatusBar, ""
            WindowProc = 0
            Exit Function
        Case WM_ERASEBKGND
            WindowProc = 0
            Exit Function
        Case WM_PAINT
            BeginPaint hwnd, PaintS
            DisplayPage False
            EndPaint hwnd, PaintS
            WindowProc = 0
            Exit Function
        ' Handle text view in dumpbox
        Case WM_KEYDOWN
            Select Case wParam
                Case VK_UP
                    If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_LINEUP, ByVal 0
                Case VK_DOWN
                    If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_LINEDOWN, ByVal 0
                Case VK_LEFT
                    If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_LINELEFT, ByVal 0
                Case VK_RIGHT
                Case VK_END
                    If (GetKeyState(VK_CONTROL) And &H80&) Then
                        If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_BOTTOM, ByVal 0
                    End If
                    If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_BOTTOM, ByVal 0
                Case VK_HOME
                    If (GetKeyState(VK_CONTROL) And &H80&) Then
                        If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_TOP, ByVal 0
                    End If
                    If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_TOP, ByVal 0
                Case VK_PGUP
                    If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_PAGEUP, ByVal 0
                Case VK_PGDN
                    If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_PAGEDOWN, ByVal 0
            End Select
        Case DUMPBOX_LINELEFT
            If CurrentColX > 0 Then
                CurrentColX = CurrentColX - 1
                InvalidateRect hwnd, 0, 0
            End If
            WindowProc = CurrentColX
            Exit Function
        Case DUMPBOX_LINEUP
            If CurrentLineY > 0 Then
                CurrentLineY = CurrentLineY - 1
                DumpBoxScrollUp hWndDumpBox, 1, CharHeight, 1
                ClearTextLine 0
                WriteLineToWindow BackGroundDC, TextLines(CurrentLineY), 0
                BlitTextLine 0
            End If
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_LINEDOWN
            If CurrentLineY < (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
                CurrentLineY = CurrentLineY + 1
                DumpBoxScrollDown hWndDumpBox, 1, CharHeight, 1
                MaxCurrentLine = DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
                ClearTextLine 0
                WriteLineToWindow BackGroundDC, TextLines(CurrentLineY + MaxCurrentLine), 0
                BlitTextLine MaxCurrentLine
            End If
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_PAGEUP
            If CurrentLineY > (10 - 1) Then
                CurrentLineY = CurrentLineY - 10
                InvalidateRect hwnd, 0, 0
            Else
                CurrentLineY = 0
                InvalidateRect hwnd, 0, 0
            End If
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_PAGEDOWN
            If CurrentLineY < (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
                CurrentLineY = CurrentLineY + 10
                If CurrentLineY > (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
                    CurrentLineY = UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
                End If
                InvalidateRect hwnd, 0, 0
            Else
                CurrentLineY = UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
                InvalidateRect hwnd, 0, 0
            End If
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_TOP
            CurrentLineY = 0
            InvalidateRect hwnd, 0, 0
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_BOTTOM
            CurrentLineY = UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
            InvalidateRect hwnd, 0, 0
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_POSITIONUPDOWN
            CurrentLineY = lParam
            If OldLineY <> CurrentLineY Then
                OldLineY = CurrentLineY
                InvalidateRect hwnd, 0, 0
            End If
            WindowProc = CurrentLineY
            Exit Function
        Case DUMPBOX_TRACKUPDOWN
            CurrentLineY = lParam
            If OldLineY <> CurrentLineY Then
                OldLineY = CurrentLineY
                InvalidateRect hwnd, 0, 0
            End If
            WindowProc = CurrentLineY
            Exit Function
        Case WM_COMMAND
            Select Case (wParam And &H7FFF&)
                Case MENU_OPENVB
                    TempProjectName = ChooseOpenFile(hwnd, "Visual Basic project files (*.vbp)|*.vbp", "", False)
                    If TempProjectName <> "" Then
                        ProjectName = TempProjectName
                        CursorSetWait
                        DoEvents
                        DoConversion
                        DoEvents
                        CursorSetNormal
                        StatusBarSetText hStatusBar, ""
                    End If
                Case MENU_PREFS
                    CreateModalDialog 300, 216, hwnd, AddressOf PreferencesProc, WS_BORDER Or WS_CAPTION Or WS_SYSMENU
                Case MENU_ABOUT
                    CmdMenu_About
                Case MENU_EXIT
                    UnLoadForm hwnd
            End Select
            WindowProc = 0
            Exit Function
    End Select
    WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End Function

' --- Show about message --- '
Public Sub CmdMenu_About()
    ShellAbout hWndDialog, "VB2Cpp ", _
    "Version " & APPVersion & " (Built on " & Date & ")" & vbCr & "Copyright (C) 2002-2003 Franck Charlet.", 0
End Sub

' --- Create the menu bar --- '
Public Sub CreateMenuBar(hParent As Long)
    ReDim MenuComments(0 To 3)
    hMenuBar = CreateMenu
    SetMenu hParent, hMenuBar
    hMenu = CreatePopupMenu
    AppendMenu hMenu, MF_STRING, MENU_OPENVB, "Convert"
    MenuComments(0) = "Open and convert a Visual Basic project"
    AppendMenu hMenu, MF_SEPARATOR, 1, "-"
    AppendMenu hMenu, MF_STRING, MENU_PREFS, "Preferences"
    MenuComments(1) = "Modify converter parameters"
    AppendMenu hMenu, MF_SEPARATOR, 1, "-"
    AppendMenu hMenu, MF_STRING, MENU_ABOUT, "About"
    MenuComments(2) = "Show some essential informations"
    AppendMenu hMenu, MF_SEPARATOR, 1, "-"
    AppendMenu hMenu, MF_STRING, MENU_EXIT, "Exit" & vbTab & "Alt+F4"
    MenuComments(3) = "Quit VB2Cpp"
    AppendMenu hMenuBar, MF_POPUP, hMenu, "File"
    DrawMenuBar hParent
End Sub

' --- Preferences proc --- '
Public Function PreferencesProc(ByVal hwndDlg As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_INITDIALOG
            ControlSetText hwndDlg, "Preferences"
            hWndPrefsOk = CreateButton(142, 191, 77, 23, hwndDlg, "Ok", 1, WS_TABSTOP Or WS_GROUP Or BS_DEFPUSHBUTTON)
            hWndPrefsCancel = CreateButton(221, 191, 77, 23, hwndDlg, "Cancel", 2, WS_TABSTOP)
            hWndPrefsSysTab = CreateSysTab(2, 1, 293, 158, hwndDlg, 0, 0, 0, WS_TABSTOP Or TCS_BUTTONS Or TCS_FLATBUTTONS Or TCS_HOTTRACK)
            SysTabAddItem hWndPrefsSysTab, "Converter", 0, 0
            SysTabAddItem hWndPrefsSysTab, "Visuals", 1, 0
            hWndFrameOptions = CreateFrame(3, 25, 295, 162, hwndDlg, "Options", 0, 0, AddressOf FrameConverterProc)
            hWndFrameVisuals = CreateFrame(3, 25, 295, 162, hwndDlg, "Options", 0, 0, AddressOf FrameVisualsProc)
            hWndOptDouble = CreateCheckBox(10, 17, 280, 15, hWndFrameOptions, "Performs multiple symbols checking", 6, WS_TABSTOP)
            hWndOptDispWarns = CreateCheckBox(10, 17 + 16, 280, 15, hWndFrameOptions, "Report conversion warnings", 8, WS_TABSTOP)
            hWndOptStopAtError = CreateCheckBox(10, 17 + (16 * 2), 280, 15, hWndFrameOptions, "Stop process at first error", 10, WS_TABSTOP)
            hWndOptOutputVBLines = CreateCheckBox(10, 17 + (16 * 3), 280, 15, hWndFrameOptions, "Write VB code lines in output", 11, WS_TABSTOP)
            CreateLabel 10, 18 + (16 * 4), 200, 17, hWndFrameOptions, "Assume default type:", 0, 0
            hWndOptDefault = CreateComboBox(10, 18 + (16 * 4) + 15, 180, 150, hWndFrameOptions, "", 12, WS_TABSTOP Or CBS_DROPDOWNLIST)
            CreateLabel 10, 18 + (16 * 6) + 8, 200, 17, hWndFrameOptions, "Visual C++ libraries directory:", 0, 0
            hWndVCLib = CreateTextBox(10, 18 + (16 * 7) + 8, 254, 15, hWndFrameOptions, VCLibDir, 13, ES_READONLY, 0, 0)
            hWndPrefsSelDir = CreateButton(266, 18 + (16 * 7) + 6, 21, 19, hWndFrameOptions, "...", 14, WS_TABSTOP)
            CreateLabel 10, 16 + 6, 100, 17, hWndFrameVisuals, "Background color:", 0, 0
            CreateLabel 10, 45 + 6, 100, 17, hWndFrameVisuals, "Foreground color:", 0, 0
            hWndColorBackGround = CreateColorBox(110, 16, 26, 26, hWndFrameVisuals, 15, DumpBackColor, 0)
            hWndColorForeGround = CreateColorBox(110, 45, 26, 26, hWndFrameVisuals, 16, DumpForeColor, 0)
            ComboBoxAddItem hWndOptDefault, "(Report Error)", -1
            ComboBoxAddItem hWndOptDefault, "Byte", -1
            ComboBoxAddItem hWndOptDefault, "Integer", -1
            ComboBoxAddItem hWndOptDefault, "Long", -1
            ComboBoxAddItem hWndOptDefault, "Double", -1
            ComboBoxAddItem hWndOptDefault, "Single", -1
            ComboBoxAddItem hWndOptDefault, "Boolean", -1
            ComboBoxAddItem hWndOptDefault, "String", -1
            CheckBoxSetState hWndOptDouble, CLng(LookForDoubleSmb)
            CheckBoxSetState hWndOptDispWarns, CLng(DisplayWarns)
            CheckBoxSetState hWndOptStopAtError, CLng(StopAtError)
            CheckBoxSetState hWndOptOutputVBLines, CLng(OutputVBLines)
            ComboBoxSetIndex hWndOptDefault, DefReturnType
            ControlVisible hWndFrameOptions, True
            ControlVisible hWndFrameVisuals, False
            SetFocus hWndPrefsSelDir
            PreferencesProc = 0