|
|
楼主 |
发表于 2017-7-30 01:11:18
|
显示全部楼层
来自： 中国陕西西安
- Option Explicit
* Q! v( z$ v# [# B* q - - Y/ L3 C6 y9 ~& x2 D9 a( i
- ' 定义用户类型，以减少＃if VBA7语句的数量，但不能消除他们...$ ]& o% b h, v7 k, E
- Private Type LongPtr_T
2 `$ h. m# r% X% r - #If VBA7 Then
# ^" {$ e+ h6 g. D - Value As LongPtr+ Z5 a! m3 E. e7 X0 M0 j( o$ l
- ' Compare automatically resized LongPtr to fixed size Long and LongLong. Z( E) e0 x: f S6 a, h" O/ A
- #Else7 G( W% e% C" U- g5 P* b h
- Value As Long
/ N2 E3 w+ Y h8 B8 G - #End If7 ^0 |* K e; U, \
- End Type& q+ `2 t: w7 `% d- @
- - B0 S- I7 D4 e+ \. {8 m1 i
- ' Win32 数据类型. Different signatures for different versions of VBA
) H$ Y8 q2 _% n* p) ^* z8 q - Private Type BROWSEINFO
# q: o v2 M6 j" I- \" C; e2 a - #If VBA7 Then/ m; E; L" C$ t6 o( P
- hWndOwner As LongPtr
: r# j6 w* C$ x: i% t - pIDLRoot As LongPtr- O: l* i! ~& T( n5 [
- pszDisplayName As Long9 n: _) @% ~( I1 |: O) I8 z
- lpszTitle As String
, l, T ?3 x$ I2 v4 ~5 l- d - ulFlags As Long" o+ J$ W; i% e2 b# P
- lpfnCallback As LongPtr: V: t/ Y, q7 m7 q, |( Z
- lParam As Long$ c1 n) t& k- \; g0 e! Z- _4 |
- iImage As Long
) N5 k. ~8 t* M - #Else# R- ?1 O% s5 x! p9 Y
- hWndOwner As Long9 ?' s4 ^, b" j; T6 E
- pIDLRoot As Long& I# a: K( _3 g. D. |
- pszDisplayName As Long
3 K# n: E% G" \" V- t9 E/ Q - lpszTitle As String
1 A$ X3 U& k1 U$ o# h, k* r - ulFlags As Long. n: }1 X1 c. T
- lpfnCallback As Long' q( f/ _- e9 A
- lParam As Long& w7 D& B1 T: d2 |, p7 k% T, Y( Q" U
- iImage As Long
/ `+ |) K1 P9 L% e$ R, B - #End If
4 h9 Y) G' z4 Z9 X7 m% ^ - End Type: }+ S# ^7 x8 C, l: ?/ L7 h* |
- : Y5 `2 m" N- j" B6 N
- Private Const MAX_PATH = 260
2 T8 t- {7 r' ~0 H1 h) T+ u: O. g - 'Directories only6 l4 V+ @3 f1 y1 `* d
- Private Const BIF_RETURNONLYFSDIRS = &H1&
& p( G, i* B3 l - 'Windows 2000 (Shell32.dll 5.0) extended dialog3 K' T! }! G1 d% {& s3 m6 j4 u
- Private Const BIF_NEWDIALOGSTYLE = &H405 l6 z% x/ v7 P, y
- ' show edit box g( H* u- T! t* u- M
- Private Const BIF_EDITBOX = &H10&
3 v, {3 I$ H2 K0 x( c/ S
4 w+ y6 E8 z, E( F1 ~- Private Const WM_USER = &H400. W* D2 Z6 \6 }
- Private Const BFFM_INITIALIZED = 1( R w, o- y8 j: P$ e
- Private Const BFFM_SELCHANGED = 2
# F5 L. Q7 L" k% W/ G7 K1 {6 F5 R - Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)6 e# m4 t% U) S- C7 u8 E+ ^
5 z% f- |" [6 q0 B. V- Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
3 g- ?6 A* P, ~; j3 n- X+ ?- L - Private Const BFFM_SETEXPANDED = (WM_USER + 16)/ ]% `) a0 U" a+ c9 f
/ I7 c1 C) d. X7 d9 x- Private m_sDefaultFolder As String" q3 F% x- h$ ]$ @% O, l
- & J3 q" }: G( |( U+ |) l- g
- Public Const SWP_NOMOVE = 2
0 L# \; D* m6 l* H S0 d, ~ - Public Const SWP_NOSIZE = 1' H3 Y" D1 n! K) s; o5 c3 ]! b
- Private Const SWP_NOZORDER = 4
% c2 d: E, A) ~) h
% ]7 [, |" B: @! X2 O) _- Private Type RECT7 D9 K( D: n5 J4 J+ q+ Z+ }, I3 Z
- Left As Long
) G; N: P% I g3 b' E: ?2 P4 t - Top As Long: F4 D& U# j% m& c5 e' \9 O
- Right As Long
" M1 K5 i: n, v - Bottom As Long" ]5 _# c0 w( _. w3 o
- End Type4 |/ N" r9 j; B2 q8 k" ]! j
- * \8 h s* v: C% H8 h4 Y2 r7 v
- ' Win32 API declarations. Different signatures for different versions of VBA.
# L& i1 [8 f/ R8 N% |; m - ' Note the mandatory use of PtrSafe keyword in VBA7.
_( ?' g) K1 U4 l6 v3 L - #If VBA7 Then
, i0 a) q: W& n3 z' j8 U - 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) F8 z' `8 u, p- ?
- Private Declare PtrSafe Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long& K/ Q9 o2 L! D+ g7 F0 B
- Private Declare PtrSafe Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long
+ D9 v$ e) B g - Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)
r$ i$ W) ]- g! ] - Private Declare PtrSafe Function SetWindowPos Lib "USER32" (ByVal hWnd As LongPtr, _
( K! ~7 ?7 I2 h7 z - ByVal hWndInsertAfter As LongPtr, _( u7 s5 J* Q. q1 K" `8 q; i* T
- ByVal x As Long, _
; d0 _$ P7 }3 Y- I$ N" e4 X - ByVal y As Long, _# Q% | V7 ] ^8 n4 |
- ByVal cx As Long, _! ~/ [; Y- F4 ]7 G
- ByVal cy As Long, _
8 }+ D* a7 F+ g6 j, d7 I f$ R/ y - ByVal wFlags As Long) As Long+ s! u$ o. [+ s7 m. j ]6 g' \& D6 t
- Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" (ByVal hWnd As LongPtr, lpRect As RECT) As Long7 O& q- G& G2 b$ ], d2 b. P
- % _6 a& r2 t) d
- #Else: Q, Z v# q: d/ c7 ~ d. D& D' Y
- 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; h7 [5 ^ y$ ]9 d
- Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long% q5 z) Z1 S8 U9 F6 p
- Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long% t0 z! |8 M1 W9 O3 h" a% N
- Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)/ Y7 C y5 x. \* P* F
- Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
8 g7 _- l, a" }2 {7 h* f - ByVal hWndInsertAfter As Long, _6 e: h: a+ s" W7 R* B' w
- ByVal x As Long, _/ n' b0 `: G3 h
- ByVal y As Long, _8 E8 o. ?0 [0 r
- ByVal cx As Long, _; C- Y8 s8 K" ^2 a' a
- ByVal cy As Long, _$ I6 A( S# n) e5 H" w4 E$ Q, {! l
- ByVal wFlags As Long) As Long
- q) u1 H0 j- n0 q: k6 o& x: o" y; O - Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long- R$ I, L; {! @5 w1 @
- 1 q d" K+ ^" Z4 X/ z
- #End If& d+ V6 a/ c. W Z3 |' f- M" Q
- $ g1 e# R- g8 F. \5 v) s7 a8 f
- Private lastKnownPosition As RECT
1 a7 Y5 E% C7 `9 [* k* T - Private lockLastKnownPosition As Boolean
: U, t) G* T5 a* g( }" z1 }梁大，将这一段修改一下 |
|
发表于 2017-7-29 14:05:12
发表于 2017-7-29 15:10:55
