modbff.bas

一个比较简单美观的魔域登陆器源码

    End With
    IDList = SHBrowseForFolder(tBrowseInfo)
    If (IDList) Then
      mTemp = Space(MAX_PATH)
      SHGetPathFromIDList IDList, mTemp
      mTemp = Left(mTemp, InStr(mTemp, vbNullChar) - 1)
      BrowseFF = mTemp
        If Newboy = True Then GoTo startagain
        CleanUp
    Else
      BrowseFF = ""
        If Newboy = True Then GoTo startagain
        CleanUp
    End If

End Function
'Used to allow BrowseCallbackProc hook
Private Function GetAddressofFunction(Add As Long) As Long
  GetAddressofFunction = Add
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
'Messages to the Browse for Folder window are recieved here
Dim lpIDList As Long
Dim ret As Long, temp As String, TVr As RECT, CS As CREATESTRUCT
Dim sBuffer As String, hFont As Long
Dim hWnda As Long, ClWind As String * 14, ClCaption As String * 100
On Error Resume Next
DialogWindow = hwnd
If Len(BB.Titlebar) = 0 Then BB.Titlebar = "Browse for Folder"
SetWindowText DialogWindow, BB.Titlebar
If BB.AllowResize Then RoomForSizer = 50

Select Case uMsg
  Case BFFM_INITIALIZED 'Lets set things up the way we want
    If BB.InitDir = "" Then BB.InitDir = "c:\"
    Call SendMessage(hwnd, BFFM_SETSELECTION, 1, BB.InitDir) 'Start here please
    CurrentDir = BB.InitDir
    If Newboy = False Then 'If we are not just updating with a new folder
         'locate the window and then set its size
        Call GetWindowRect(DialogWindow, R)
        If BB.DoubleSizeDlg Then
            Call MoveWindow(DialogWindow, R.Left, R.Top, 480, 480, True)
        ElseIf BB.FSDlg Then
            Call MoveWindow(DialogWindow, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, True)
        Else
            Call MoveWindow(DialogWindow, R.Left, R.Top, 320, 320, True)
        End If
        Call GetWindowRect(DialogWindow, R)
        'Put the window where we want it
        If BB.CenterDlg Then
            Call MoveWindow(DialogWindow, (Screen.Width / Screen.TwipsPerPixelX) / 2 - (R.Right - R.Left) / 2, (Screen.Height / Screen.TwipsPerPixelY) / 2 - (R.Bottom - R.Top) / 2, R.Right - R.Left, R.Bottom - R.Top, True)
        End If
        Call GetWindowRect(DialogWindow, R) 'Remember the new position
    Else
        'If we are updating with a new folder use the old size and position
        Call MoveWindow(DialogWindow, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, True)
    End If
    Newboy = False 'reset this flag
    'Get a handle on the elements within the Browse for Folder window
    hWnda = GetWindow(hwnd, GW_CHILD) 'Get the child windows
        Do While hWnda <> 0 'Go through all the children and get its ClassName
            GetClassName hWnda, ClWind, 14
            If Left(ClWind, 6) = "Button" Then 'Found a button
                GetWindowText hWnda, ClCaption, 100
                If UCase(Left(ClCaption, 2)) = "OK" Then 'Its the OK button
                    OKbuttonWindow = hWnda 'Remember its handle
                    If Len(BB.OKCaption) = 0 Then BB.OKCaption = "OK" 'Default
                    SetWindowText OKbuttonWindow, BB.OKCaption 'Set its caption
                End If
                If UCase(Left(ClCaption, 6)) = "CANCEL" Then 'Its the Cancel button
                    CancelbuttonWindow = hWnda 'Remember its handle
                    If Len(BB.CancelCaption) = 0 Then BB.CancelCaption = "Cancel" 'Default
                    SetWindowText CancelbuttonWindow, BB.CancelCaption 'Set its caption
                End If
            End If
            If Left(ClWind, 13) = "SysTreeView32" Then 'Its the Treeview
                SysTreeWindow = hWnda 'Remember its handle
                Call GetWindowRect(SysTreeWindow, TVr)
                'Remember its Top position - used to locate other controls on the resize event
                TreeTop = TVr.Top - R.Top
            End If
            If BB.EditBoxOld Then
                If Left(ClWind, 4) = "Edit" Then 'Its the default Edit window because we haven't made one yet
                    EditWindowOld = hWnda 'Remember its handle
                    Call GetWindowRect(EditWindowOld, TVr)
                    'Remember its Top and height - used to locate other controls on the resize event
                    EditTop = TVr.Top - R.Top
                    EditHeight = TVr.Bottom - TVr.Top
                End If
            End If
            If Left(ClWind, 6) = "Static" Then 'label
                If UCase(Left(ClCaption, Len(BB.Prompt))) <> BB.Prompt Then
                    'If its not our descriptive text it must it must be the status text
                    StattxtWindow = hWnda 'Remember its handle
                    Call GetWindowRect(StattxtWindow, TVr)
                    'Remember its Top and height - used to locate other controls on the resize event
                    StattxtTop = TVr.Top - R.Top
                    StattxtHeight = TVr.Bottom - TVr.Top
                End If
            End If
            hWnda = GetWindow(hWnda, GW_NEXT)
        Loop
        If BB.RootDir <> 3 And BB.RootDir <> 4 And BB.RootDir <> 10 And BB.RootDir <> 18 And BB.RootDir <> 19 Then
        'if the RootDir is Control Panel,Printers,Recycle,Network or Nethood then no Buttons/Checkbox or Editbox
            If BB.EditBoxNew Then
                'Create a textbox and a label
                EditWindow = CreateWindowEx(WS_EX_CLIENTEDGE, "EDIT", "", WS_CHILD Or ES_MULTILINE Or ES_WANTRETURN Or ES_AUTOHSCROLL, 0, 0, 0, 23, DialogWindow, 0, App.hInstance, CS)
                LabelWindow = CreateWindowEx(0, "STATIC", "Folder :", WS_CHILD, 0, 0, 0, 23, DialogWindow, 0, App.hInstance, CS)
                'make the font the same as the OK button
                hFont = SendMessage(OKbuttonWindow, WM_GETFONT, 0&, ByVal 0&)
                SendMessage EditWindow, WM_SETFONT, hFont, ByVal 1&
                SendMessage LabelWindow, WM_SETFONT, hFont, ByVal 1&
                ShowWindow LabelWindow, 1
                ShowWindow EditWindow, 1
                'Place a window hook on the editbox so we can take action on any input
                glPrevWndProcEdit = fSubClassEdit()
            End If
            If BB.ShowButton Or BB.ShowCheck Then
                If BB.ShowButton Then
                    'make a standard button and set its caption
                    If Len(BB.NewFCaption) = 0 Then BB.NewFCaption = "New Folder" 'Default
                    ButtonWindow = CreateWindowEx(0, "BUTTON", BB.NewFCaption, WS_CHILD, 0, 0, 75, 23, DialogWindow, 0, App.hInstance, CS)
                Else
                    'make a standard checkbox
                    If Len(BB.CHCaption) = 0 Then BB.CHCaption = "Include subfolders" 'Default
                    ButtonWindow = CreateWindowEx(0, "BUTTON", BB.CHCaption, WS_CHILD Or BS_CHECKBOX, 20, 0, 110, 23, DialogWindow, 0, App.hInstance, CS)
                End If
                'Set its font to match the OK button
                hFont = SendMessage(OKbuttonWindow, WM_GETFONT, 0&, ByVal 0&)
                SendMessage ButtonWindow, WM_SETFONT, hFont, ByVal 1&
                ShowWindow ButtonWindow, 1
                'Place a window hook on the button or checkbox so we can take action on any input
                glPrevWndProc = fSubClass()
            End If
        Else
            'if the RootDir is Control Panel,Printers,Recycle,Network or Nethood then
            'make sure these are false or the resizing will go astray
            BB.ShowButton = False
            BB.ShowCheck = False
            BB.EditBoxNew = False
        End If
        If BB.AllowResize Then 'add some scrollbars with a size grip in the corner
            If Is2K Then
                ScrollWindow = CreateWindowEx(WS_EX_RIGHTSCROLLBAR, "SCROLLBAR", "", WS_CHILD Or SBS_SIZEGRIP Or SBS_SIZEBOX, R.Right - R.Left - 24, R.Bottom - R.Top - 44, 16, 16, DialogWindow, 0, App.hInstance, CS)
                ShowWindow ScrollWindow, 1 'show the scrollbox
                glPrevWndProcFS = fSubClassFS() 'we need to hook for Win2K- not sure why
            Else
                'I cant get the sizegrip to work under Win95/98
                'so I create a dummy scrollbar with a sizegrip
                'and disable it, setting it as the real scrollbars child
                ScrollWindow = CreateWindowEx(0, "SCROLLBAR", "", WS_CHILD Or SBS_SIZEBOX, R.Right - R.Left - 24, R.Bottom - R.Top - 44, 16, 16, DialogWindow, 0, App.hInstance, CS)
                dummyWindow = CreateWindowEx(0, "SCROLLBAR", "", WS_CHILD Or SBS_SIZEGRIP Or WS_DISABLED, -4, -4, 16, 16, ScrollWindow, 0, App.hInstance, CS)
                ShowWindow ScrollWindow, 1 'show the scrollbox
                ShowWindow dummyWindow, 1 'show the sizegrip
            End If
            'Place a window hook on the main window so when it resizes we can move all the controls appropriately
            glPrevWndProcDlg = fSubClassDlg()
        End If
        'Enter the start folder text in the edit box
        Call SendMessage(EditWindow, WM_SETTEXT, 0, FileOnly(CurrentDir))
        Call SendMessage(EditWindow, EM_SETSEL, Len(FileOnly(CurrentDir)), 0)
        'Done setting up, so call the resize event
        SizeAndPosition
  Case BFFM_SELCHANGED
        sBuffer = Space(MAX_PATH)
        ret = SHGetPathFromIDList(lp, sBuffer)
        'update the edit box and the status label with the new directory
        If ret = 1 Then
            Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, ByVal sBuffer)
            If Len(StripTerminator(sBuffer)) > 3 Then
                Call SendMessage(EditWindow, WM_SETTEXT, 0, FileOnly(sBuffer))
                Call SendMessage(EditWindow, EM_SETSEL, Len(FileOnly(sBuffer)), 0)
            Else
                Call SendMessage(EditWindow, WM_SETTEXT, 0, sBuffer)
                Call SendMessage(EditWindow, EM_SETSEL, Len(sBuffer), 0)
            End If
            CurrentDir = sBuffer
        End If
