Logo Foltyn Presentation
Table of Contents Previous Page Next Page
Content-Symbol-Img
Ein Programm in der Programmiersprache A program in the programming language
vbScript
für die Darstellung eines Fortschritt-Balkens in vbScript for the display of a progress-bar in vbScript

ein Fortschrittsbalken ist nicht vorgesehen in vbScript, aber auf diese Weise kann es gemacht werden.

a progress-bar is not foreseen in vbScript, but this way it can be made.

Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist
The program ist tested before publication, but there can be given no guarantee, that it is free of errors
25. Feb. 2016 Feb 25th 2016

This progress-bar-window is generated by the program

' Progress-Bar

Option Explicit

Dim ScreenWidth, ScreenHeight, Title_ProgressDisplay, ProgressBarWidth, ProgressBarHeight

Dim objIE ' objExplorer needy for Function "ProgressDisplay"

GetMonitorProperties

Title_ProgressDisplay = "Progress-Bar"
ProgressBarWidth = 400
ProgressBarHeight = 150

' Program

Main

' End of Program

' Procedures

Sub Main: Dim Progress
    ProgressDisplay "Open",""
    For Progress = 0 To 100 ' Get Progress from program
        ShowProgress(Progress)
        WScript.Sleep 20
    Next:   ProgressDisplay "Close",""
            MsgBox "Job done"
End Sub

Sub ShowProgress(Progress0to100): Dim Text, k: k = (ProgressBarWidth - 2*19-21)
        Text = "<p align=""center"">Progress " & CStr(Progress0to100) & " %</p>" & _
            "<table border=""0"" cellpadding=""0"" cellspacing=""0""><tr><td width=""" & _
            CStr(k*Progress0to100/100) & _
            """ height=""15"" bgcolor=""#0000FF"">&nbsp;</td></tr></table>"
        ProgressDisplay "Display",Text: WScript.Sleep 20
End Sub

Sub ProgressDisplay (Mode, AnyText): Dim String1, String2, colItems, objItem
    ' Mode = Open, Display, Close
    ' AnyText only used in Display-Mode
    Mode = UCase(Left(Mode,1)) & LCase(Right(Mode,Len(Mode)-1))
    Select Case Mode
        Case "Open"
            Set objIE = CreateObject("InternetExplorer.Application")
            With objIE
                .Navigate "about:blank"
                .ToolBar = False: .StatusBar = False
                .Width = ProgressBarWidth: .Height = ProgressBarHeight
                .Left = (ScreenWidth - ProgressBarWidth) \ 2
                .Top = (ScreenHeight - ProgressBarHeight) \ 2
                .Visible = True
                With .Document
                    .title = Title_ProgressDisplay
                    .ParentWindow.focus()
                    With .Body.Style
                        .backgroundcolor = "#F0F7FE"
                        .color = "#0060FF"
                        .Font = "11pt 'Calibri'"
                    End With
                End With: While .Busy: Wend
            End With
        Case "Display"
            On Error Resume Next ' for clicking away the bar while running
            If Err.Number = 0 Then
                With objIE.Document
                    .Body.InnerHTML = AnyText: WScript.Sleep 200: .ParentWindow.focus()
                End With
            End If
        Case "Close": WScript.Sleep 100: objIE.Quit
    End Select
End Sub

Sub GetMonitorProperties
    Dim strComputer, objWMIService, objItem, colItems, VMD: strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_VideoController")
    For Each objItem In colItems: VMD = objItem.VideoModeDescription: Next
    ' VMD = 1280 x 1024 x 4294967296 Farben
    VMD = Split(VMD, " x "): ScreenWidth = Eval(VMD(0)): ScreenHeight = Eval(VMD(1))
End Sub

' End of Procedures