如何通过代码实现将控件做成平面的??

guoke888 2003-11-14 04:53:15
如何通过代码实现将控件做成平面的??
...全文
31 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
射天狼 2003-11-14
  • 打赏
  • 举报
回复
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

'改变控件的风格。依xp风格显示
Public Function AddOfficeBorder(ByVal hWnd As Long)

Dim lngRetVal As Long

'Retrieve the current border style
lngRetVal = GetWindowLong(hWnd, GWL_EXSTYLE)

'Calculate border style to use
lngRetVal = lngRetVal Or WS_EX_STATICEDGE And Not WS_EX_CLIENTEDGE

'Apply the changes
SetWindowLong hWnd, GWL_EXSTYLE, lngRetVal
SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or _
SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED

End Function


Public Sub changeForm(ByRef frmChng As Object)
On Error GoTo EH
Dim objCtrl As Control

frmChng.Appearance = 0
AddOfficeBorder (frmChng.hWnd)
frmChng.BackColor = &H80000016
For Each objCtrl In frmChng.Controls

If Not TypeOf objCtrl Is Label Then
objCtrl.Appearance = 0

If TypeOf objCtrl Is TextBox Or _
TypeOf objCtrl Is CommandButton Or _
TypeOf objCtrl Is ComboBox Or _
TypeOf objCtrl Is Frame Then
' TypeOf objCtrl Is MSHFlexGrid Or _
' TypeOf objCtrl Is DTPicker


AddOfficeBorder (objCtrl.hWnd)
End If
If TypeOf objCtrl Is TextBox Or _
TypeOf objCtrl Is CommandButton Or _
TypeOf objCtrl Is ComboBox Or _
TypeOf objCtrl Is CheckBox Or _
TypeOf objCtrl Is OptionButton Then

objCtrl.BackColor = &H80000016
objCtrl.BorderStyle = 0
End If

If TypeOf objCtrl Is CheckBox Or _
TypeOf objCtrl Is OptionButton Then

objCtrl.BackColor = &H8000000F
End If
If TypeOf objCtrl Is Frame Then
objCtrl.BackColor = &H8000000F
End If
End If
Next

EH:
If Err.Number = 438 Then
Resume Next
End If
End Sub


Private Sub Command1_Click()
Call changeForm(Me)
End Sub


7,766

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