|
|
楼主 |
发表于 2017-7-30 01:11:18
|
显示全部楼层
- Option Explicit) e+ g) S" y2 w# L% Y* t( Q1 R
7 ^' x, {6 w/ S* K- ' 定义用户类型，以减少＃if VBA7语句的数量，但不能消除他们...' B8 p; Y6 ^* x+ J. w
- Private Type LongPtr_T1 t! @9 i2 W' _: F! r
- #If VBA7 Then. h' ^$ K% y+ k0 _
- Value As LongPtr
% A) m7 W6 F R- Q7 j/ F. j9 t - ' Compare automatically resized LongPtr to fixed size Long and LongLong/ L, U4 z% m2 L1 w" L2 w" J
- #Else' b" U& N. `7 ^) n
- Value As Long
6 j1 q) _0 T- P; @ - #End If
1 v! U$ c! L6 }& ?' p/ p - End Type% h" e' i$ k" ]8 N l
- 9 y6 c: L7 W9 X: V9 L
- ' Win32 数据类型. Different signatures for different versions of VBA
! t# x7 {+ t* B/ e - Private Type BROWSEINFO
n: C$ n# X$ e) T - #If VBA7 Then
/ }& f6 |; F) N3 [- e) v* g - hWndOwner As LongPtr9 \; B5 _; S7 ?
- pIDLRoot As LongPtr- v9 U W. B/ Y' R
- pszDisplayName As Long
" F* B4 a- E( n+ z* a' {" g# W8 j - lpszTitle As String
6 P+ J& B) l- u - ulFlags As Long
( l1 b7 `8 e% s; [ - lpfnCallback As LongPtr! j. j. a) D5 X1 t6 _& T. Q
- lParam As Long3 h4 B- \2 c9 s8 S
- iImage As Long
' s1 P3 y( U+ k. a9 h! q0 B, b - #Else7 c1 o* }) P; F5 T" [3 b3 f8 O
- hWndOwner As Long
( @& Q9 h' e: J6 a# S& p9 e - pIDLRoot As Long
1 g' _2 ^! x* E% k% w# }: Z% e - pszDisplayName As Long
3 a/ f& F& ~7 R* R+ x. b - lpszTitle As String
" \% x+ c" e0 U - ulFlags As Long
! s5 j- o% d! C, i/ j3 R! n - lpfnCallback As Long$ {. m/ ^5 e H( ]
- lParam As Long
. k' D& k0 ^' B - iImage As Long
; k8 ^9 m% ^9 L* c9 D - #End If. B$ U+ s) `/ j" i+ f# y
- End Type, L3 j8 n8 k- v& f! J( m: D7 W
- & Q% e+ K: G9 P4 ^
- Private Const MAX_PATH = 260
& N6 u2 k3 r! T+ { - 'Directories only2 J8 H8 L$ s9 K4 g
- Private Const BIF_RETURNONLYFSDIRS = &H1&
?8 J4 D$ n& {+ Y- t6 p9 Y8 P9 T - 'Windows 2000 (Shell32.dll 5.0) extended dialog
4 @; u0 y( E( U4 p! Z - Private Const BIF_NEWDIALOGSTYLE = &H40
; a' ^1 y; t6 e9 [* v - ' show edit box; U% n" P1 y% B$ J( F+ J
- Private Const BIF_EDITBOX = &H10&/ I# j7 X1 l# J* { B# u, E
- 3 p: k: e4 S) b x
- Private Const WM_USER = &H400
) Q" G m3 P! M - Private Const BFFM_INITIALIZED = 1# u, J/ \6 p! f q5 v& Q
- Private Const BFFM_SELCHANGED = 2
, P5 f1 R: \7 L2 N - Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)2 u4 [0 I# k# F& G- N
- ) e/ ^# F! U9 u6 f# Z
- Private Const BFFM_SETSELECTIONA = (WM_USER + 102)7 p6 V( s3 N0 `
- Private Const BFFM_SETEXPANDED = (WM_USER + 16)
$ I+ G. s; d5 d6 r( j: y+ t
" Z1 }5 {+ ]' _$ f& Q- Private m_sDefaultFolder As String0 }( F6 @8 A, J
! T0 h0 R9 |* y; C- Public Const SWP_NOMOVE = 2; l/ D" ]$ R+ x' B
- Public Const SWP_NOSIZE = 11 g1 @. S5 j( Y8 N& {* a
- Private Const SWP_NOZORDER = 4# y8 Y. l. g# a: l
& t& E' _' x% p" J; R ~- Private Type RECT
" V8 _8 z) w8 @+ c6 V* N - Left As Long' Q( Y; G# R4 a6 C% V2 J/ c
- Top As Long
! A+ U: J1 d* Y: v" g - Right As Long
) V, \& w( K* B. q' L: ] - Bottom As Long
) _/ {3 X; B+ {! ?: Z - End Type( H' ~4 m* T2 |9 C r
- G J# i0 \9 J) G( ]
- ' Win32 API declarations. Different signatures for different versions of VBA.
1 E& @$ `, B B M& V5 q4 l9 e - ' Note the mandatory use of PtrSafe keyword in VBA7.
7 T- M7 s: B! ]5 Q( W - #If VBA7 Then, F+ w) V# x: E% 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
6 k% m- t. `! p0 S2 `6 I - Private Declare PtrSafe Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long% v: W7 o5 t4 a/ f1 r" I
- Private Declare PtrSafe Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long
K2 Z: K+ w4 J" X$ J - Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)
1 O' i6 v, v+ O- ]2 l1 O* ] - Private Declare PtrSafe Function SetWindowPos Lib "USER32" (ByVal hWnd As LongPtr, _, u: A- u' K+ g6 h
- ByVal hWndInsertAfter As LongPtr, _4 U: f6 B" r; |# V
- ByVal x As Long, _
; c, h8 J2 }1 r( _ - ByVal y As Long, _
; q& k0 ~, C( {5 e( I( I - ByVal cx As Long, _
$ `" W4 _& q/ C - ByVal cy As Long, _, @/ |' U* y- \$ }/ Y2 q
- ByVal wFlags As Long) As Long+ T) J8 E7 Z( C: Q; T' `( H+ _
- Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
9 w+ s. Q% Y! [7 J; V8 g C - * J/ X% K+ \0 e2 x( s
- #Else
- f- d4 A' u( g" Q - 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
- X0 t$ x- t5 }9 Y - Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long U# }, @# l5 N& t# N9 d4 i
- Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
9 P, l! [" W8 O/ O - Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long). `& m, v+ }! T4 X/ [+ X
- Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
' u& `( d: f E4 D0 \1 R/ u - ByVal hWndInsertAfter As Long, _
( @6 ^6 P# K; @$ r4 K" |1 M - ByVal x As Long, _5 f( t& T9 z; P1 \0 ~# i: b1 K- C5 a
- ByVal y As Long, _# I5 [1 T0 t% g; L
- ByVal cx As Long, _2 t. L2 H/ q. |- q7 c& Z' U
- ByVal cy As Long, _
: j8 I \, T+ A- J+ w$ I! r - ByVal wFlags As Long) As Long
" M! ]! q, f# F# m - Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long- m4 D3 X# G* X8 w0 K8 Y
6 ?3 @# u2 m8 \4 i, ]8 N: u- #End If
. E6 K% T4 q- i- @6 H* I6 R3 u) H - 1 a I! u) F Y5 H! ?$ y
- Private lastKnownPosition As RECT
1 @! N, Z6 _! }5 O m - Private lockLastKnownPosition As Boolean
梁大，将这一段修改一下 |
|
发表于 2017-7-29 14:05:12
发表于 2017-7-29 15:10:55
