Guidance
指路人
g.yi.org
software / rapidq / Examples / Memory Process Thread Message / wshUsingWM SETTEXTMsgDemo / rqStatusMsgProgBar.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
' rq Status / ProgressBar Helper Utility for wsh scripters, jw 19Aug00
' author: jwarrington*NoSteekinSpam*@att.net

' --- for rapidq neophites: ----------------------
' RapidQ is a ONE-PASS compiler.
'   This makes need for some unusual programming behavior.
'   Specifically: YOU MUST DEFINE EVERYTHING BEFORE YOU USE IT.
'   This may require a bit of ingenuity, but then
'   that's all part of the challenge...
' --- end of neophite comments -------------------

' --- Discussion ---------------------------------
' This program is intended to serve as a Status Message / Progress Bar
'   Helper Utility for wsh script writers, (a capability lacking in the
'   wsh language).  It would be nice if RapidQ supported ActiveX server
'   capabilities, but (alas!) it doesn't.  Not to worry.  There are a
'   number of inter-process communication techniques that can be used,
'   in spite of Windows pronounced lack of enthusiasm for allowing separate
'   processes to "interfere" with one another.  In this case, we are using
'   WM_SETTEXT which works very well indeed across process boundaries,
'   thank you very much...
'
' In brief, this program is a "server" program, designed to act as a
'   graphical interface ("gooey") by the "client" script (that is, the
'   script using this utility to display its status messages and pct
'   complete).  This program shows a form which contains a textbox
'   (child) window, which is used for "in-coming" messages posted by
'   the client script, telling the program what to do.  The list of
'   possibilities is endless, however, at present the program only
'   responds to status messages and pct complete messages (plus "ping"
'   and "quit")...
'
' There is no backwards communication (although it is entirely possible
'   by posting messages to an "out-going window", and having the script
'   read them).  This program will clear the in-coming message window
'   after it receives a message, and (hopefully) that is enough to assure
'   the client script that all is well.  There is a "cancel" button on
'   the form, and if the user clicks it, this app will close.  The client
'   script is expected to check for a valid window handle before writing
'   this window, and if a valid handle is not found, then the client script
'   is expected NOT to write to the window, and further to assume that this
'   program has been closed.  The client can then do whatever it wants
'   (either continue on anyway, or take this closed window to imply that
'   the user doesn't wish to continue, (in effect by closing this dialog
'   the user can terminate the underlying or client script).
'
' The messages are responded to as follows...
'   "ping": the message is read and the txtbox cleared.
'             (used by the "client" to determine if we are alive).
'   "quit": the message is read, and this app exits immediately.
'   "xx% complete": the progress bar is advanced.
'   all other messages received are considered as ordinary
'             "status messages", and simply displayed in a rolling
'             (i.e., scrollable) window (a listbox).
' --- end of discussion --------------------------

     $INCLUDE "RAPIDQ.INC"
     $TYPECHECK ON

     CONST sExeName = "RQSTATUSMSGPROGBAR.EXE"
     CONST WM_VSCROLL = &H115
     CONST SB_BOTTOM = 7


  ' create the form, and populate it,
  '   (with status message diaplay area, progressbar, cancel button,
  '   and "inter-process communicator" i.e., a txtBox)

     CREATE frmTest AS QFORM
      Width = 400 : Height = 210
      CAPTION = "< rq StatusMessage / ProgressBar Helper Utility >"
    ' ShowMessage "my path: " & Command$(0)
      delBorderIcons(biMinimize) : delBorderIcons(biMaximize)
      Center

      CREATE lblStatusMsg AS QLABEL
       Left = 20 : Top = 5 : Width = 300 : Height = 15
       CAPTION = "Status Messages"
      END CREATE

      CREATE lstStatusMsg AS QLISTBOX
       Left = 20 : Top = 20 : Width = 350 : Height = 70
        ' AddItems "Status Message Window"  ' (don't need this)
      END CREATE

      CREATE lblProgBar AS QLABEL
       Left = 30 : Top = 95 : Width = 290 : Height = 20
       CAPTION = "Script Progress"
      END CREATE

      CREATE progressBar AS QGAUGE
       Left = 30 : Top = 110 : Width = 330 : Height = 20
       ForeColor = clBlue  ' (blue bar)
      END CREATE

      CREATE cmdCancel AS QBUTTON
       Left = 150 : Top = 145 : Width = 100 : Height = 25
       CAPTION = "Cancel"
      END CREATE

    ' need txtBox to be visible, otherwise rq doesn't instantiate it(?)
    '   so, we'll just hide it by moving it out of client area (tricky)...
      CREATE txtBox AS QEDIT
       Left = -130 : Top = 150 : Width = 100  ' std height
      ' don't need any text to find this window,
      '   (it's the only qedit window)...
      ' Text = "ChildTextWindow"
      ' OnChange = txtBox_onChange (put in later)
      ' Visible = False (this doesn't work, hide by moving offscreen)
      END CREATE  ' txtBox

     END CREATE  ' frmTest

     SUB txtBox_onChange
      DIM sText AS STRING, ucMsg AS STRING
      DIM iPct AS INTEGER, sPct AS STRING, nPct AS INTEGER

      sText = txtBox.Text  ' retrieve the text
    ' if you're going to clear the txtbox, then you haf'ta
    '   turn off the event handler while you do (clear the box)...
    ' for now, just ignore a change to blank (assume it's you clearing the box)
      IF sText = ""  THEN  EXIT SUB
    ' SHOWMESSAGE "Found String: " & sText

    ' figure out what to do with the message
      ucMsg = UCASE$(sText)
    ' lstStatusMsg.AddItems "ucMsg is: " & ucMsg  '  debug msg...
      iPct = INSTR(ucMsg, "% COMPLETE")
    ' lstStatusMsg.AddItems "iPct is: " & Str$(iPct)  '  debug msg...

      IF ucMsg = "PING" THEN
       txtBox.Text = ""  ' clear the txtbox...
      ELSEIF ucMsg = "QUIT" THEN
       Application.Terminate
      ELSEIF IF iPct > 0  THEN
       sPct = MID$(ucMsg, iPct-3, 3)
      ' lstStatusMsg.AddItems "pct string: [" & sPct & "] "  ' for debugging
       nPct = VAL(sPct)  ' convert text to number
       IF nPct >= 0 AND nPct <= 100  THEN
        progressBar.Position = nPct  ' advance progressbar...
       END IF
       txtBox.Text = ""  ' clear the txtbox...
      ELSE  ' none of the above, treat as status msg
       lstStatusMsg.AddItems sText  ' post to StatusMsg box...
      ' uh oh. little problem here, rapidq won't scroll down the listbox so that
      '   the last message shows, and there's built-in no method to get it to scroll.
      '   So, we'll have to take matters into our own hands...
       SENDMESSAGE(lstStatusMsg.Handle, WM_VSCROLL, SB_BOTTOM, 0)
       txtBox.Text = ""  ' clear the txtbox...
      END IF
     END SUB

     SUB cmdCancel_Click
      Application.Terminate
     END SUB

' ================================================
' === MAIN PROGRAM ===============================
' ================================================
     DIM sIconPath AS STRING

  ' some initializations that couldn't be made above,
  '   (due to ONE-PASS nature of rapidq)...
     txtBox.OnChange = txtBox_onChange  ' set event handlers
     cmdCancel.OnClick = cmdCancel_Click

  ' Command$(0) contains the path to this exe, replace exe name w/ico name
     sIconPath = REPLACESUBSTR$(COMMAND$(0), sExeName, "RapidQ.ico")
  ' ShowMessage sIconPath
     frmTest.Icon = sIconPath  ' use rapidq icon on form



     frmTest.SHOWMODAL
     Application.Terminate

' --- end of this program ------------------------
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Thu 2026-6-25  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2000-08-21 19:21:20