📄 frmeffect.bas
字号:
Attribute VB_Name = "frmeffect"
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _
ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_CLIENTEDGE = &H200
Private Const WS_EX_STATICEDGE = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Public Const BS_FLAT = &H8000&
Public Const GWL_STYLE = (-16)
Public Const WS_CHILD = &H40000000
Global Const ATTR_READONLY = 1 'Read-only file
Global Const ATTR_VOLUME = 8 'Volume label
Global Const ATTR_ARCHIVE = 32 'File has changed since last back-up
Global Const ATTR_NORMAL = 0 'Normal files
Global Const ATTR_HIDDEN = 2 'Hidden files
Global Const ATTR_SYSTEM = 4 'System files
Global Const ATTR_DIRECTORY = 16 'Directory
Global Const ATTR_DIR_ALL = ATTR_DIRECTORY + ATTR_READONLY + ATTR_ARCHIVE + ATTR_HIDDEN + ATTR_SYSTEM
Global Const ATTR_ALL_FILES = ATTR_NORMAL Or ATTR_HIDDEN Or ATTR_SYSTEM Or ATTR_READONLY Or ATTR_ARCHIVE
Global Const ATTR_ALL_FILES_EXCEPT_READONLY = ATTR_NORMAL Or ATTR_HIDDEN Or ATTR_SYSTEM Or ATTR_ARCHIVE
Sub AddBorderToAllTextBoxes(frmX As Form) '//咆胶飘 冠胶 瓤苞
'//***************************************************************************************
'// Copyrigth 2006.7.20 Hanhulsoft Make 瘤悼辨
'// 咆胶飘冠胶甸狼 乞搁拳 瓤苞 扁瓷 葛碘
'// 荤侩规过 : AddBorderToAllTextBoxes 汽疙
'//***************************************************************************************
Dim X As Control
On Error Resume Next
For Each X In frmX.Controls
If TypeOf X Is TextBox Then
X.Appearance = vbFlat
X.BorderStyle = 0
AddOfficeBorder X
End If
Next
End Sub
Sub AddBorderToAllListviews(frmX As Form) '//府胶飘轰 冠胶 瓤苞
'//***************************************************************************************
'// Copyrigth 2006.7.20 Hanhulsoft Make 瘤悼辨
'// 府胶飘轰甸狼 乞搁拳 瓤苞 扁瓷 葛碘
'// 荤侩规过 : AddBorderToAllListviews 汽疙
'//***************************************************************************************
Dim X As Control
On Error Resume Next
For Each X In frmX.Controls
If TypeOf X Is ListView Then
X.Appearance = vbFlat
X.BorderStyle = 0
AddOfficeBorder X
End If
Next
End Sub
Sub AddBorderToAlltreeviews(frmX As Form) '//飘府轰 冠胶 瓤苞
'//***************************************************************************************
'// Copyrigth 2006.7.20 Hanhulsoft Make 瘤悼辨
'// 飘府轰甸狼 乞搁拳 瓤苞 扁瓷 葛碘
'// 荤侩规过 : AddBorderToAlltreeviews 汽疙
'//***************************************************************************************
Dim X As Control
On Error Resume Next
For Each X In frmX.Controls
If TypeOf X Is TreeView Then
X.Appearance = vbFlat
X.BorderStyle = 0
AddOfficeBorder X
End If
Next
End Sub
Sub AddBorderToAllProgressBar(frmX As Form) '//橇肺弊贰胶官 瓤苞
'//***************************************************************************************
'// Copyrigth 2006.7.20 Hanhulsoft Make 瘤悼辨
'// 橇肺弊贰胶官甸狼 乞搁拳 瓤苞 扁瓷 葛碘
'// 荤侩规过 : AddBorderToAllProgressBar 汽疙
'//***************************************************************************************
Dim X As Control
On Error Resume Next
For Each X In frmX.Controls
If TypeOf X Is ProgressBar Then
X.Appearance = vbFlat
X.BorderStyle = 0
AddOfficeBorder X
End If
Next
End Sub
Public Function AddOfficeBorder(ctlX As Control) '//command 滚畔狼 乞搁拳
'//***************************************************************************************
'// Copyrigth 2006.7.20 Hanhulsoft Make 瘤悼辨
'// command 滚畔甸狼 乞搁拳 瓤苞 扁瓷 葛碘
'// 荤侩规过 : AddOfficeBorder 汽疙
'//***************************************************************************************
Dim lngRetVal As Long
lngRetVal = GetWindowLong(ctlX.hwnd, GWL_EXSTYLE)
lngRetVal = lngRetVal Or WS_EX_STATICEDGE And Not WS_EX_CLIENTEDGE
SetWindowLong ctlX.hwnd, GWL_EXSTYLE, lngRetVal
SetWindowPos ctlX.hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or _
SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
End Function
Sub AddBorderToAllListbox(frmX As Form) '//府胶飘轰 冠胶 瓤苞
'//***************************************************************************************
'// Copyrigth 2006.7.20 Hanhulsoft Make 瘤悼辨
'// 府胶飘轰甸狼 乞搁拳 瓤苞 扁瓷 葛碘
'// 荤侩规过 : AddBorderToAllListviews 汽疙
'//***************************************************************************************
Dim X As Control
On Error Resume Next
For Each X In frmX.Controls
If TypeOf X Is ListBox Then
X.Appearance = vbFlat
X.BorderStyle = 0
AddOfficeBorder X
End If
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -