Mit dem heutigen Extra-Tipp möchten wir Ihnen zeigen, dass es mit den VB6-Bordmitteln ohne Weiteres möglich ist, eine ProgressBar im XP-Style zu erzeugen. Und das alles ohne API Calls und ohne UserDrawing - als reine VB6 Klasse. Alles was wir dazu benötigen, ist das nachfolgende VB6 Klassenmodul und ein Shape auf der Form, das uns als Container für die ProgressBar dient. Die Klasse selber stellt uns dabei die vier XP-Farbschemas XPGreen, XPBlue, XPOlive und XPSilver zur Verfügung. Die ProgressBar kann entweder im Block- oder Smooth-Style angezeigt werden. Optional können Sie in der ProgressBar noch den prozentualen Fortschritt einblenden lassen. Das Ereignis "Progress" feuert zusätzlich noch den Fortschritt der ProgressBar in die aufrufende Form zurück. Doch nun zu unserer Klasse. Erstellen Sie ein neues Klassenmodul und nennen Sie es clsXPProgBar. ' ********************************************************************** ' * ' * XP Style ProgressBar Marke Eigenbau (VB6 Klasse) ' * ' * Das nachfolgende Klassenmodul generiert aus einem übergebenen ' * Shape eine XP-Progressbar. Es werden vier Color-Styles ' * in den XP-Farben Grün, Blau, Olive und Silber zur Verfügung ' * gestellt. Optional kann eine prozentuale Fortschrittsanzeige ' * eingeblendet werden. Weiterhin kann die Anzeige als Block oder ' * Smooth erfolgen. Der Event "Progress" feuert den prozentualen ' * Fortschritt in die aufrufende Form zurück. ' * ' * September 2005 - VB-Power.net www.vb-power.net ' * ' ********************************************************************** Option Explicit Public Enum XPColorStyle XPGreen = &H79E671 XPBlue = &HE1A780 XPOlive = &H8CC0B1 XPSilver = &HB19395 End Enum Public Enum XPBarStyle Smooth = 1 Block = 3 End Enum Public Enum XPBackStyle Transparent = 0 Undurchsichtig = 1 End Enum Public Event Progress(lProzent As Long) Private cBackColor As OLE_COLOR Private cBackStyle As XPBackStyle Private cBarStyle As XPBarStyle Private cBorderColor As OLE_COLOR Private cColorStyle As OLE_COLOR Private cShape As VB.Shape Private tShape As VB.Shape Private cLabel As VB.Label Private cShowProzent As Boolean Private cMax As Long Private cValue As Long ' ========================================= ' Hauptroutine zum Erzeugen der ProgressBar ' ========================================= Public Sub InitBar(oForm As Form, oShape As Shape) If oForm Is Nothing Then Exit Sub If oShape Is Nothing Then Exit Sub Set cShape = oShape ' Dynamisches (zweites) Shape erzeugen Set tShape = oForm.Controls.Add("VB.Shape", _ "tmpShape" & Format(Int(1000000 * Rnd) + 1)) With tShape Set .Container = oShape.Container .BackColor = cColorStyle .BackStyle = 1 .BorderStyle = 0 .FillColor = cBackColor .FillStyle = cBarStyle .Shape = 0 .Move cShape.Left + (3 * Screen.TwipsPerPixelX), _ cShape.Top + (3 * Screen.TwipsPerPixelY), _ 0, cShape.Height - (5 * Screen.TwipsPerPixelY) .ZOrder .Visible = True End With ' Dynamisches Label für die prozentuale Anzeige erzeugen Set cLabel = oForm.Controls.Add("VB.Label", _ "tmpLabel" & Format(Int(1000000 * Rnd) + 1)) With cLabel Set .Container = oShape.Container .Alignment = 2 .AutoSize = True .BackStyle = 0 .BorderStyle = 0 .Caption = "0 %" .FontName = "Verdana" .FontSize = 8 .Move cShape.Left + (cShape.Width / 2), _ cShape.Top + (cShape.Height / 2) - (.Height / 2) .ZOrder .Visible = True End With With cShape .BackColor = cBackColor .BorderColor = cBorderColor .BackStyle = cBackStyle .Shape = 4 End With End Sub ' ========================================= ' Hauptroutine zum Zeichnen der ProgressBar ' ========================================= Private Sub DrawBar() Dim x As Long Dim p As Long On Error Resume Next x = ((cShape.Width - (6 * Screen.TwipsPerPixelX)) / cMax) * cValue If x > cShape.Width - (6 * Screen.TwipsPerPixelX) Then x = cShape.Width - (6 * Screen.TwipsPerPixelX) End If tShape.Width = x ' Progress berechnen und Event feuern p = Int(cValue / cMax * 100 + 0.5) If (p < 0) Then p = 0 If (p > 100) Then p = 100 RaiseEvent Progress(p) If cShowProzent Then cLabel.Caption = Format(p) & " %" End If End Sub ' ===================== ' Klasse initialisieren ' ===================== Private Sub Class_Initialize() cBackColor = vbWhite cBackStyle = Undurchsichtig cBarStyle = Block cBorderColor = &H808080 cColorStyle = XPGreen cMax = 100 cShowProzent = True cValue = 0 Randomize Timer End Sub ' ======================== ' Eigenschaften der Klasse ' ======================== Public Property Let BackColor(ByVal vData As OLE_COLOR) cBackColor = vData cShape.BackColor = cBackColor tShape.FillColor = cBackColor End Property Public Property Get BackColor() As OLE_COLOR BackColor = cBackColor End Property Public Property Let BackStyle(ByVal vData As XPBackStyle) cBackStyle = vData cShape.BackStyle = cBackStyle End Property Public Property Get BackStyle() As XPBackStyle BackStyle = cBackStyle End Property Public Property Let BarStyle(ByVal vData As XPBarStyle) cBarStyle = vData tShape.FillStyle = cBarStyle End Property Public Property Get BarStyle() As XPBarStyle BarStyle = cBarStyle End Property Public Property Let BorderColor(ByVal vData As OLE_COLOR) cBorderColor = vData cShape.BorderColor = cBorderColor End Property Public Property Get BorderColor() As OLE_COLOR BorderColor = cBorderColor End Property Public Property Let ColorStyle(ByVal vData As XPColorStyle) cColorStyle = vData tShape.BackColor = cColorStyle End Property Public Property Get ColorStyle() As XPColorStyle ColorStyle = cColorStyle End Property Public Property Let Max(ByVal vData As Long) cMax = vData End Property Public Property Get Max() As Long Max = cMax End Property Public Property Let ShowProzent(ByVal vData As Boolean) cShowProzent = vData cLabel.Visible = cShowProzent End Property Public Property Get ShowProzent() As Boolean ShowProzent = cShowProzent End Property Public Property Let Value(ByVal vData As Long) cValue = vData DrawBar End Property Public Property Get Value() As Long Value = cValue End Property Wie Sie nun die Klasse, also unsere ProgressBar nutzen können und welche Möglichkeiten es gibt, zeigen wir Ihnen in unserem Beispielprojekt. Viel Spaß mit der ProgressBar... |