Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Windows GUI

TrackBar (Slider)

Lizenz:Erster Autor:Letzte Bearbeitung:
LGPLRedakteurVolta 15.08.2007

Ich hoffe der Quellcode erkärt sich von selbst ;)
Der mit dem Slider eingestellte Wert wird in der globalen Variable track_pos gespeichert, für das Demo lasse ich ihn im Tooltip anzeigen.

' TrackBar Demo , code by Volta

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

'Program Main
Dim wMsg As MSG
Dim wcls As WNDCLASS
Dim hWnd As HWND
'TrackBar object handle
Dim Shared As HWND hTrackBar
Dim Shared As Integer track_pos

Dim appName As String
appName = "VoltasTrackBarDemo"

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, "Voltas TrackBar Demo", _
                      WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
                      CW_USEDEFAULT, CW_USEDEFAULT, 440, 100, _
                      null, null, hInstance, null )

Do Until( GetMessage( @wMsg, null, 0, 0 ) = FALSE ) 'messages loop
  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

  Select Case ( uMsg )
  Case WM_CREATE
    InitCommonControls 'initialisiere common controls
    'erstellt TrackBar
    hTrackBar = CreateWindowEx(0, TRACKBAR_CLASS, "Trackbar", _
               WS_CHILD Or WS_VISIBLE Or TBS_HORZ Or TBS_TOP Or TBS_AUTOTICKS _
               Or TBS_TOOLTIPS, 20, 20, 400, 40, hWnd, null, hInstance, null )
    SendMessage hTrackBar, TBM_SETRANGE, 1, makelong(0, 200) 'MAKELONG(Min, Max)
    SendMessage hTrackBar, TBM_SETTICFREQ, 10,0
    Return 0

  Case WM_HSCROLL
    If lParam = hTrackBar Then 'ist das die Trackbar?
      track_pos = SendMessage (hTrackBar, TBM_GETPOS,0,0)
    End If
    'Return 0

  Case WM_KEYDOWN
    If( Lobyte( wParam ) = 27 ) Then
      PostMessage( hWnd, WM_CLOSE, 0, 0 )
    End If
    Return 0

  Case WM_DESTROY
    DestroyWindow hTrackBar 'Destroy hTrackBar
    PostQuitMessage( 0 )
    Exit Function
  End Select

  Function = DefWindowProc( hWnd, uMsg, wParam, lParam )
End Function

Viel Spaß damit
Volta


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 15.08.2007 von RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 15.08.2007 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen