msgsvc.prg

MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能

      lnMinWidth= toDialog.MinWidth- (7* toDialog.nHDBU)- .Left

      * Pick a reasonable widest maximum first Memowidth
      * 8 is the minimum memowidth in 3.0/5.0
      SET MEMOWIDTH TO MAX( 8, lnMaxWidth/ (FONTMETRIC( 6, .FontName, .FontSize)*0.85))

      DO WHILE .T.
        lnWidestLine= 0
        FOR lni= 1 TO MEMLINES( .Value)
          lnWidestLine= MAX( lnWidestLine, ;
                             TXTWIDTH( MLINE( .Value, lnI), ;
                                       .FontName, ;
                                       .FontSize)* FONTMETRIC(6, .FontName, .FontSize))

          IF lnWidestLine> lnMaxWidth
            SET MEMOWIDTH TO SET("MEMOWIDTH")- 1  && Slow
            EXIT
          ENDIF

          IF lnWidestLine< lnMinWidth
            * llDone= .T.
            * EXIT
            LOOP
          ENDIF
          llDone= .T.
          EXIT
        ENDFOR
        IF llDone OR lni > MEMLINES( .Value)
          EXIT
        ENDIF
      ENDDO

      .Width = MAX( toDialog.MinWidth, lnWidestLine+ .Margin+ 3)
      .Height= 18+ ( MAX( 2, MEMLINES( .VALUE))* (FONTMETRIC(1, .FontName, .FontSize)+ ;
                                        FONTMETRIC(5, .FontName, .FontSize)))

      *-- A final pass to adjust for the case of a single line
      IF MEMLINES( .VALUE)= 1
        .TOP= .TOP + 6 * toDialog.nVDBU
      ENDIF
      .Visible= .T.
      SET MEMOWIDTH to lnOldMemoWidth
    ENDWITH
  ENDIF

  *-- Position the therm bar
  IF TYPE("toDialog.oTherm")= "O"
    WITH toDialog.oTherm
      .Top= (4* toDialog.nVDBU)  && margin before buttons
      lnMaxHeight= 0
      FOR lni= 1 TO toDialog.ControlCount
        IF toDialog.Controls( lnI).Name= .Name
          LOOP
        ENDIF
        lnMaxHeight= MAX( lnMaxHeight, toDialog.Controls( lnI).Top + toDialog.Controls( lnI).Height)
      ENDFOR
      .Top= .Top + lnMaxHeight
      .Visible= .T.
    ENDWITH
  ENDIF

  *-- Position the buttons
  IF TYPE("toDialog.oButtons")= "O"
    WITH toDialog.oButtons
      .Top= (4* toDialog.nVDBU)  && margin before buttons
      lnMaxHeight= 0
      FOR lni= 1 TO toDialog.ControlCount
        IF toDialog.Controls( lnI).Name= .Name
          LOOP
        ENDIF
        lnMaxHeight= MAX( lnMaxHeight, toDialog.Controls( lnI).Top + toDialog.Controls( lnI).Height)
      ENDFOR
      .Top= .Top + lnMaxHeight
      .Visible= .T.
    ENDWITH
  ENDIF

  IF ISNULL( toDialog)
    RETURN
  ENDIF

  *  LOCAL lnI, lnMaxHeight, lnMaxWidth
  WITH toDialog
    *-- Size the dialog
    lnMaxHeight= .MinHeight
    lnMaxWidth = .MinWidth

    FOR lni= 1 TO toDialog.ControlCount
      lnMaxHeight= MAX( lnMaxHeight, .Controls( lnI).Top+  .Controls( lnI).Height)
      lnMaxWidth = MAX( lnMaxWidth,  .Controls( lnI).Left+ .Controls( lnI).Width)
    ENDFOR

    .Height= (7* .nVDBU)+ lnMaxHeight
    .Width = 2*(7* .nHDBU)+ lnMaxWidth

    *-- Final fine-tune of thermometer
    IF TYPE("toDialog.oTherm")= "O"
      .oTherm.Left= .Width/2 - .oTherm.Width/2
    ENDIF

    *-- Final fine-tune of buttons
    IF TYPE("toDialog.oButtons")= "O"
      .oButtons.Left= .Width/2 - .oButtons.Width/2
      .oButtons.Top= MAX( .oButtons.Top, .Height- (7* .nVDBU)- .oButtons.Height)
    ENDIF

    *-- Start the timer, if there's one
    IF TYPE("toDialog.oTimer")= "O"
      .oTimer.Enabled= .T.
    ENDIF


  ENDWITH

 *====================================
 *-- cGenericMsgBuilder::AddTitle(oo)
 *====================================
 *
  FUNCTION AddTitle( toDialog, toSpecPackage)
    LOCAL loMessageSpec
    loMessageSpec= toSpecPackage.GetItem("Message Spec")

    LOCAL lcTitle
    lcTitle= "loMessageSpec."+ THIS.cTitleProp

    IF TYPE( "&lcTitle") <> "U"
      lcTitle= ALLTRIM(&lcTitle)
      IF !EMPTY( lcTitle)
        *-- "\" means never a title, even in Windows
        IF ALLTRIM( lcTitle) == "\"
          RETURN
        ENDIF

        *-- Build the title, including error number...
        IF !EMPTY( lcTitle)
        
           *-- Macro expand the Codebook defined constant
           IF ("APPNAME_LOC" == ALLTRIM(UPPER(lcTitle)) )
              lcTitle = ALLTRIM( GetString( "APPNAME_LOC" , "appincl" ) )
           ENDIF
           
           toDialog.Caption = ALLTRIM( lcTitle)
        ENDIF
      ENDIF
    ENDIF

    LOCAL lcError
    lcError= "loMessageSpec."+ THIS.cErrorProp
    IF TYPE( "&lcError") <> "U"
      lcError= ALLTRIM(&lcError)
      IF !EMPTY( lcError)
        toDialog.Caption =  strippat( stripext( SYS(16,1)))+ [ Error No ]+ ;
                           ALLTRIM( lcError)+ ;
                           [ ]+ ;
                           toDialog.Caption
      ENDIF
    ENDIF


    *-- In Windows all boxes have titles...
    IF EMPTY( toDialog.Caption)
       toDialog.Caption=  strippat( stripext( SYS(16,1)))
    ENDIF

 *====================================
 *-- cGenericMsgBuilder::AddImage(oo)
 *====================================
 *
  FUNCTION AddImage( toDialog, toSpecPackage)
    LOCAL loMessageSpec
    loMessageSpec= toSpecPackage.GetItem( "Message spec")

    IF !EMPTY( loMessageSpec.cGuiVisual)
      toDialog.AddObject( "oImage", THIS.cImageClass, toSpecPackage)
    ENDIF

 *====================================
 *-- cGenericMsgBuilder::AddButtons(oo)
 *====================================
 *
  FUNCTION AddButtons( toDialog, toSpecPackage)
    toDialog.AddObject( "oButtons", THIS.cButtonClass, toSpecPackage)

 *====================================
 *-- cGenericMsgBuilder::AddTherm(oo)
 *====================================
 *
  FUNCTION AddTherm( toDialog, toSpecPackage)
    toDialog.AddObject( "oTherm", THIS.cThermClass, toSpecPackage)

 *====================================
 *-- cGenericMsgBuilder::Addtext(oo)
 *====================================
 *
  FUNCTION Addtext( toDialog, toSpecPackage)
    LOCAL loMessageSpec
    loMessageSpec= toSpecPackage.GetItem( "Message spec")

    toDialog.AddObject( "oText", THIS.cTextClass, toSpecPackage)
    toDialog.SetText( loMessageSpec.cOriginal)

 *====================================
 *-- cGenericMsgBuilder::Addtimer(oo)
 *====================================
 *
  FUNCTION AddTimer( toDialog, toSpecPackage)
    LOCAL loMessageSpec
    loMessageSpec= toSpecPackage.GetItem( "Message spec")
    *-- We might require a timer...
    IF VAL( loMessageSpec.cTimeout)> 0
      toDialog.AddObject( "oTimer", THIS.cTimerClass, toSpecPackage)
    ENDIF


 *====================================
 *-- cGenericMsgBuilder::PositionDialog(oo)
 *====================================
 * Set the apropriate focus, if appropriate.
   FUNCTION PositionDialog(toDialog, toSpecPackage)
     LOCAL loMessageSpec
     loMessageSpec= toSpecPackage.GetItem( "Message spec")
     IF !EMPTY( loMessageSpec.cRow) OR ;
       !EMPTY( loMessageSpec.cCol)

       toDialog.TOP= VAL( loMessageSpec.cRow)
       toDialog.Left= VAL( loMessageSpec.cCol)
       toDialog.AutoCenter= .F.
     ENDIF

 *====================================
 *-- cGenericMsgBuilder::SetButtonFocus(oo)
 *====================================
 * Set the apropriate focus.
 *
  FUNCTION SetButtonFocus(toDialog, toSpecPackage)
  LOCAL loMessageSpec
  loMessageSpec= toSpecPackage.GetItem( "Message spec")
  LOCAL lnTemp
  lnTemp= VAL( loMessageSpec.cObject)

  IF lnTemp > 0 AND ;
     TYPE( "toDialog.oButtons") = "O" AND ;
       toDialog.oButtons.ControlCount >= lnTemp

    toDialog.oButtons.Controls( lnTemp).SetFocus()
 ENDIF

 *====================================
 *-- cGenericMsgBuilder::SetReturnType(oo)
 *====================================
 *
  FUNCTION SetReturnType(toDialog, toSpecPackage)
  LOCAL loMessageSpec
  loMessageSpec= toSpecPackage.GetItem( "Message spec")
  DO CASE
  CASE TYPE( "loMessageSpec.cRetType") = "U"
  CASE EMPTY( loMessageSpec.cRetType)
  CASE loMessageSpec.cRetType= "C"
    toDialog.nReturnIndex= 1

  CASE loMessageSpec.cRetType= "N"
    toDialog.nReturnIndex= 2

  CASE loMessageSpec.cRetType= "L"
    toDialog.nReturnIndex= 3

  CASE loMessageSpec.cRetType= "M"
    toDialog.nReturnIndex= 4

  ENDCASE

