frmeffect.bas

来自「Usb Key loock vb soucrse code. ocx not f」· BAS 代码 · 共 139 行

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