Tipp 0077 StatusBar ohne OCX erstellen
Autor/Einsender:
Datum:
  Ronald Janowski
05.06.2001
Entwicklungsumgebung:   VB 6
Die VB-StatusBar ist eine interessante Komponente. Eine Alternative ist dieser Tipp, der aufzeigt, wie man ohne OCX mit nur einer PictureBox, ein paar Label und mit nur einer Funktion eine eigene StatusBar anlegt. Zusätzlich hält dieser Tipp noch ein paar schöne zusätzliche Beispiele parat, die auch mit einigen wenigen Handgriffen ins eigene Programm integriert werden können.
Hinweis
Das Beispielprojekt enthält noch einige gute Zusatzfunktionen
 
Option Explicit

Private Declare Function GetKeyState Lib "user32" (ByVal _
        nVirtKey As Long) As Integer

Dim i As Integer
Dim pCnt As Integer
Dim pFxd As Boolean
Dim unten As Boolean
Dim pNr As Integer
Dim pPxl As Long
Dim oben As Boolean
Dim ks

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case 145: nPanel(4).Caption = "         " & "Scroll-Taste": _
              Call kStatus(145)
    Case 144: nPanel(4).Caption = "         " & "Num-Taste": _
              Call kStatus(144)
    Case 19: nPanel(4).Caption = "         " & "Pause-Taste": _
              Call kStatus(19)
  End Select
End Sub

Private Function kStatus(kC As Integer)
  ks = GetKeyState(kC) + 128
  If ks = 1 Then
    imgLEDShow.Picture = imgLED(0).Picture
  ElseIf ks = 0 Then
    imgLEDShow.Picture = imgLED(1).Picture
  End If
End Function

Private Sub Form_Load()
  Call setBar(4, True, True, 1, 200)
End Sub

Public Function setBar(pCount As Integer, pBottom As Boolean, _
          pFixed As Boolean, pNumber As Integer, pPixel As Long)

  If pFixed = True Then
    If pNumber > pCount Then GoTo fehler:
  End If

  pCnt = pCount: pFxd = pFixed: pNr = pNumber: pPxl = pPixel

  Bar.Width = Me.Width

  If pBottom = True Then
    Bar.Top = Me.ScaleTop + Me.ScaleHeight - Bar.Height
    unten = True: oben = False
  Else
    Bar.Top = 0
    oben = True: unten = False
  End If

  For i = 1 To pCnt
    Load nPanel(i + 1)
    nPanel(i).Top = nPanel(1).Top
    If pFixed = True Then
      If i = pNumber Then
        nPanel(i).Width = pPixel * 15
      Else
        nPanel(i).Width = ((Bar.Width - 150) - (pPxl * 15)) \ _
              (pCount - 1)
      End If
    Else
      nPanel(i).Width = (Bar.Width - 150) \ pCount
    End If
    nPanel(i + 1).Left = (nPanel(i).Left + nPanel(i).Width) + 15
    nPanel(i).Visible = True
  Next i

  nPanel(1).Caption = " Fenstergröße : " & Me.Width \ 15 & _
            " x " & Me.Height \ 15
  nPanel(3).Caption = Format(Date, " dddd") & ", " & _
            Format(Date, "d mmmm yyyy")
  Exit Function

fehler:
  MsgBox "Überprüfen Sie die Parameter im Funktionsaufruf " & _
         """etBar (...)""" vbOKOnly, "Fehler !"
  Unload Me
End Function

Private Sub Form_Resize()

On Erro Resume Next
  Bar.Width = Me.Width
  If unten = True Then
    Bar.Top = Me.ScaleTop + Me.ScaleHeight - Bar.Height
  Else
    Bar.Top = 0
  End If

  For i = 1 To pCnt
    nPanel(i).Top = nPanel(1).Top
    If pFxd = True Then
      If i = pNr Then
        nPanel(i).Width = pPxl * 15
      Else
        nPanel(i).Width = ((Bar.Width - 150) - (pPxl * 15)) \ _
                  (pCnt - 1)
      End If
    Else
      nPanel(i).Width = (Bar.Width - 150) \ pCnt
    End If
    nPanel(i + 1).Left = (nPanel(i).Left + nPanel(i).Width) + 15
  Next i

  nPanel(1).Caption = " Fenstergröße : " & Me.Width \ 15 & _
            " x " & Me.Height \ 15 & " Pixel"
  imgLEDShow.Left = nPanel(4).Left
  nPanel(4).ZOrder 0

  lblEcke1(0).Left = ((Bar.Left + Bar.Width) - 140) - _
            lblEcke1(0).Width
  lblEcke1(1).Left = lblEcke1(0).Left
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private m_FrmWidth  As Long
Private m_FrmHeight As Long

Private Sub Form_Load()
  m_FrmWidth = Me.Width
  m_FrmHeight = Me.Height
End Sub

Private Sub cmdLimitWindowSize_Click()
  Dim lngMinHeight As Long
  Dim lngMinWidth  As Long
  Dim lngMaxHeight As Long
  Dim lngMaxWidth  As Long

  lngMinWidth = Val(txtMinWidth.Text)
  If lngMinWidth <= 0 Then
    lngMinWidth = m_FrmWidth
  End If

  lngMinHeight = Val(txtMinHeight.Text)
  If lngMinHeight <= 0 Then
    lngMinHeight = m_FrmHeight
  End If

  lngMaxWidth = Val(txtMaxWidth.Text)
  If lngMaxWidth <= 0 Then
    lngMaxWidth = Screen.Width / Screen.TwipsPerPixelX
  Else
    If lngMaxWidth < lngMinWidth Then
      lngMaxWidth = lngMinWidth
    End If
  End If

  lngMaxHeight = Val(txtMaxHeight.Text)
  If lngMaxHeight <= 0 Then
    lngMaxHeight = Screen.Height / Screen.TwipsPerPixelY
  Else
    If lngMaxHeight < lngMinHeight Then
      lngMaxHeight = lngMinHeight
    End If
  End If

  Call LimitWindowSize(Me, lngMinWidth, lngMinHeight, _
            lngMaxWidth, lngMaxHeight)
End Sub

Private Sub cmdReleaseWindowSize_Click()
  ReleaseWindowSize Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ReleaseWindowSize Me
End Sub
 
Weitere Links zum Thema
SplitterBar -1-

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (8,6 kB) Downloads bisher: [ 1887 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 28. August 2011