End Select
BrowseCallbackProc = 0
End Function
'****************Hook and Unhook our windows*****************************8
Private Function fSubClassDlg() As Long
fSubClassDlg = SetWindowLong(DialogWindow, GWL_WNDPROC, AddressOf pMyWindowProcDlg)
End Function
Private Sub pUnSubClassDlg()
Call SetWindowLong(DialogWindow, GWL_WNDPROC, glPrevWndProcDlg)
End Sub
Private Function fSubClassEdit() As Long
fSubClassEdit = SetWindowLong(EditWindow, GWL_WNDPROC, AddressOf pMyWindowProcEdit)
End Function
Public Sub pUnSubClassEdit()
Call SetWindowLong(EditWindow, GWL_WNDPROC, glPrevWndProcEdit)
End Sub
Private Function fSubClass() As Long
fSubClass = SetWindowLong(ButtonWindow, GWL_WNDPROC, AddressOf pMyWindowProc)
End Function
Private Sub pUnSubClass()
Call SetWindowLong(ButtonWindow, GWL_WNDPROC, glPrevWndProc)
End Sub
Private Function fSubClassFS() As Long
fSubClassFS = SetWindowLong(ScrollWindow, GWL_WNDPROC, AddressOf pMyWindowProcFS)
End Function
Public Sub pUnSubClassFS()
Call SetWindowLong(ScrollWindow, GWL_WNDPROC, glPrevWndProcFS)
End Sub
Private Function pMyWindowProcFS(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
pMyWindowProcFS = CallWindowProc(glPrevWndProcFS, hw, uMsg, wParam, lParam)
End Function
Private Function pMyWindowProcDlg(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'This is a hook on the main window
Dim iKeyCode As Long
Select Case uMsg
Case WM_GETMINMAXINFO 'stop the scroller if it gets too small
      Dim udtMINMAXINFO As MINMAXINFO
      Dim nWidthPixels&, nHeightPixels&
      nWidthPixels = Screen.Width \ Screen.TwipsPerPixelX
      nHeightPixels = Screen.Height \ Screen.TwipsPerPixelY
      CopyMemory udtMINMAXINFO, ByVal lParam, Len(udtMINMAXINFO)
      With udtMINMAXINFO
        .ptMinTrackSize.x = 320 'change to desired minimum size
        .ptMinTrackSize.Y = 320
      End With
      CopyMemory ByVal lParam, udtMINMAXINFO, Len(udtMINMAXINFO)
Case WM_SIZE
    Call GetWindowRect(DialogWindow, R) 'how big is it ?
    SizeAndPosition 'Move the controls to fit
Case WM_EXITSIZEMOVE
    Call GetWindowRect(DialogWindow, R) 'how big is it ?
    SizeAndPosition 'Move the controls to fit
End Select
pMyWindowProcDlg = CallWindowProc(glPrevWndProcDlg, hw, uMsg, wParam, lParam)
End Function
Private Function pMyWindowProcEdit(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'This is a hook on the edit box
Dim iKeyCode As Long, temp As String, tmpDir As String
Select Case uMsg
Case WM_CHAR
    iKeyCode = (wParam And &HFF)
    If iKeyCode = 13 Then 'user is finished - they pressed enter
        tmpDir = StripTerminator(CurrentDir)
        If Right(tmpDir, 1) = "\" Then tmpDir = Left(tmpDir, Len(tmpDir) - 1)
        temp = gettext(EditWindow) 'read the edit box
        If Right(temp, 1) = "\" Then temp = Left(temp, Len(temp) - 1)
        If FileExists(PathOnly(tmpDir) + "\" + temp) Then 'does this work ?
            CurrentDir = PathOnly(tmpDir) + "\" + temp
            Call SendMessage(DialogWindow, BFFM_SETSELECTION, 1, CurrentDir)
        ElseIf FileExists(temp) Then 'well, try this instead
            CurrentDir = temp
            Call SendMessage(DialogWindow, BFFM_SETSELECTION, 1, CurrentDir)
        Else 'your a wacky user - what am I supposed to do ?
            MsgBox temp + vbCrLf + "The specified path does not exist." + vbCrLf + vbCrLf + "Check the path, and try again.", vbCritical, "Browse for Folder"
        End If
    Else
        pMyWindowProcEdit = CallWindowProc(glPrevWndProcEdit, hw, uMsg, wParam, lParam)
    End If
    Exit Function
End Select
pMyWindowProcEdit = CallWindowProc(glPrevWndProcEdit, hw, uMsg, wParam, lParam)
End Function
Private Function pMyWindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long