Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Kolorowy StatusBar - może komuś się przyda
Tamgo




Typ: neutral
Postów: 129
Zarejestrowany: Aug 2004
Kolorowy StatusBar - może komuś się przyda

Znaleziony na Planet Source Code, mam nadzieję, że ewentualne błądy w tłumaczeniu są wybaczalne.
'Windows API/ Deklaracja Global:

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type

' Nazwa: Pasek stanu z 3 panelami
 
' opis: Ta procedura rysuje gruntownie pasek
'    stanu poprzez wywołanie formy frmmain, przy pomocy
'    zaprogramowanych zmian koloru light,
'    medium i dark .
'    Jedynym powodem, by zastosować taką procedurę
'    jest żałosny brak w całym VB właściwości
'    backcolor dla statusbar, stąd konieczność stosowania
'    w drugim planie kontrolki obrazka, jako tła. 
'    Ten statusbar ma 3 panele, które automatycznie
'    zmieniają wielkość kiedy forma zmienia wielkość.

' Dane wejścioweptional String1,
' Optional String2, Optional String3
'
' Działanie: Rysowanie na formie w picturebox.
'   
' Założenia: Wymagane  wywołanie formy frmMain
'    wraz z kontrolką picturebox dla wywołania
'    picStatusbar. Scalemode dla obu obrazków
'    picStatusbar należy ustawić na piksele,
'    kontrolka powinna mieć ustawienia na Flat, a nie Border.
'    Wywołuj ten podprogram w procedurze
'    dla frmmain_resize  kiedy tylko zechcesz
'    zmienić tekst w panelach.
'**************************************

Friend Sub RefreshStatus(Optional s1 As String, Optional s2 As String, Optional s3 As String)
On Error Resume Next
Dim w As Long, h As Long, i As Long
Dim MaxWidth(1 To 3) As Long
Dim r(1 To 3) As RECT
Static s(1 To 3) As String
Static t(1 To 3) As String
Static StatusBarLight As Long
Static StatusBarMedium As Long
Static StatusBarDark As Long
Static Initialized As Boolean
Static TextTop As Long
Static p As Double

If Initialized = False Then
    'ustawione kolory - tylko pierwszy raz
    StatusBarLight = RGB(167, 185, 209)
    StatusBarMedium = RGB(105, 131, 156)
    StatusBarDark = RGB(43, 66, 92)
    p = 0.25 'jak długo pierwszy i trzeci panel statusu są porównywane do szerokości ekranu
    TextTop = 6
    frmMain.picStatusBar.BackColor = StatusBarMedium
    frmMain.picStatusBar.ForeColor = StatusBarDark
    frmMain.ScaleMode = 3
    frmMain.picStatusBar.ScaleMode = 3
    frmMain.picStatusBar.AutoRedraw = True
    Initialized = True
End If
' przesunięcie statusbaru
With frmMain.picStatusBar
    'przesuń pasek stanu do końca
    .Move 0, frmMain.ScaleHeight - .Height, frmMain.ScaleWidth, 25
    ' pobierz szerokość i wysokość
    w = frmMain.picStatusBar.ScaleWidth
    h = frmMain.picStatusBar.ScaleHeight
    ' Ustaw wielkość prostokątów
    r(1).Top = 2: r(2).Top = 2: r(3).Top = 2
    r(1).Bottom = 22: r(2).Bottom = 22: r(3).Bottom = 22
    r(1).Left = 2: r(1).Right = (w * p) - 1
    r(3).Left = w - (r(1).Right - r(1).Left) - 2: r(3).Right = w - 3
    r(2).Left = r(1).Right + 3: r(2).Right = r(3).Left - 3
    ' Modyfikuj łańcuchy tekstowe

    If Len(s1) > 0 Then
        s(1) = s1
    End If


    If Len(s2) > 0 Then
        s(2) = s2
    End If


    If Len(s3) > 0 Then
        s(3) = s3
    End If
    ' Przytnij koniecznie część łańcucha tekstowego, by dopasować do obszaru okienka
   
    For i = 1 To 3
        MaxWidth(i) = r(i).Right - r(i).Left - 4
        t(i) = s(i)

        If .TextWidth(s(i)) > MaxWidth(i) Then

            Do
                t(i) = Left$(t(i), Len(t(i)) - 1)

                If .TextWidth(t(i)) <= MaxWidth(i) Then
                    Exit Do
                End If
            Loop
        End If
    Next i

    ' przenieś wszystkie 3 przycięte fragmenty tekstu
    .Cls

    For i = 1 To 3
        .CurrentX = r(i).Left + 2: .CurrentY = TextTop: frmMain.picStatusBar.Print t(i)
    Next i

End With

For i = 1 To 3
    ' określ pozycję okienk

    With r(i)
        frmMain.picStatusBar.Line (.Left, .Top)-(.Right, .Top), StatusBarDark
        frmMain.picStatusBar.Line (.Left, .Top)-(.Left, .Bottom), StatusBarDark
        frmMain.picStatusBar.Line (.Left, .Bottom)-(.Right, .Bottom), StatusBarLight
        frmMain.picStatusBar.Line (.Right, .Top + 1)-(.Right, .Bottom + 1), StatusBarLight
    End With

Next i

End Sub


08-03-2005 18:03
Pokaż profil Tamgo  Wyślij email do Tamgo        4484571
Wszystkich odpowiedzi: 0 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1