modlogui.bas

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

    MyOpenFName.nMaxFile = 255
    For i = 1 To lstrlen(OFilters) Step 1
        If lstrcmp(Mid(OFilters, i, 1), "|") = 0 Then Mid(OFilters, i, 1) = Chr(2)
    Next
    LocFilters = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, Len(OFilters) + 2)
    CopyMemory ByVal LocFilters, ByVal OFilters, Len(OFilters)
    ' Nasty but it works
    For i = 1 To Len(OFilters) Step 1
        If lstrcmp(Mid(OFilters, i, 1), Chr(2)) = 0 Then ZeroMemory ByVal LocFilters + i - 1, 1
    Next
    MyOpenFName.lpstrFilter = LocFilters
    MyOpenFName.nFilterIndex = 1
    If MultiSelect = True Then
        MyOpenFName.lpstrTitle = "Select file(s) to open"
    Else
        MyOpenFName.lpstrTitle = "Select a file to open"
    End If
    MyOpenFName.hInstance = App.hInstance
    ChooseOpenFile = ""
    If GetOpenFileName(MyOpenFName) <> 0 Then TmpOp = Trim(MyOpenFName.lpstrFile)
    If lstrlen(TmpOp) <> 0 Then
        If MultiSelect = False Then
            TmpOp = left(TmpOp, lstrlen(TmpOp))
            TmpOp = Trim(TmpOp)
        Else
            ' The results will be separated with 0s
            ' Replace them with char 2
            For i = 1 To MyOpenFName.nMaxFile Step 1
                If Asc(Mid(TmpOp, i, 1)) = 0 Then TmpOp = left(TmpOp, i - 1) & Chr(2) & Mid(TmpOp, i + 1, MyOpenFName.nMaxFile - i)
            Next
            Do While Right(TmpOp, 1) = Chr(2)
                TmpOp = left(TmpOp, lstrlen(TmpOp) - 1)
            Loop
        End If
    End If
    GlobalFree LocFilters
    ChooseOpenFile = TmpOp
End Function

' --- Create a button control --- '
Public Function CreateButton(BLeft As Long, BTop As Long, BWidth As Long, BHeight As Long, hParent As Long, BText As String, CtrlID As Long, ExtraStyle As Long) As Long
    Dim ReturnValue As Long
    ControlBound hParent, BLeft, BTop, BWidth, BHeight
    ReturnValue = CreateWindowEx(WS_EX_NOPARENTNOTIFY Or WS_EX_STATICEDGE, "BUTTON", BText, WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_CENTER Or BS_VCENTER Or BS_PUSHBUTTON Or BS_MULTILINE Or ExtraStyle, BLeft, BTop, BWidth, BHeight, hParent, CtrlID, App.hInstance, ByVal 0)
    If ReturnValue = 0 Then Exit Function
    ControlSetFont ReturnValue, SerifFont
    CreateButton = ReturnValue
End Function

' --- Display a browse dialog --- '
Public Function BrowseDir(hwnd As Long, Title As String) As String
    Dim MyBrowse As BROWSEINFO
    Dim TempPath As String
    Dim SelPath As String
    Dim PtrItemLst As Long
    Dim MyPointer As Long
    TempPath = Space(MAX_PATH)
    BrowseDir = ""
    MyBrowse.hwndOwner = hwnd
    MyBrowse.pidlRoot = 0
    MyBrowse.lpszTitle = Title
    MyBrowse.pszDisplayName = TempPath
    MyBrowse.lParam = 0
    MyBrowse.ulFlags = BIF_RETURNONLYFSDIRS
    PtrItemLst = SHBrowseForFolder(MyBrowse)
    If PtrItemLst <> 0 Then
        SelPath = Space(MAX_PATH)
        SHGetPathFromIDList ByVal PtrItemLst, ByVal SelPath
        BrowseDir = ""
        If lstrlen(SelPath) <> 0 Then
            SelPath = left(SelPath, lstrlen(SelPath))
            BrowseDir = SelPath
        End If
    End If
End Function

' --- Create a listview control --- '
Public Function CreateListView(ByVal LVLeft As Long, ByVal LVTop As Long, ByVal LVWidth As Long, ByVal LVHeight As Long, ByVal hParent As Long, ByVal CtrlID As Long, ByVal ExtraStyle As Long, ByVal WStyle As Long) As Long
    Dim ReturnValue As Long
    ControlBound hParent, LVLeft, LVTop, LVWidth, LVHeight
    ReturnValue = CreateWindowEx(WS_EX_NOPARENTNOTIFY Or WS_EX_STATICEDGE, "SysListView32", "", WS_HSCROLL Or WS_VSCROLL Or WS_VISIBLE Or WS_CHILD Or LVS_REPORT Or LVS_SHOWSELALWAYS Or LVS_SHAREIMAGELISTS Or WStyle, LVLeft, LVTop, LVWidth, LVHeight, hParent, CtrlID, App.hInstance, ByVal 0)
    If ReturnValue = 0 Then Exit Function
    ControlSetFont ReturnValue, SerifFont
    If ExtraStyle <> 0 Then SendMessage ReturnValue, LVM_SETEXTENDEDLISTVIEWSTYLE, ExtraStyle, ByVal ExtraStyle
    CreateListView = ReturnValue
