volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1876 Wohnort: D59192
|
Verfasst am: 23.07.2007, 01:24 Titel: |
|
|
Doch ist alles vorhanden!!
Code: | ' ProgressBar Demo , 10.02.2006 by Volta
'Option Explicit
#include once "windows.bi"
#include once "win/commctrl.bi"
Declare Function WndProc ( Byval hWnd As HWND, Byval uMsg As UINT, _
Byval wParam As WPARAM, Byval lParam As LPARAM ) As Integer
Dim Shared hInstance As HINSTANCE
hInstance = GetModuleHandle( null )
' Main
Dim wMsg As MSG
Dim wcls As WNDCLASS
Dim hWnd As HWND
Dim Shared hProgressBar As HWND 'ProgressBar object handle
Dim appName As String
appName = "VoltaProgressBarDemo"
With wcls
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon( null, IDI_APPLICATION )
.hCursor = LoadCursor( null, IDC_ARROW )
.hbrBackground = Cptr( HGDIOBJ, COLOR_BACKGROUND )
.lpszMenuName = null
.lpszClassName = Strptr( appName )
End With
If ( RegisterClass( @wcls ) = false ) Then
MessageBox( null, "Fehler bei der Registrierung der WindowClass!", _
appName, MB_ICONERROR )
End 1
End If
hWnd = CreateWindowEx( 0, appName, "ProgressBar Demo ( <- Taste -> )", _
WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
CW_USEDEFAULT, CW_USEDEFAULT, 440, 100, _
null, null, hInstance, null )
'messages loop
Do Until( GetMessage( @wMsg, null, 0, 0 ) = FALSE )
TranslateMessage( @wMsg )
DispatchMessage ( @wMsg )
Loop
End 0
' Window Procedure Handler
Function WndProc ( Byval hWnd As HWND, Byval uMsg As UINT, _
Byval wParam As WPARAM, Byval lParam As LPARAM ) As Integer
Static As Integer ipos, a=1
Select Case ( uMsg )
Case WM_CREATE
InitCommonControls() 'initialisiere common controls
'erstellt ProgressBar
hProgressBar = CreateWindowEx(0,PROGRESS_CLASS, "ProgressBar", _
WS_CHILD Or WS_VISIBLE Or PBS_SMOOTH ,_ '
20, 30, 400, 16, _
hWnd, null, hInstance, null )
Return 0
Case WM_KEYDOWN
If( Lobyte( wParam ) = 27 ) Then
PostMessage( hWnd, WM_CLOSE, 0, 0 )
Else
ipos +=a
SendMessage hProgressBar, PBM_SETPOS, ipos, 0
If ipos=0 Or ipos=99 Then a=-a
End If
Return 0
Case WM_DESTROY
DestroyWindow hProgressBar 'Destroy hProgressBar
PostQuitMessage( 0 )
Exit Function
End Select
Function = DefWindowProc( hWnd, uMsg, wParam, lParam )
End Function |
_________________ Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|