Forma 1 tane command1 butonu ekleyiniz

1 adet ProgressBar1 ekleyin

1 adet StatusBar1 ekleyin

-------------------------------

Aşağıdaki kodu Forma Ekleyiniz

Option Explicit

Private defProgBarHwnd As Long

Private Declare Function SetParent Lib "user32" _

(ByVal hWndChild As Long, _

ByVal hWndNewParent As Long) As Long

Private Const WM_USER = &H400

Private Const CCM_FIRST As Long = &H2000&

Private Const CCM_SETBKCOLOR As Long = (CCM_FIRST + 1)

Private Const PBM_SETBKCOLOR As Long = CCM_SETBKCOLOR

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

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 = "Calıştır Progbar"

With ProgressBar1

.Min = 0

.Max = 10000

.Value = .Max

End With

Dim pading As Long

pading = 40

AttachProgBar ProgressBar1, StatusBar1, 2, pading

Call SendMessage(ProgressBar1.hwnd, _

PBM_SETBARCOLOR, _

0&, _

ByVal RGB(205, 0, 205))

ProgressBar1.Value = 0

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 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

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

defProgBarHwnd = SetParent(pb.hwnd, sb.hwnd)

With sb

.Align = vbAlignTop

.Visible = False

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

.Panels(nPanel).AutoSize = sbrNoAutoSize

.Align = vbAlignBottom

.Visible = True

End With

End If

End Function
__________________