End Function

' --- Add a column to a listview control --- '
Public Function ListViewAddCol(ByVal hListview As Long, ByVal LVColText As String, ByVal LVWidth As Long, ByVal ColPosition As Long) As Long
    Dim CRect As RECT
    Dim ListViewColumn As LV_COLUMN
    GetClientRect hListview, CRect
    If LVWidth < 0 Then LVWidth = CRect.Right / -LVWidth
    ListViewColumn.imask = LVCF_FMT Or LVCF_TEXT Or LVCF_WIDTH Or LVCF_SUBITEM
    ListViewColumn.fmt = LVCFMT_LEFT
    ListViewColumn.lx = LVWidth
    ListViewColumn.pszText = LVColText
    ListViewColumn.cchTextMax = lstrlen(LVColText)
    ListViewColumn.iSubItem = ColPosition
    ListViewAddCol = SendMessage(hListview, LVM_INSERTCOLUMN, 0, ListViewColumn)
End Function

' --- Add an item to a listview control --- '
Public Function ListViewAddItem(ByVal hListview As Long, ByVal LVItemText As String, ByVal LVItemPos As Long, ByVal LVImage As Long) As Long
    Dim ListViewItem As LV_ITEM
    ListViewItem.imask = LVIF_TEXT Or LVIF_STATE Or LVIF_PARAM Or LVIF_IMAGE
    ListViewItem.iItem = LVItemPos
    ListViewItem.iSubItem = 0
    ListViewItem.pszText = LVItemText
    ListViewItem.state = 0
    ListViewItem.stateMask = 0
    ListViewItem.iImage = LVImage
    ListViewItem.cchTextMax = lstrlen(LVItemText)
    ' Stored here for sorting purpose
    ListViewItem.lParam = LVItemPos
    ListViewAddItem = SendMessage(hListview, LVM_INSERTITEM, 0, ListViewItem)
End Function

' --- Retrieve the checkbox state of an item in a listview control --- '
Public Function ListViewGetItemCheckbox(ByVal hListview As Long, ByVal LVItemIndex As Long) As Long
    Dim ReturnValue As Long
    Select Case SendMessage(hListview, LVM_GETITEMSTATE, LVItemIndex, ByVal LVIS_STATEIMAGEMASK)
        Case &H1000&
            ReturnValue = 0
        Case &H2000&
            ReturnValue = 1
    End Select
    ListViewGetItemCheckbox = ReturnValue
End Function

' --- Check if the notification message is a checkbox changes --- '
Public Function ListViewIsCheckboxNotify(ByVal hListview As Long, ByVal LVItemIndex As Long) As Boolean
    Dim ReturnValue As Boolean
    Select Case SendMessage(hListview, LVM_GETITEMSTATE, LVItemIndex, ByVal LVIS_STATEIMAGEMASK)
        Case &H1000&
            ReturnValue = True
        Case &H2000&
            ReturnValue = True
        Case Else
            ReturnValue = False
    End Select
    ListViewIsCheckboxNotify = ReturnValue
End Function

' --- Set the checkbox state of an item in a listview control --- '
Public Function ListViewSetItemCheckbox(ByVal hListview As Long, ByVal LVItemIndex As Long, ByVal LVCheckState As Long) As Long
    Dim GetListViewItem As LV_ITEM
    GetListViewItem.imask = LVIF_STATE
    Select Case LVCheckState
        Case 0
            GetListViewItem.state = &H1000&
        Case Else
            GetListViewItem.state = &H2000&
    End Select
    GetListViewItem.stateMask = LVIS_STATEIMAGEMASK
    GetListViewItem.iItem = LVItemIndex
    GetListViewItem.iSubItem = 0
    GetListViewItem.pszText = 0
    GetListViewItem.cchTextMax = 0
    ListViewSetItemCheckbox = SendMessage(hListview, LVM_SETITEMSTATE, LVItemIndex, GetListViewItem)
End Function

' --- Retrieve selection state of a listview item --- '
Public Function ListViewCheckBoxItemDoubleClick(ByVal hListview As Long) As Long
    Dim CurrentLvItem As Long
    CurrentLvItem = ListViewGetItemUnderCursor(hListview)
    If CurrentLvItem <> -1 Then
        ListViewSetItemSel hListview, CurrentLvItem
        Select Case ListViewGetItemCheckbox(hListview, CurrentLvItem)
            Case 0
                ListViewSetItemCheckbox hListview, CurrentLvItem, 1
            Case 1
                ListViewSetItemCheckbox hListview, CurrentLvItem, 0
        End Select
    End If
    ListViewCheckBoxItemDoubleClick = CurrentLvItem
End Function

' --- Retrieve the item number currently under the cursor --- '
Public Function ListViewGetItemUnderCursor(ByVal hListview As Long) As Long
    Dim MyTest As LV_HITTESTINFO
    GetCursorPos MyTest.pt
    MyTest.pt.X = MyTest.pt.X - ControlLeft(hListview)
    MyTest.pt.Y = MyTest.pt.Y - ControlTop(hListview)
    SendMessage hListview, LVM_HITTEST, 0, MyTest
    ListViewGetItemUnderCursor = MyTest.iItem
