Welcome guest. Before posting on our computer help forum, you must register. Click here it's easy and free.

Author Topic: Auto Center Vbs Window  (Read 5040 times)

0 Members and 1 Guest are viewing this topic.

alanbr00

    Topic Starter


    Starter

    • Experience: Beginner
    • OS: Windows 10
    Auto Center Vbs Window
    « on: September 14, 2019, 11:18:09 AM »
    Hello to all,

    sorry if i post in wrong section.
    This is script does what i need, i'm just need to know how to do "window auto center", "get the message in the center of the box" and put a "countdown", in this script.

    Thanks for any help.

    Code: [Select]
    with HTABox("DodgerBlue", 100, 300, 0, 0)
      .document.title = "Atualizando Sistema"
      .msg.innerHTML = "<font color=red><b>ATUALIZANDO SISTEMA, AGUARDE.<b></font>"
      Timeout = 60000 ' milliseconds
      do until .done.value or (n > TimeOut): wsh.sleep 50 : n=n+50 : loop
      .done.value = true
      .close
    end with

    ' Author Tom Lavedas, June 2010
    Function HTABox(sBgColor, h, w, l, t)
    Dim IE, HTA

      randomize : nRnd = Int(1000000 * rnd)
      sCmd = "mshta.exe ""javascript:{new " _
           & "ActiveXObject(""InternetExplorer.Application"")" _
           & ".PutProperty('" & nRnd & "',window);" _
           & "window.resizeTo(" & 500 & "," & 500 & ");" _
           & "window.moveTo(" & l & "," & t & ")}"""

      with CreateObject("WScript.Shell")
        .Run sCmd, 1, False
        do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
      end with ' WSHShell

      For Each IE In CreateObject("Shell.Application").windows
        If IsObject(IE.GetProperty(nRnd)) Then
          set HTABox = IE.GetProperty(nRnd)
          IE.Quit
          HTABox.document.title = "HTABox"
          HTABox.document.write _
                   "<HTA:Application contextMenu=no border=thin " _
                 & "minimizebutton=no maximizebutton=no sysmenu=no />" _
                 & "<body scroll=no style='background-color:" _
                 & sBgColor & ";font:normal 14pt Arial Black;" _
                 & "border-Style:outset;border-Width:10px'" _
                 & "onbeforeunload='vbscript:if not done.value then " _
                 & "window.event.cancelBubble=true:" _
                 & "window.event.returnValue=false:" _
                 & "done.value=true:end if'>" _
                 & "<input type=hidden id=done value=false>" _
                 & "<center><span id=msg>&nbsp;</span><center></body>"
          Exit Function
        End If
      Next

    ' I can't imagine how this line can be reached, but just in case
      MsgBox "HTA window not found."
      wsh.quit

    End Function

    Hackoo



      Hopeful
    • Thanked: 42
    • Experience: Expert
    • OS: Windows 10
    Re: Auto Center Vbs Window
    « Reply #1 on: September 17, 2019, 11:23:11 AM »
    Just give a try for this code with countdown :
    Code: [Select]
    with HTABox("DodgerBlue", 100, 100, 500, 300)
    .document.title = "Atualizando Sistema"
    nMinutes = 01
    nSeconds = 00
    do until (nMinutes + nSeconds < 1)
    .msg.innerHTML = "<font color=red><b>ATUALIZANDO SISTEMA, AGUARDE.<b><br>" &_
    Right("0"&nMinutes,2) & ":" & Right("0"&nSeconds, 2)&"</b></font><br>"
    Wait 1
    nSeconds = nSeconds - 1
    if nSeconds < 0 then
    if nMinutes > 0 then
    nMinutes = nMinutes - 1
    nSeconds = 59
    end if
    end if
    Loop
    .done.value = true
    .close
    end with
    '********************************************************************************************
    Sub Wait(Seconds)
    Dim ws
    Set ws = CreateObject ("WScript.Shell")
    ws.Run "Cmd /c Timeout /T " & Seconds & " /nobreak", 0, True
    End Sub
    '********************************************************************************************
    ' Author Tom Lavedas, June 2010
    Function HTABox(sBgColor, h, w, l, t)
    Dim IE, HTA
    randomize : nRnd = Int(1000000 * rnd)
    sCmd = "mshta.exe ""javascript:{new " _
    & "ActiveXObject(""InternetExplorer.Application"")" _
    & ".PutProperty('" & nRnd & "',window);" _
    & "window.resizeTo(" & 450 & "," & 130 & ");" _
    & "window.moveTo(" & l & "," & t & ")}"""

    with CreateObject("WScript.Shell")
    .Run sCmd, 1, False
    do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
    end with ' WSHShell

    For Each IE In CreateObject("Shell.Application").windows
    If IsObject(IE.GetProperty(nRnd)) Then
    set HTABox = IE.GetProperty(nRnd)
    IE.Quit
    HTABox.document.title = "HTABox"
    HTABox.document.write _
    "<HTA:Application contextMenu=no border=thin " _
    & "minimizebutton=no maximizebutton=no sysmenu=no />" _
    & "<body scroll=no style='background-color:" _
    & sBgColor & ";font:normal 14pt Arial Black;" _
    & "border-Style:outset;border-Width:10px'" _
    & "onbeforeunload='vbscript:if not done.value then " _
    & "window.event.cancelBubble=true:" _
    & "window.event.returnValue=false:" _
    & "done.value=true:end if'>" _
    & "<input type=hidden id=done value=false>" _
    & "<center><span id=msg>&nbsp;</span><center></body>"
    Exit Function
    End If
    Next
    ' I can't imagine how this line can be reached, but just in case
    MsgBox "HTA window not found."
    wsh.quit
    End Function

    Hackoo



      Hopeful
    • Thanked: 42
    • Experience: Expert
    • OS: Windows 10
    Re: Auto Center Vbs Window
    « Reply #2 on: September 17, 2019, 10:25:43 PM »
    Here is another code but you should execute it as HTA file not as VBS file :
    So, just copy and paste this code as name Countdown.hta
    Code: [Select]
    <HTML>
    <HEAD>
    <Title>ATUALIZANDO SISTEMA, AGUARDE ...</Title>
    <HTA:APPLICATION
    ICON = "magnify.exe"
    BORDER="THIN"
    INNERBORDER="NO"
    MAXIMIZEBUTTON="NO"
    MINIMIZEBUTTON="NO"
    SCROLL="NO"
    SYSMENU="NO"
    SELECTION="NO"
    SINGLEINSTANCE="YES">
    </HEAD>
    <BODY text="Red"><CENTER>
    <b><marquee DIRECTION="LEFT" SCROLLAMOUNT="3" BEHAVIOR=ALTERNATE><font color="red" face="Tahoma">ATUALIZANDO SISTEMA, AGUARDE ... </font></marquee></b>
    <b><span id="countdown"></span></b>
    <img src="data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA" />
    </CENTER></BODY>
    </HTML>
    <SCRIPT LANGUAGE="VBScript">
    Set ws = CreateObject("wscript.Shell")
    Sub window_onload()
        CenterWindow 400,120
        Self.document.bgColor = "DodgerBlue"
    Call CountDownToClose(01,00) '1 minute countdown
     End Sub
    '--------------------------------------------------------------------
     Sub CenterWindow(x,y)
        Dim iLeft,itop
        window.resizeTo x,y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft,itop
    End Sub
    '--------------------------------------------------------------------
    Sub CountDownToClose(nMinutes,nSeconds)
    do until (nMinutes + nSeconds < 1)
    countdown.innerHTML = Right("0"&nMinutes,2) & ":" & Right("0"&nSeconds, 2)&"<br>"
    Wait 1
    nSeconds = nSeconds - 1
    if nSeconds < 0 then
    if nMinutes > 0 then
    nMinutes = nMinutes - 1
    nSeconds = 59
    end if
    end if
    Loop
    Self.close
    End Sub
    '--------------------------------------------------------------------
    Sub Wait(Seconds)
    Dim ws
    Set ws = CreateObject ("WScript.Shell")
    ws.Run "Cmd /c Timeout /T " & Seconds & " /nobreak", 0, True
    End Sub
    '--------------------------------------------------------------------
    </script>