modhigui.bas

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

            Exit Function
        Case WM_NOTIFY
            Select Case ControlGetNotifiedMsg(lParam)
                Case TCN_SELCHANGE
                    Select Case SysTabGetCurrentItem(hWndPrefsSysTab)
                        Case 0
                            ControlVisible hWndFrameVisuals, False
                            ControlVisible hWndFrameOptions, True
                        Case 1
                            ControlVisible hWndFrameVisuals, True
                            ControlVisible hWndFrameOptions, False
                    End Select
                    PreferencesProc = 0
                    Exit Function
            End Select
        Case WM_COMMAND
            Select Case lParam
                Case hWndPrefsOk
                    ' Save prefs
                    VCLibDir = TextBoxGetText(hWndVCLib)
                    IniWriteKey "CONFIG", "DoubleSymbols", CStr(CheckBoxGetState(hWndOptDouble)), PrefsIniFile
                    IniWriteKey "CONFIG", "DisplayWarnings", CStr(CheckBoxGetState(hWndOptDispWarns)), PrefsIniFile
                    IniWriteKey "CONFIG", "DefaultFncReturns", CStr(ComboBoxGetIndex(hWndOptDefault)), PrefsIniFile
                    IniWriteKey "CONFIG", "StopAtError", CStr(CheckBoxGetState(hWndOptStopAtError)), PrefsIniFile
                    IniWriteKey "CONFIG", "OutputVBLines", CStr(CheckBoxGetState(hWndOptOutputVBLines)), PrefsIniFile
                    IniWriteKey "CONFIG", "VCLibDir", VCLibDir, PrefsIniFile
                    IniWriteKey "CONFIG", "BackGroundColor", CStr(ColorBoxGetColor(hWndColorBackGround)), PrefsIniFile
                    IniWriteKey "CONFIG", "ForeGroundColor", CStr(ColorBoxGetColor(hWndColorForeGround)), PrefsIniFile
                    ' Save global variables
                    Select Case CheckBoxGetState(hWndOptDouble)
                        Case 0
                            LookForDoubleSmb = False
                        Case 1
                            LookForDoubleSmb = True
                    End Select
                    Select Case CheckBoxGetState(hWndOptDispWarns)
                        Case 0
                            DisplayWarns = False
                        Case 1
                            DisplayWarns = True
                    End Select
                    Select Case CheckBoxGetState(hWndOptStopAtError)
                        Case 0
                            StopAtError = False
                        Case 1
                            StopAtError = True
                    End Select
                    Select Case CheckBoxGetState(hWndOptOutputVBLines)
                        Case 0
                            OutputVBLines = False
                        Case 1
                            OutputVBLines = True
                    End Select
                    DefReturnType = ComboBoxGetIndex(hWndOptDefault)
                    DumpBackColor = ColorBoxGetColor(hWndColorBackGround)
                    DumpForeColor = ColorBoxGetColor(hWndColorForeGround)
                    InvalidateRect hWndMain, 0, 0
                    UnLoadForm hwndDlg
                    PreferencesProc = 0
                    Exit Function
                Case hWndPrefsCancel
                    UnLoadForm hwndDlg
                    PreferencesProc = 0
                    Exit Function
            End Select
        Case WM_CLOSE
            EndDialog hwndDlg, 0
            PreferencesProc = 0
            Exit Function
    End Select
    PreferencesProc = 0
End Function