ENDDEFINE

*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c D i a l o g B u i l d e r
* Version..: March 31 1996
* Assumes..: Image is to left of text
*            Buttons are below text
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cDialogBuilder AS cGenericMsgBuilder
 *====================================
 *-- cDialogBuilder::Build(oo)
 *====================================
  FUNCTION BUILD(toDialog, toSpecPackage)
    cGenericMsgBuilder::Build( @toDialog, @toSpecPackage)
    THIS.Arrange( @toDialog)
ENDDEFINE

*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c W o r k i n g D i a l o g B u i l d e r
* Version..: March 31 1996
* Assumes..: Image is to left of text
*            Buttons are below text
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cWorkingDialogBuilder AS cGenericMsgBuilder
  cFormClass  =  "cFrmWorkingMsgSvc"
  lButtons= .T.
  lText   = .T.

 *====================================
 *-- cWorkingDialogBuilder::Build(oo)
 *====================================
  FUNCTION BUILD(toDialog, toSpecPackage)
    cGenericMsgBuilder::Build( @toDialog, @toSpecPackage)
    THIS.Arrange( @toDialog)
ENDDEFINE


*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c T h e r m B u i l d e r
* Version..: March 31 1996
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cThermBuilder AS cGenericMsgBuilder
  cFormClass  =  "cFrmThermMsgSvc"
  lButtons= .T.
  lText   = .T.

 *====================================
 *-- cThermBuilder::Build(oo)
 *====================================
  FUNCTION BUILD(toDialog, toSpecPackage)
    cGenericMsgBuilder::Build( @toDialog, @toSpecPackage)
    LOCAL loMessageSpec, loCallParameters, lxSecondParameter
    loMessageSpec    = toSpecPackage.GetItem("Message Spec")
    loCallParameters = ToSpecPackage.GetItem("Call parameters")

    *-- Go through the call parameters, looking for Numerics
    LOCAL lni, lci, lxtest
    FOR lni= 1 TO loCallParameters.ItemCount
      lcI= STR( lni, 1)
      lxTest= loCallParameters.GetItem( "Parameter"+lcI)
      IF TYPE( "lxTest")= "N"
        toDialog.SetPercent( lxtest)
      ENDIF
      DO CASE
      CASE TYPE("lnText")<> "C"
      CASE AT( "NOBUTTON", UPPER( STRTRAN(lxTest," "))) > 0
        toDialog.oButtons.Visible= .F.
      CASE AT( "BUTTON", UPPER( STRTRAN(lxTest," "))) > 0
        toDialog.oButtons.Visible= .T.
        LOOP
      ENDCASE
    ENDFOR

    THIS.Arrange( @toDialog)