End Function

' --- Set the selection state of a listview item --- '
Public Function ListViewSetItemSel(ByVal hListview As Long, ByVal LVItemIndex As Long) As Long
    Dim GetListViewItem As LV_ITEM
    GetListViewItem.imask = LVIF_STATE
    GetListViewItem.state = LVIS_SELECTED Or LVIS_FOCUSED
    GetListViewItem.stateMask = LVIS_SELECTED Or LVIS_FOCUSED
    GetListViewItem.iItem = LVItemIndex
    GetListViewItem.iSubItem = 0
    GetListViewItem.pszText = 0
    GetListViewItem.cchTextMax = 0
    ListViewSetItemSel = SendMessage(hListview, LVM_SETITEMSTATE, LVItemIndex, GetListViewItem)
End Function

' --- Set a column width of a listview control --- '
Public Function ListViewSetColWidth(ByVal hListview As Long, ByVal LVColNumber As Long, ByVal LVWidth As Long) As Long
    ListViewSetColWidth = SendMessage(hListview, LVM_SETCOLUMNWIDTH, LVColNumber, ByVal LVWidth)
End Function

' --- Retrieve the number of items of a listview control --- '
Public Function ListViewItemCount(ByVal hListview As Long) As Long
    ListViewItemCount = SendMessage(hListview, LVM_GETITEMCOUNT, 0, ByVal 0)
End Function

' --- Create a frame control --- '
Public Function CreateFrame(FLeft As Long, FTop As Long, FWidth As Long, FHeight As Long, hParent As Long, BText As String, CtrlID As Long, ExtraStyle As Long, WinProc As Long) As Long
    Dim ReturnValue As Long
    ControlBound hParent, FLeft, FTop, FWidth, FHeight
    ReturnValue = CreateWindowEx(WS_EX_CONTROLPARENT Or WS_EX_NOPARENTNOTIFY, "BUTTON", BText, WS_VISIBLE Or WS_CHILD Or BS_GROUPBOX Or ExtraStyle, FLeft, FTop, FWidth, FHeight, hParent, CtrlID, App.hInstance, ByVal 0)
    If ReturnValue = 0 Then Exit Function
    If WinProc <> 0 Then SetWindowLong ReturnValue, GWL_USERDATA, SetWindowLong(ReturnValue, GWL_WNDPROC, WinProc)
    ControlSetFont ReturnValue, SerifFont
    CreateFrame = ReturnValue
End Function

' --- Create a combobox control  --- '
Public Function CreateComboBox(CBLeft As Long, CBTop As Long, CBWidth As Long, CBHeight As Long, hParent As Long, CBText As String, CtrlID As Long, ExtraStyle As Long) As Long
    Dim ReturnValue As Long
    ControlBound hParent, CBLeft, CBTop, CBWidth, CBHeight
    ReturnValue = CreateWindowEx(0, "COMBOBOX", CBText, WS_TABSTOP Or WS_VSCROLL Or WS_VISIBLE Or WS_CHILD Or CBS_NOINTEGRALHEIGHT Or CBS_AUTOHSCROLL Or ExtraStyle, CBLeft, CBTop, CBWidth, CBHeight, hParent, CtrlID, App.hInstance, ByVal 0)
    If ReturnValue = 0 Then Exit Function
    ControlSetFont ReturnValue, SerifFont
    CreateComboBox = ReturnValue
End Function

' --- Add an item into a combobox control --- '
Public Function ComboBoxAddItem(hCB As Long, CBItemText As String, CBItemIndex As Long) As Long
    ComboBoxAddItem = SendMessage(hCB, CB_INSERTSTRING, CBItemIndex, ByVal CBItemText)
End Function

' --- Set the current selected index of a combobox control --- '
Public Sub ComboBoxSetIndex(hCB As Long, CBIndex As Long)
    SendMessage hCB, CB_SETCURSEL, CBIndex, ByVal 0
End Sub

' --- Retrieve the current selected index of a combobox control --- '
Public Function ComboBoxGetIndex(hCB As Long) As Long
    ComboBoxGetIndex = SendMessage(hCB, CB_GETCURSEL, 0, ByVal 0)
End Function

' --- Retrieve state of a checkbox --- '
Public Function CheckBoxGetState(hCB As Long) As Long
    CheckBoxGetState = SendMessage(hCB, BM_GETCHECK, 0, ByVal 0)
End Function

' --- Set state of a checkbox --- '
Public Sub CheckBoxSetState(hCB As Long, CheckedState As Long)
    SendMessage hCB, BM_SETCHECK, CheckedState, ByVal 0
End Sub

' --- Display hourglass cursor --- '
Public Function CursorSetWait() As Long
    CursorSetWait = SetCursor(LoadCursor(0, IDC_WAIT))
End Function

' --- Display normal arrow cursor --- '
Public Function CursorSetNormal() As Long