' --- Modules selection proc --- '
Public Function SelectModsProc(ByVal hwndDlg As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim i As Long
    Dim MaxModNameLen As Long
    Dim ModuleNameSize As Size
    Dim OldFontObj As Long
    Dim hDC As Long
    Select Case uMsg
        Case WM_INITDIALOG
            ModulesChoice = MODULES_CANCEL
            ControlSetText hwndDlg, "Select modules to convert"
            hModulesCmdConvert = CreateButton(324, 1, 77, 23, hwndDlg, "Convert", 1, BS_DEFPUSHBUTTON Or WS_TABSTOP Or WS_GROUP)
            hModulesCmdCancel = CreateButton(324, 25, 77, 23, hwndDlg, "Cancel", 2, WS_TABSTOP)
            hModulesCmdSelAll = CreateButton(324, 51, 77, 23, hwndDlg, "Select all", 4, WS_TABSTOP)
            hModulesCmdUnSelAll = CreateButton(324, 75, 77, 23, hwndDlg, "Unselect all", 5, WS_TABSTOP)
            hModulesListview = CreateListView(2, 2, 319, 240, hwndDlg, 6, LVS_EX_FULLROWSELECT Or LVS_EX_CHECKBOXES Or LVS_EX_LABELTIP, LVS_SINGLESEL Or LVS_NOCOLUMNHEADER Or WS_TABSTOP)
            ListViewAddCol hModulesListview, "", 320, 0
            MaxModNameLen = 0
            hDC = GetDC(hwndDlg)
            For i = 0 To UBound(ModulesArrayConversion()) - 1 Step 1
                ListViewAddItem hModulesListview, ModulesArray(i), i, -1
                ListViewSetItemCheckbox hModulesListview, i, 1
                ' Get filename len to adapt listview control
                OldFontObj = SelectObject(hDC, SerifFont)
                GetTextExtentPoint32 hDC, ModulesArray(i), lstrlen(ModulesArray(i)), ModuleNameSize
                SelectObject hDC, OldFontObj
                If MaxModNameLen < (ModuleNameSize.cx + 30) Then MaxModNameLen = (ModuleNameSize.cx + 30)
                ModulesArrayConversion(i) = True
            Next
            If MaxModNameLen < 314 Then MaxModNameLen = 314
            ListViewSetColWidth hModulesListview, 0, MaxModNameLen
            ReleaseDC hwndDlg, hDC
            SetFocus hModulesListview
            SelectModsProc = 0
            Exit Function
        Case WM_NOTIFY
            If ControlGetNotifiedhWnd(lParam) = hModulesListview Then
                Select Case ControlGetNotifiedMsg(lParam)
                    Case NM_DBLCLK
                        ListViewCheckBoxItemDoubleClick hModulesListview
                        SelectModsProc = 0
                        Exit Function
                End Select
            End If
        Case WM_COMMAND
            Select Case lParam
                Case hModulesCmdSelAll
                    For i = 0 To ListViewItemCount(hModulesListview) - 1 Step 1
                        ListViewSetItemCheckbox hModulesListview, i, 1
                    Next
                    SelectModsProc = 0
                    Exit Function
                Case hModulesCmdUnSelAll
                    For i = 0 To ListViewItemCount(hModulesListview) - 1 Step 1
                        ListViewSetItemCheckbox hModulesListview, i, 0
                    Next
                    SelectModsProc = 0
                    Exit Function
                Case hModulesCmdConvert
                    ModulesChoice = MODULES_CONVERT
                    For i = 0 To UBound(ModulesArrayConversion()) Step 1
                        If ListViewGetItemCheckbox(hModulesListview, i) = 0 Then ModulesArrayConversion(i) = False
                    Next
                    UnLoadForm hwndDlg
                    SelectModsProc = 0
                    Exit Function
                Case hModulesCmdCancel
                    UnLoadForm hwndDlg
                    SelectModsProc = 0
                    Exit Function
            End Select
        Case WM_CLOSE
            EndDialog hwndDlg, 0
            SelectModsProc = 0
            Exit Function
    End Select
    SelectModsProc = 0
End Function

' --- Main textbox hook -- '
Private Sub DisplayPage(AddText As Boolean)
    Dim EraseRECT As RECT
    Dim i As Long
    Dim PlainLines As Long
    Dim ModLines As Long
    Dim LocBrush As Long
    If ControlIsVisible(hWndDumpBox) = 0 Then Exit Sub
    SetVertScrollBar
    PlainLines = DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
    ModLines = PlainLines
    GetClientRect hWndDumpBox, EraseRECT
    LocBrush = GDICreateColorBrush(DumpBackColor)
    FillRect BackGroundDC, EraseRECT, LocBrush
    DeleteObject LocBrush
    For i = 0 To PlainLines Step 1
        If i > UBound(TextLines()) Then Exit For
        If (i + CurrentLineY) > UBound(TextLines()) Then Exit For
        If TextLines(i + CurrentLineY) <> "" Then WriteLineToWindow BackGroundDC, TextLines(i + CurrentLineY), i
    Next
    GDIBlitBackDC EraseRECT, MainBackDC
    SetHorzScrollBar
End Sub

' --- Clear a line of text --- '
Public Sub ClearTextLine(LineNumber As Long)
    Dim EraseRECT As RECT
    Dim LocBrush As Long
    GetClientRect hWndDumpBox, EraseRECT
    EraseRECT.top = (LineNumber * CharHeight)
    EraseRECT.bottom = EraseRECT.top + CharHeight
    LocBrush = GDICreateColorBrush(DumpBackColor)
    FillRect BackGroundDC, EraseRECT, LocBrush
    DeleteObject LocBrush
End Sub

' --- Display a line of text --- '
Public Sub BlitTextLine(LineNumber As Long)
    Dim EraseRECT As RECT
    GetClientRect hWndDumpBox, EraseRECT
    EraseRECT.top = (LineNumber * CharHeight)
    EraseRECT.bottom = CharHeight
    GDIBlitBackDC EraseRECT, MainBackDC
End Sub

' --- Show/hide vertical scrollbar --- '
Public Sub SetVertScrollBar()
    Dim CurVisLines As Long
    If ControlIsVisible(hWndDumpBox) = 0 Then Exit Sub
    CurVisLines = DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
    If UBound(TextLines()) > CurVisLines Then
        ScrollBarSetMinMaxRange hWndDumpBox, SB_VERT, 0, UBound(TextLines()) - CurVisLines
        ShowScrollBar hWndDumpBox, SB_VERT, 1
        VertSBOn = True
    Else
        ShowScrollBar hWndDumpBox, SB_VERT, 0
        If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_TOP, ByVal 0
        VertSBOn = False
    End If
End Sub

' --- Show/hide horizontal scrollbar --- '
Public Sub SetHorzScrollBar()
    Dim CurVisLines As Long
    Dim TextWidth As Long
    If ControlIsVisible(hWndDumpBox) = 0 Then Exit Sub
    TextWidth = MaxTextWidth \ CharWidth
    CurVisLines = DumpBoxGetVisibleColumns(hWndDumpBox, CharWidth, 1)
    If TextWidth > CurVisLines Then
        ScrollBarSetMinMaxRange hWndDumpBox, SB_HORZ, 0, TextWidth - CurVisLines
        ShowScrollBar hWndDumpBox, SB_HORZ, 1
        HorzSBOn = True
    Else
        ShowScrollBar hWndDumpBox, SB_HORZ, 0
        If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_TOP, ByVal 0
        HorzSBOn = False
    End If
End Sub

' --- Create a new dump box context --- '
Public Sub CreateDump()
    If BackGroundDC = 0 Then
        MainBackDC.Color = DumpBackColor
        MainBackDC.hwnd = hWndDumpBox
        BackGroundDC = GDICreateBackDC(MainBackDC)
    End If
End Sub

' --- Remove current dump box context --- '
Public Sub RemoveDump()
    If BackGroundDC <> 0 Then GDIDestroyBackDC MainBackDC
    BackGroundDC = 0
End Sub

' --- Write a line in the dumpbox --- '
Public Sub WriteLineToWindow(hDC As Long, TextLine As String, LineNumber As Long)
    GDIWriteText hDC, 1, LineNumber * CharHeight, TextLine, DumpForeColor, CourierFont, 1, DumpBackColor
End Sub

' --- Write a string in textbox --- '
Public Sub WriteText(WTxt As String)
    WTxt = Replace(WTxt, "\n", Chr(10))
    ' Expand tabs
    WTxt = Replace(WTxt, Chr(9), "    ")
    DumpBoxAddText WTxt
    DisplayPage True
    DoEvents
End Sub

' --- Add a text --- '
Public Sub DumpBoxAddText(TbText As String)
    Dim TextWidth As Long
    Dim i As Long
    TbTextArray() = Split(TbText, Chr(10))
    If UBound(TbTextArray()) <= 0 Then
        TextLines(UBound(TextLines())) = TextLines(UBound(TextLines())) & TbText
        Exit Sub
    End If
    For i = 0 To UBound(TbTextArray()) - 1 Step 1
        TextLines(UBound(TextLines())) = TextLines(UBound(TextLines())) & TbTextArray(i)
        TextWidth = GDIGetTextWidth(hWndDumpBox, CourierFont, TextLines(UBound(TextLines())))
        If TextWidth > MaxTextWidth Then MaxTextWidth = TextWidth
        ReDim Preserve TextLines(UBound(TextLines()) + 1)
    Next
End Sub

' --- Frame (converter) proc --- '
Public Function FrameConverterProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim TempVBDir As String
    Select Case uMsg
        Case WM_COMMAND
            Select Case lParam
                Case hWndPrefsSelDir
                    TempVBDir = BrowseDir(GetParent(hwnd), "Select Visual C++ libraries directory")
                    If TempVBDir <> "" Then
                        VCLibDir = TempVBDir
                        ControlSetText hWndVCLib, VCLibDir
                    End If
                    FrameConverterProc = 0
                    Exit Function
            End Select
    End Select
    FrameConverterProc = CallWindowProc(GetWindowLong(hwnd, GWL_USERDATA), hwnd, uMsg, wParam, lParam)
End Function

' --- Frame (visual) proc --- '
Public Function FrameVisualsProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim TempVBDir As String
    Select Case uMsg
        Case MSG_COLORBOX_CLICKED
            Select Case wParam
                Case hWndColorBackGround
                    If MiscChooseCol(GetParent(hwnd), ColorBoxGetColor(hWndColorBackGround)) <> 0 Then
                        ColorBoxSetColor hWndColorBackGround, MyColor.rgbResult
                    End If
                    FrameVisualsProc = 0
                    Exit Function
                Case hWndColorForeGround
                    If MiscChooseCol(GetParent(hwnd), ColorBoxGetColor(hWndColorForeGround)) <> 0 Then
                        ColorBoxSetColor hWndColorForeGround, MyColor.rgbResult
                    End If
                    FrameVisualsProc = 0
                    Exit Function
            End Select
    End Select
    FrameVisualsProc = CallWindowProc(GetWindowLong(hwnd, GWL_USERDATA), hwnd, uMsg, wParam, lParam)
End Function