|
|
楼主 |
发表于 2017-7-30 01:11:18
|
显示全部楼层
来自： 中国陕西西安
- Option Explicit
' o# `- @7 r6 `" p3 a7 T - ) U" x. ^0 ^+ {0 K2 {8 t
- ' 定义用户类型，以减少＃if VBA7语句的数量，但不能消除他们...
7 d s2 H/ V r4 ` - Private Type LongPtr_T
8 t' l& M `- ^2 [5 U4 @ - #If VBA7 Then
+ P% s& @+ C# J9 n - Value As LongPtr
+ c8 v0 [- p! `. G6 n' W - ' Compare automatically resized LongPtr to fixed size Long and LongLong- I5 ]- b6 X2 J% q# Y
- #Else4 P N# }, P" J
- Value As Long7 @7 u8 n& ]( T) U, h% w; _
- #End If
6 b* ^# h4 U! H# M$ k& { - End Type
5 _9 c8 @) f- @; F( | Z0 x
0 F% [4 O. M9 r7 b7 g- {( Q; R- ' Win32 数据类型. Different signatures for different versions of VBA
) e' d( D; o+ J/ t - Private Type BROWSEINFO
# d2 b$ T8 ?$ y1 l8 ^1 M5 D - #If VBA7 Then
( u: T% p e1 y+ R" f9 b - hWndOwner As LongPtr
1 t9 @$ Y6 i! g( I, ]1 J - pIDLRoot As LongPtr
* B6 F( L. r) x( N - pszDisplayName As Long! t/ [+ A! S1 X4 x6 Y' x
- lpszTitle As String
# @5 E$ r- f/ p$ F - ulFlags As Long
0 H- L8 e/ w$ y& F& o9 l' }9 j; c u+ c - lpfnCallback As LongPtr7 q7 }- `3 O5 r' R4 P: `
- lParam As Long( y+ T" S$ N/ A
- iImage As Long
) Z$ X0 x) f' v9 A" p. B4 j1 E$ ^9 p - #Else
/ L5 _$ h2 k9 k8 p' | - hWndOwner As Long R, `, D( U( i6 J- q6 X
- pIDLRoot As Long
6 @, t3 X1 l/ C+ z% Y. O' E - pszDisplayName As Long' ~9 V; t. K, P) C; v$ z& V1 r
- lpszTitle As String$ v: Q9 X( b/ d* _; ^
- ulFlags As Long
! L& U0 d+ _3 d3 ^4 r" V - lpfnCallback As Long) ~! W/ a! o8 p* \6 c
- lParam As Long# o( d; c G# B! A. ]
- iImage As Long, j' k: s w: {$ ~, X" g
- #End If) Z3 I' \; ]/ |0 n; ~, }: g
- End Type6 M( P/ L! F2 q2 [7 K
& x+ E5 u7 ~" y: f+ E ~0 l- Private Const MAX_PATH = 260
7 E) B B5 O1 l# I - 'Directories only
, \6 L+ ~; _6 ^0 @* w - Private Const BIF_RETURNONLYFSDIRS = &H1&
6 z' i) }2 v+ Q+ ?2 M% d% A$ ^2 U - 'Windows 2000 (Shell32.dll 5.0) extended dialog1 h# e3 H/ ^! B) \: M
- Private Const BIF_NEWDIALOGSTYLE = &H40
8 p7 T* }/ L- p b+ v% M9 j! x: Y - ' show edit box: t1 o0 L- P3 I9 ^! z
- Private Const BIF_EDITBOX = &H10&
5 @1 T2 c& r3 B( P: M - $ v: ^ y! T4 n: S9 F
- Private Const WM_USER = &H400( u. i' l+ d$ M: u6 O
- Private Const BFFM_INITIALIZED = 1
( L; _# T, f2 B0 @2 g& z - Private Const BFFM_SELCHANGED = 21 w* q6 V( n0 h& ~$ K% Q8 u7 H
- Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)$ t/ ?$ Z6 l6 \! T' C% I
. _3 K C5 G; F- Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
" C& u' a4 L( {& R" Q! i0 Z - Private Const BFFM_SETEXPANDED = (WM_USER + 16)7 g: S' H. J. {. {! R& R4 `
; q* W! G/ u* L- D- Private m_sDefaultFolder As String# j8 E5 T7 \& L3 J
- 5 @+ ~* S$ d: |! x8 g
- Public Const SWP_NOMOVE = 28 ]- z6 {3 m1 ]' H" R2 N# ]
- Public Const SWP_NOSIZE = 1. G: m0 h) Q X1 E1 ?
- Private Const SWP_NOZORDER = 4
+ Y: l/ r1 `# R! [: c - 4 u; b$ K5 I# k- e; m4 _- i
- Private Type RECT
4 S5 P* L0 B; B' Q4 F+ F - Left As Long7 \; j4 @ e: [8 O! z
- Top As Long' ` p+ s' z8 o1 ~; J* c; D
- Right As Long
% ]3 _7 t+ f0 D+ o% I( \$ v - Bottom As Long
7 w0 |6 d! W+ L1 q6 ^$ M - End Type( j' K" M* t, Q5 ^* Q
- . X( _$ c: h! h% v: C
- ' Win32 API declarations. Different signatures for different versions of VBA.0 g2 G% Q* c) o4 |
- ' Note the mandatory use of PtrSafe keyword in VBA7.
: b% ]* E1 M2 z( [( d - #If VBA7 Then
' G( |4 p1 g/ E0 u0 A1 [, B - Private Declare PtrSafe Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
3 \1 ?& m) O! r1 N2 }! _- ^5 g- ?3 H6 g; h - Private Declare PtrSafe Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long4 R0 g3 V, {& x' l
- Private Declare PtrSafe Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long
- ]* J$ A7 Y, e0 H( O) W& M2 X) I - Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)
- f0 x! ~: F4 W+ A7 J# R: p; [ - Private Declare PtrSafe Function SetWindowPos Lib "USER32" (ByVal hWnd As LongPtr, _
3 z- u4 s- Z: r1 p/ B' @: h - ByVal hWndInsertAfter As LongPtr, _. l4 Z1 e$ t. ]$ r- V& T1 ]
- ByVal x As Long, _3 D7 k# V2 y) _0 J" i7 o
- ByVal y As Long, _. o. O) b) R( F4 E" v' y
- ByVal cx As Long, _4 K! y$ |* @* q% @
- ByVal cy As Long, _
. t9 L. t# Z8 U - ByVal wFlags As Long) As Long
# A7 k/ ?- K6 J+ Z, H$ i - Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" (ByVal hWnd As LongPtr, lpRect As RECT) As Long" D! K; _ ?# ?
- . u, ^7 A% i+ M3 [
- #Else E- j8 u2 C, ~
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long: e# i4 V7 R, g2 S% M6 Y) Q
- Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long
0 W8 B- f0 Q' O' R2 w) p+ h# R2 z - Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long) ]5 Q, t) j: h( r) t! m
- Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)
$ Y. A3 S! r: O0 L+ H - Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _6 ^% g9 [' r$ w% h
- ByVal hWndInsertAfter As Long, _
) x' g. v% O0 }" c0 \4 y - ByVal x As Long, _( `7 m! s, C' C+ B) M
- ByVal y As Long, _
6 `5 {( b- `2 s4 \" d' J( i* o - ByVal cx As Long, _
( E, ^$ G: T( U B4 l - ByVal cy As Long, _
1 S9 D" M8 ], h j - ByVal wFlags As Long) As Long2 U$ F. O8 k$ L* D! d4 K
- Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long* q; g" ^! G; ]0 s6 V4 z3 s2 S
- / A% A6 E( N7 R+ d( ~7 L
- #End If) L8 M& k# |! j6 [# g" U7 w
- A, Q; y; J* y, i5 V# ~- [
- Private lastKnownPosition As RECT" ?6 f7 q7 L0 Q* I
- Private lockLastKnownPosition As Boolean
; ~* j; _$ P3 q- ], g s5 y1 E% X梁大，将这一段修改一下 |
|
发表于 2017-7-29 14:05:12
发表于 2017-7-29 15:10:55
