هدفم این بود که بفهمم حقیقت چیه!
این هم یه سورس کد که یه همچین کاری می کنه :
باید 2 تا Label، یه CheckBox، یه TextBox و یه CommandButton بذارید رو فرم.
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'The progress bar's Form_Resize() module level variables
Private hProgBar As Long 'hWnd
Private dwPBPosLeft As Long 'static x position when vertical
Private dwPBPosTop As Long 'static y position when horizontal
'SetWindowLong param
Private Const GWL_STYLE As Long = (-16)
'Restricts input in the text box control to digits only
Private Const ES_NUMBER As Long = &H2000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_CHILD As Long = &H40000000
Private Const WM_USER = &H400
Private Const PBM_SETRANGE = (WM_USER + 1)
Private Const PBM_SETPOS = (WM_USER + 2)
Private Const PBM_SETSTEP = (WM_USER + 4)
Private Const PBM_STEPIT = (WM_USER + 5)
Private Const PBM_SETRANGE32 = (WM_USER + 6)
Private Const PBM_GETRANGE = (WM_USER + 7)
Private Const PROGRESS_CLASS = "msctls_progress32"
Private Const PBS_VERTICAL = &H4
Private Const ICC_PROGRESS_CLASS = &H20
Private Type tagINITCOMMONCONTROLSEX
dwSize As Long
dwICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" _
(lpInitCtrls As tagINITCOMMONCONTROLSEX) As Boolean
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function CreateWindowEx Lib "user32" _
Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, _
ByVal hInstance As Long, _
lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
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 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 Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, _
ByVal Length As Long)
Private Sub Form_Load()
Call IsNewComctl32
With Text1
.Text = 25000
.Move 1000, 300, 1000, 285
Call SetWindowLong(.hwnd, _
GWL_STYLE, _
GetWindowLong(Text1.hwnd, GWL_STYLE) _
Or ES_NUMBER)
End With
With Check1
.Caption = "Vertical"
.Value = vbUnchecked
.Move 2200, 300, 1200, 285
End With
With Command1
.Caption = "Create && Run ProgressBar..."
.Cancel = True
.Move 1000, 700, 2500, 375
End With
With Label1
.AutoSize = True
.WordWrap = False
.Caption = ""
.Move 900, 1200
End With
With Label2
.AutoSize = True
.WordWrap = False
.Caption = "n %"
.Move 3700, 780 ', 2500, 375
End With
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Resize()
'adjust the width & height w/the form
If IsWindow(hProgBar) Then
MoveWindow hProgBar, _
dwPBPosLeft, dwPBPosTop, _
Me.ScaleWidth - dwPBPosLeft, _
Me.ScaleHeight - dwPBPosTop, _
1
'display the progress bar's current size
Label1.Caption = "Width: " & Me.ScaleWidth - dwPBPosLeft & _
" Height: " & Me.ScaleHeight - dwPBPosTop & _
" (pixels)"
Else
Label1.Caption = "(click button to create a progress bar...)"
End If
End Sub
Private Sub Command1_Click()
'Dynamically create a progress bar and place it at the
'bottom (or the right) of the form, do stuff that takes a
'while & show the progress, then destroy the progress bar.
'(The progress bar could be hidden using ShowWindow() instead
'of it being destroyed, but the time it takes to create it is
'negligible & its resources are also freed with this method)
Static bRunning As Boolean 'cancel flag
Dim bIsIE3 As Boolean
Dim dwIterations As Long
Dim dwRange As Long
Dim dwStyle As Long
Dim cnt As Long
On Local Error GoTo progbar_exit
If bRunning Then bRunning = False: Exit Sub
'Set the default progress bar styles
dwStyle = WS_CHILD Or WS_VISIBLE
'if vertical selected, make it so!
If Check1.Value = vbChecked Then
dwStyle = dwStyle Or PBS_VERTICAL
End If
'Create and show the status bar. Additional standard
'or extended window styles can be specified to alter the
'default appearance of the progress bar. The progress
'bar can also be easily created as a child window of a
'status bar part (VB "Panel"). Substitute the status bar's
'hWnd and a part's bounding rectangle (via SB_GETRECT) in
'CreateWindowEx()'s respective params below.
hProgBar = CreateWindowEx(0, PROGRESS_CLASS, _
vbNullString, _
dwStyle, _
0, 0, 0, 0, _
hwnd, 0, _
App.hInstance, _
ByVal 0)
If hProgBar = 0 Then MsgBox "CreateWindowEx failed.": Exit Sub
'Here we go... the progress bar's style can't
'be changed after its been created.
bRunning = True
Command1.Caption = "Stop"
Text1.Enabled = False
Check1.Enabled = False
'Set the progress bar's static x (or y) position
'so its initially 20 pixels wide (or high). The code
'in the form_resize event uses these values to position
'the progress bar
If Check1.Value = vbChecked Then
dwPBPosLeft = Me.ScaleWidth - 20
dwPBPosTop = 0
Else
dwPBPosTop = Me.ScaleHeight - 20
dwPBPosLeft = 0
End If
'MoveWindow() in the Form_Resize event will set the
'progress bar's initial position & size. It will also
'display the prog bar's current size in the label.
Call Form_Resize
'get the number of iterations entered into the textbox
dwIterations = Val(Text1.Text)
'set the range and step interval of the progress bar
dwRange = MAKELPARAM(0, dwIterations)
Call SendMessage(hProgBar, PBM_SETRANGE, 0&, ByVal dwRange)
Call SendMessage(hProgBar, PBM_SETSTEP, ByVal 1, 0&)
'Let's do some stuff...
For cnt = 1 To dwIterations
'call DoEvents to allow the loop to
'respond to a cancel (stop) command
DoEvents
If Not bRunning Then Exit For
'<your app-specific code goes here>
'advance the current position of the progress bar
'by the step increment.
Call SendMessage(hProgBar, PBM_STEPIT, 0&, ByVal 0&)
Label2.Caption = Int((cnt / dwIterations) * 100) & " %"
Next
progbar_exit:
'Free all resources associated with the progress bar.
'If not destroyed here, the progress bar will automatically
'be destroyed when the parent window - the window specified in
'hWndParent of CreateWindowEx() - is destroyed.
If IsWindow(hProgBar) Then Call DestroyWindow(hProgBar)
're-initialize form's controls
bRunning = False
Command1.Caption = "Create && Run ProgressBar..."
Text1.Enabled = True
Check1.Enabled = True
Label2.Caption = "n %"
End Sub
Private Function MAKELPARAM(wLow As Long, wHigh As Long) As Long
'Combines two integers into a long
MAKELPARAM = MAKELONG(wLow, wHigh)
End Function
Private Function MAKELONG(wLow As Long, wHigh As Long) As Long
MAKELONG = LoWord(wLow) Or (&H10000 * LoWord(wHigh))
End Function
Private Function LoWord(dwValue As Long) As Integer
CopyMemory LoWord, dwValue, 2
End Function
Private Function IsNewComctl32() As Boolean
'ensures that the Comctl32.dll library is loaded
Dim icc As tagINITCOMMONCONTROLSEX
On Error GoTo Err_InitOldVersion
icc.dwSize = Len(icc)
icc.dwICC = ICC_PROGRESS_CLASS
'VB will generate error 453 "Specified DLL function not found"
'here if the new version isn't installed
IsNewComctl32 = InitCommonControlsEx(icc)
Exit Function
Err_InitOldVersion:
InitCommonControls
End Function
حالا یه فایل project1.exe.manifest کنار برنامه تون بسازید و این ها رو توش بنویسید:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="CompanyName.ProductName.YourAppName"
type="win32" />
<description>Your application description here</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*" />
</dependentAssembly>
</dependency>
</assembly>
بعد برنامه تون رو Compile کنید و از روی فایل project1.exe اجراش کنید!
