OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 15-12-2007, 09:22
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default [useful code] BrowserForFolder dialog box

here's a WinAPI wrapper function I use to display a folder selection dialog box.
  • Auto-expands initial folder
  • Remembers on-screen dialog position
    (if OK was clicked or a user has browsed for another folder)
  • Optionally shows files along with folders
Put the code into a new module for convenience and use it as follows:
Code:
dim tmpStr as string
tmpStr = apiBrowseForFolder("d:\folder1\folder2\folder3", bIncludeFiles:=True)
if tmpStr<>"" then
   msgbox "Folder selected: " & tmpStr
end if
Here's the main code:
Code:
Option Explicit

Private m_biStartFolder$, m_biInit&, m_BrowseF4rect As wRECT

Private Declare Function SHBrowseForFolderW& Lib "shell32" (ByRef lpbi As wBROWSEINFO)
Private Type wBROWSEINFO
         hwndOwner As Long: pidlRoot As Long: pszDisplayNameW As Long: pszTitleW As Long: _
         ulFlags As Long: lpfn As Long: lParam As Long: iImage As Long: End Type

Private Type wRECT: L As Long: t As Long: r As Long: b As Long: End Type
Private Type wPOINT: x As Long: y As Long: End Type

Private Declare Function SHGetPathFromIDListW& Lib "shell32" (ByVal pidList&, ByVal lpBuffer&)

Private Declare Function SetWindowPos& Lib "user32" (ByVal hWnd&, ByVal hAfter&, ByVal x&, ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags As wEnumSetWindowPos)
Private Enum wEnumSetWindowPos: SWP_NOSIZE = 1: SWP_NOMOVE = 2: SWP_NOZORDER = 4: SWP_NOREDRAW = 8: SWP_NOACTIVATE = 16: _
         SWP_DRAWFRAME = 32: SWP_SHOWWINDOW = 64: SWP_HIDEWINDOW = 128: SWP_NOCOPYBITS = 256: SWP_NOREPOSITION = 512: _
         SWP_NOSENDCHANGING = 1024: SWP_DEFERERASE = 8192: SWP_ASYNCWINDOWPOS = 16384: End Enum

Private Declare Function GetWindowPlacement& Lib "user32" (ByVal hWnd&, lpwndpl As wWINDOWPLACEMENT)
Private Type wWINDOWPLACEMENT: Length As Long: Flags As Long: showCmd As Long: MinPos As wPOINT: MaxPos As wPOINT: NormPos As wRECT: End Type

Private Declare Function SendMessageW& Lib "user32" (ByVal hWnd&, ByVal msg&, ByVal wParam&, ByVal lParam&)
Private Declare Sub memmove Lib "ntdll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef source As Any, ByVal Length&)
Private Declare Function lstrlenW& Lib "kernel32" (ByVal lpStrW&)


'*************************************
Function apiBrowseForFolder$ _
   (Optional StartFolder$, Optional ByVal bIncludeFiles As Boolean = False)
'*************************************
   Dim bi As wBROWSEINFO, IDL&, sDisp$, sTitle$
   On Error Resume Next
   With bi
      .pidlRoot = 0: sDisp = String$(300, vbNullChar): .pszDisplayNameW = StrPtr(sDisp)
      sTitle = IIf(Len(StartFolder), "Initial folder: " & StartFolder, vbNullString)
      .pszTitleW = StrPtr(sTitle)
      .ulFlags = 1 Or &H40 Or &H10 Or &H8000 Or IIf(bIncludeFiles, &H4000, 0)
      ' BIF_RETURNONLYFSDIRS Or BIF_USENEWUI Or BIF_SHAREABLE or BIF_BROWSEINCLUDEFILES
      m_biStartFolder = StartFolder
      .lpfn = procAddr(AddressOf apiBrowseCBproc)
   End With
   
   m_biInit = 0
   IDL = SHBrowseForFolderW(bi)
   
   If IDL Then _
      If SHGetPathFromIDListW(IDL, bi.pszDisplayNameW) Then _
         apiBrowseForFolder = stringZmemW(bi.pszDisplayNameW)
   End Function


Private _
Function apiBrowseCBproc _
   (ByVal hWnd&, ByVal uMsg&, ByVal lParam&, ByRef lpData As Byte) As Long
   
   Select Case uMsg
      Case 1 'BFFM_INITIALIZED
         SetWindowPos hWnd, 0, m_BrowseF4rect.L, m_BrowseF4rect.t, 0, 0, _
                      SWP_NOZORDER Or SWP_NOREPOSITION Or _
                      SWP_NOSENDCHANGING Or SWP_NOSIZE
         m_biInit = StrPtr(m_biStartFolder)
         SendMessageW hWnd, &H467&, 1, ByVal m_biInit 'BFFM_SETSELECTIONW
         SendMessageW hWnd, &H46A&, 1, ByVal m_biInit 'BFFM_SETEXPANDED
         m_biInit = 1
      Case 2 'BFFM_SELCHANGED
         If m_biInit = 1 Then
            Dim wp As wWINDOWPLACEMENT: wp.Length = Len(wp)
            GetWindowPlacement hWnd, wp: m_BrowseF4rect = wp.NormPos
            SendMessageW hWnd, &H46A&, 0, lParam 'BFFM_SETEXPANDED
            Dim s$: s = String$(300, vbNullChar)
            If SHGetPathFromIDListW(lParam, StrPtr(s)) <> 0 Then
               'Debug.Print "Folder clicked: " & stringZmemW(StrPtr(s))
            End If
         End If
   End Select
   End Function

Private _
Function procAddr&(ByVal proc&): procAddr = proc: End Function


Private _
Function stringZmemW$(ByVal mem&)
   Dim i&: i = lstrlenW(mem): stringZmemW = Space$(i): memmove ByVal StrPtr(stringZmemW), ByVal mem, i * 2
   End Function
Attached Images
  

Last edited by wOxxOm; 19-12-2007 at 14:54.
Reply With Quote
  #2  
Old 19-12-2007, 05:42
ebu
Guest
 
Posts: n/a
Default

Hi, a good thing.

It is possible to open the target folder automaticly?
*.* doesn't work

d = ActiveDocument.FilePath
tmpStr = apiBrowseForFolder(d, bIncludeFiles:=True)


P.S.

The old Corel Scrip need only one line. I know, it is not to compare
d = ActiveDocument.FilePath & "*.*"
sFileName = CorelScriptTools.GetFileBox("Exel Files (*.xls;*.wdp)|*.xls;*.wdp", "Choose one File", 0, d)

Regards

Last edited by ebu; 19-12-2007 at 06:38.
Reply With Quote
  #3  
Old 19-12-2007, 09:25
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

please make your idea more obvious by providing the current state screenshot, the desired state screenshot, etc.
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
HOW-TO call coreldraw12 find dialog from VBA code???? wOxxOm CorelDRAW/Corel DESIGNER VBA 4 02-03-2008 08:32
Unsharp Mask dialog box geHucKa CorelDRAW/Corel DESIGNER VBA 3 04-07-2006 21:42
Problem with Common Dialog in Corel VBA RobC CorelDRAW/Corel DESIGNER VBA 3 13-05-2005 14:43
format text dialog box implement graphicdesigner CorelDRAW/Corel DESIGNER VBA 5 22-12-2004 13:37
Missing font dialog on import click101 CorelDRAW/Corel DESIGNER VBA 2 28-04-2003 12:32


All times are GMT -5. The time now is 17:41.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com