ENDDEFINE

*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c T i p B u i l d e r
* Version..: April 3 1996
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cTipBuilder AS cGenericMsgBuilder
  cFormClass  =  "cFrmTODMsgSvc"
  lButtons= .F.
  lText   = .F.
  lTitle  = .F.
  lImage  = .F.
  lTimer  = .F.
ENDDEFINE


*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c W a i t W i n d B u i l d e r
* Version..: April 3 1996
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cWaitWindBuilder AS cAbstractMsgBuilder
* Compatibility note: Schemes not supported anymore since DOS is, er, dead.
 *====================================
 *-- cWaitWindBuilder::Build(oo)
 *====================================
  FUNCTION Build( toDialog, toSpecPackage)
    cAbstractMsgBuilder::Build( @toDialog, @toSpecPackage)
    LOCAL llWaitWind, jlNoWait, llWorking, jcRetVal, jnWaitTime, loMessageSpec

    lcWaitTime   = []
    jnWaitTime   = 0
    loMessageSpec= toSpecPackage.GetItem("Message spec")

    IF [WAIT ] $ loMessageSpec.cFunction
       llWaitWind = .t.

       IF [NOWAIT] $ loMessageSpec.cFunction
          jlNowait = .T.
       ENDIF

       IF !EMPTY( loMessageSpec.cTimeOut)
          lcWaitTime =  loMessageSpec.cTimeOut
       ENDIF

       jnWaitTime = VAL( lcWaitTime)
       *-- We could have a WAIT/NOWAIT *and* a TIMEOUT
       *-- In this case, make the TIMEOUT prevail
       IF jnWaitTime > 0
          jlNowait = .f.
       ENDIF

    ENDIF

    IF ! EMPTY( loMessageSpec.cErrno)
        loMessageSpec.cOriginal = strippat( stripext( SYS(16,1))) + ;
                      [ Error No ] + ;
                     ALLTRIM( loMessageSpec.cerrno) + ;
                     [ ] + ;
                     loMessageSpec.cOriginal
    ENDIF
    IF jnWaitTime > 0
      THIS.waitwind( loMessageSpec.cOriginal, jnWaitTime)
    ELSE
      THIS.waitwind( loMessageSpec.cOriginal, jlNowait)
    ENDIF
   jcRetVal = []


 *====================================
 *-- cWaitWindBuilder::WaitWind(cx)
 *====================================
  FUNCTION WaitWind( tcPhrase, txwaiting)
    *  Parameter List....: tcPhrase  - What goes in the WAIT window
    *                      txWaiting - Numeric = TIMEOUT
    *                                  .T.= Wait, .F. = NoWait

    *-- you only need to pass the first one...

    PRIVATE ;
       jcAnswerVal, ;
       jcWaitType, ;
       jlWaiting, ;
       jnWaiting

    jnWaiting  = 0
    jlWaiting  = .F.
    jcWaitType = TYPE( "txWaiting")

    DO CASE
    CASE jcWaitType = "N"
       jnWaiting = txwaiting
    CASE jcWaitType = "L"
       jlWaiting = ! txwaiting
    ENDCASE

    jcAnswerVal= []
    jcPosition = []    && Roughed-in for the next release
    jcNowait   = []
    jcTime     = []

    DO CASE
    CASE jlWaiting                                        && defaults to .f. if nothing was passed...
       jcAnswerVal= "TO jcAnswerVal"
    CASE jnWaiting > 0
       jcAnswerVal= "TO jcAnswerVal"
       jcTime     = "TIME jnWaiting"
    OTHERWISE
       jcNoWait= "NOWAIT"
    ENDCASE

    WAIT WINDOW tcPhrase &jcPosition. &jcNowait. &jcTime. &jcAnswerVal.

    RETURN jcAnswerVal
ENDDEFINE