StatusBar+进程条问题

[chendjin]

如何将进程条放置在MDI窗体中StatusBar的第一个Panels（0）上，如同StatusBar
自带一样！

[flyingZFX]

Option Explicit

Private defProgBarHwnd As Long

Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long

'used to change progressbar colour
Private Const WM_USER = &H400
Private Const CCM_FIRST As Long = &H2000&
Private Const CCM_SETBKCOLOR As Long = (CCM_FIRST + 1)

'set progressbar backcolor in IE3 or later
Private Const PBM_SETBKCOLOR As Long = CCM_SETBKCOLOR

'set progressbar barcolor in IE4 or later
Private Const PBM_SETBARCOLOR As Long = (WM_USER + 9)

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



Private Sub Form_Load()

Dim pnl As Panel
Dim btn As Button
Dim x As Long

'create statusbar
With StatusBar1
For x = 1 To 3
Set pnl = .Panels.Add(, , "", sbrText)
pnl.Alignment = sbrLeft
pnl.Width = 1800
pnl.Bevel = sbrInset
If x = 3 Then pnl.AutoSize = sbrSpring
If x = 1 Then pnl.Text = "Status/Progbar Demo"
Next
End With

Command1.Caption = "Set Progbar"
Command2.Caption = "Run Progbar"

With ProgressBar1
.Min = 0
.Max = 10000
.Value = .Max
End With

End Sub


Private Sub Form_Unload(Cancel As Integer)

If defProgBarHwnd <> 0 Then
SetParent ProgressBar1.hwnd, defProgBarHwnd
End If

End Sub


Private Sub Command1_Click()

Dim pading As Long


'parent the progress bar in the status bar
pading = 40
AttachProgBar ProgressBar1, StatusBar1, 2, pading

'change the bar colour
Call SendMessage(ProgressBar1.hwnd, _
PBM_SETBARCOLOR, _
0&, _
ByVal RGB(205, 0, 205))

ProgressBar1.Value = 0

End Sub


Private Sub Command2_Click()

Dim cnt As Long
Dim tmp As String

tmp = StatusBar1.Panels(1).Text
StatusBar1.Panels(1).Text = "Processing ..."

For cnt = 1 To ProgressBar1.Max

ProgressBar1.Value = cnt

'needed to trap cancel click
DoEvents

Next

StatusBar1.Panels(1).Text = tmp
ProgressBar1.Value = 0

End Sub


Private Function AttachProgBar(pb As ProgressBar, _
sb As StatusBar, _
nPanel As Long, _
pading As Long)

If defProgBarHwnd = 0 Then

'change the parent
defProgBarHwnd = SetParent(pb.hwnd, sb.hwnd)

With sb

'adjust statusbar. Doing it this way
'relieves the necessity of calculating
'the statusbar position relative to the
'top of the form. It happens so fast
'the change is not seen.
.Align = vbAlignTop
.Visible = False

'change, move, set size and re-show
'the progress bar in the new parent
With pb
.Visible = False
.Align = vbAlignNone
.Appearance = ccFlat
.BorderStyle = ccNone
.Width = sb.Panels(nPanel).Width
.Move (sb.Panels(nPanel).Left + pading), _
(sb.Top + pading), _
(sb.Panels(nPanel).Width - (pading * 2)), _
(sb.Height - (pading))

.Visible = True
.ZOrder 0
End With

'restore the statusbar to the
'bottom of the form and show
.Panels(nPanel).AutoSize = sbrNoAutoSize
.Align = vbAlignBottom
.Visible = True

End With

End If

End Function

[flyingZFX]

在窗体中需要有

二个 command

一个 滚动条

一个状态条

[zichen66]

可以做到的,不过比较麻烦

[chendjin]

自己顶一下

[aohan]

用Coolbar控件来做，参考相应文档

[chendjin]

俺没有Coolbar控件，能否发一个：
[e-mail]

[虎翼]

Coolbar在vb中带了,你引用进去就行了

[chendjin]

flyingZFX不在线么？

[chendjin]

To flyingZFX:
你可能忽略了StatusBar+progressbar1均在MDI上,Command1、2不能添加
在MDI上，我增加了Form1子窗体调试，代码位置也作了相应调整，点击
Command1时出现问题
With pb
.Visible = False
....
.Width = sb.Panels(nPanel).Width 运行至该行提示“不能在该控件中设置‘Width’属性”。虽然暂时不通，但从你的代码中我又有了提高，谢谢你的帮助，我自己再想办法解决。

[chendjin]

奇怪,我已经结贴了(点击管理后可以看到某某得分情况,为什么看不到结
贴消息),斑竹请看一下!