msgsvc.prg

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

      IF ! ISNULL( loDialog)
         loDialog.Release( )
      ENDIF
      *-- A desired side effect, allowing msgsvc().
      *-- Open resource table.
      RETURN THIS.OpenTable()

    ENDCASE
    *###########################################

    *-- Open MsgSvc
    IF ! THIS.OpenTable()
      RETURN []
    ENDIF

    LOCAL lcOrig
    lcOrig= lxPassed1

    *-- Change to allow for Length
    IF TYPE("lxPassed1")= "C"
      lxPassed1= UPPER( LEFT( lxPassed1, 30))
    ENDIF

    *-- Default return is blank string
    jcRetVal= []

    *-- Seek the cookie in the table
    IF NOT SEEK( lxPassed1, [MsgSvc])
      IF EMPTY( lxPassed2)
        lxPassed2= []
      ENDIF

      IF ok2insert()
        INSERT INTO msgsvc ( ckey, cfunction, coriginal) ;
            VALUES ( lcOrig, ;
                     IIF(llTherm,"THERM","Ok"), ;
                     lcOrig)
      ENDIF
    ENDIF


    *-- Scatter to an object
    LOCAL loMsgSpec, lcOldAlias
    lcOldAlias=Alias()
    SELECT MsgSvc
    SCATTER NAME loMsgSpec MEMO

    loSpecPackage.AddItem( "Message spec", loMsgSpec)

    IF ! EMPTY(lcOldAlias)
      SELECT (lcOldAlias)
    ENDIF


    *-- Cookie substitution
    IF llSwap
      DO CASE
      CASE TYPE( [lxPassed2]) = [C]
         LOCAL lcWorkPiece
         lcWorkPiece= loMsgSpec.cOriginal
         *-- We may have more than one string to swap-in
         jnNumToSwap = tokens( lxPassed2, ccParseDelim, .T.)
         FOR jnCounter = 1 TO jnNumToSwap
           jcCounter = STR(jnCounter,1)
           *-- What's our variable "word"?
           jcVariable = tokennum( lxPassed2, jnCounter, ccParseDelim, .T.)
           *-- Accept n occurences of %C% and %Cn% for first (perhaps only) swap
           DO CASE
           *-- uppercase
           CASE [%C]+jcCounter+[%] $ lcWorkPiece
             lcWorkPiece = STRTRANC( lcWorkPiece, ;
                                    [%C]+jcCounter+[%], ;
                                    jcvariable)
           *-- lowercase
           CASE [%c]+jcCounter+[%] $ lcWorkPiece
             lcWorkPiece = STRTRANC( lcWorkPiece, ;
                                    [%c]+jcCounter+[%], ;
                                    jcvariable)
           *-- uppercase
           CASE "%C%" $ UPPER(lcWorkPiece)
             lcWorkPiece = STRTRANC( lcWorkPiece, [%C%], jcvariable, 1)

           *-- lowercase
           CASE "%c%" $ UPPER(lcWorkPiece)
             lcWorkPiece = STRTRANC( lcWorkPiece, [%c%], jcvariable, 1)

           ENDCASE
         ENDFOR

         IF "%C" $ UPPER(lcWorkPiece)
           *-- Here we've stripped all tokens except unfulfilled suffix ones.  Cleanup.
           FOR jnCounter = 1 TO 9
             jcCounter = STR(jnCounter,1)
            IF !"%C" $ UPPER(lcWorkPiece)
              EXIT
            ENDIF
            DO CASE
             *-- uppercase
             CASE [%C]+jcCounter+[%] $ lcWorkPiece
               lcWorkPiece = STRTRANC( lcWorkPiece, ;
                                      [%C]+jcCounter+[%], '')
             *-- lowercase
             CASE [%c]+jcCounter+[%] $ lcWorkPiece
               lcWorkPiece = STRTRANC( lcWorkPiece, ;
                                      [%c]+jcCounter+[%], '')
             *-- uppercase
             CASE "%C%" $ UPPER(lcWorkPiece)
               lcWorkPiece = STRTRANC( lcWorkPiece, [%C%], '' )

             *-- lowercase
             CASE "%c%" $ UPPER(lcWorkPiece)
               lcWorkPiece = STRTRANC( lcWorkPiece, [%c%], '')

             ENDCASE
           ENDFOR
         ENDIF
         loMsgSpec.cOriginal= lcWorkPiece

      CASE TYPE( [lxPassed2]) = [N]
        loMsgSpec.cOriginal = STRTRAN( loMsgSpec.cOriginal, [%N%], ALLTRIM( STR( lxPassed2)))
      CASE TYPE( [lxPassed2]) = [D]
        loMsgSpec.cOriginal = STRTRAN( loMsgSpec.cOriginal, [%D%], DTOC( lxPassed2))
      ENDCASE
    ENDIF

    *-- A pipe symbol is akin to CR+LF
    loMsgSpec.cOriginal = STRTRAN( loMsgSpec.cOriginal, "|", ccCR_LF)

    *-- Mangle the animation if globally required
    IF !EMPTY(loMsgSpec.cGuiVisual) AND ;
       ! THIS.lAnimateIcons  AND ;
       ATC("Animate",loMsgSpec.cGuiVisual )> 0

       loMsgSpec.cGuiVisual= LEFT(loMsgSpec.cGuiVisual, ;
                                  ATC("Animate",loMsgSpec.cGuiVisual )-1)
    ENDIF

    *-- Pass Object to an appropriate builder
    LOCAL loMsg, lcBuilderName, lcBuilderCookie

    loMsg= .NULL.
    lcBuilderCookie= loMsgSpec.cFunction

    *-- Hook for TEXT values
    IF UPPER( lcBuilderCookie)= "TEXT"
      RETURN ALLTRIM( loMsgSpec.cOriginal)
    ENDIF

    lcBuilderName= THIS.GetBuilder( lcBuilderCookie)
    loBuilder    = CREATE( lcBuilderName)

    ************!!!!!!!!!!!!*****************
    loBuilder.Build( @loMsg, loSpecPackage)
    ************!!!!!!!!!!!!*****************

    *-- Place MessgeObject in aDialogs array
    IF !ISNULL( loMsg) AND TYPE( "loMsg")= "O"
      LOCAL lnThisDialog
      IF ALEN( THIS.aDialogs)= 1 AND ISNULL( THIS.aDialogs[1])
        lnThisDialog= 1
      ELSE
        DIMENSION THIS.aDialogs( ALEN( THIS.aDialogs)+ 1)
        lnThisDialog= ALEN( THIS.aDialogs)
      ENDIF
      THIS.aDialogs[ lnThisDialog]= loMsg
      THIS.aDialogs[ lnThisDialog].oReturnPointer= THIS

      IF EMPTY( MsgSvc.cRow + MsgSvc.cCol)
        THIS.aDialogs[ lnThisDialog].AutoCenter= .T.
      ENDIF
      *-------------------------------------------------------------------
      *-- This next line of code brought here because SetFocus() is
      *-- triggering premature visibility in VFP 5
      loBuilder.SetButtonFocus( THIS.aDialogs[ lnThisDialog], @loSpecPackage)
      *----------------------------------------------------------------

      *-- Release unneeded object references
      loBuilder.Release()
      RELEASE loMsgSpec
      loSpecPackage.Release()

      THIS.aDialogs[ lnThisDialog].SHOW()

      *-- IF the dialog was modal, it's gone
      *-- so clean up the stack
      LOCAL lnMaxDialog
      lnMaxDialog= ALEN( THIS.aDialogs)
      DO WHILE lnMaxDialog > 1 AND ISNULL( THIS.aDialogs[ lnMaxDialog])
        lnMaxDialog= lnMaxDialog-1
        DIMENSION THIS.aDialogs[ lnMaxDialog]
      ENDDO
    ELSE

      RETURN THIS.ReturnValue

    ENDIF

    RETURN IIF( lnThisDialog <= ALEN(THIS.aDialogs) AND ;
                         ! ISNULL(THIS.aDialogs[lnThisDialog]) AND ;
                         TYPE( "THIS.aDialogs[lnThisDialog]")="O"  , ;
                THIS.aDialogs[lnThisDialog],;
                THIS.ReturnValue)

 *====================================
 *-- cMsgSvc::CloseTable
 *====================================
 * Close the class's resource table
 *
  FUNCTION CloseTable
    USE IN (THIS.cAlias)

 *====================================
 *-- cMsgSvc::OpenTable
 *====================================
 * Open the class's resource table
 *
  FUNCTION OpenTable

    LOCAL lcOldError
    lcOldError= ON( "Error")
    ON ERROR lnError= -1

    *-- make sure the table's open
    IF ! USED( THIS.cAlias)
      USE LOCFILE( THIS.cTable, [DBF], [Where is ]+ THIS.cTable+[?] ) ORDER 1 IN 0
    ENDIF
    IF EMPTY( ORDER( THIS.cAlias))
      SET ORDER TO TAG cKey IN (THIS.cAlias)
    ENDIF

    ON ERROR &lcOldError

    RETURN USED( THIS.cAlias)


ENDDEFINE

DEFINE CLASS SetExact AS Relation
  cOldExact= .NULL.

  FUNCTION Init( tcNew)
    THIS.cOldExact= SET("Exact")
    IF TYPE( "tcNew")= "C"
      SET EXACT &tcNew
    ENDIF

  FUNCTION Destroy
    LOCAL lcString
    lcString= THIS.cOldExact
    SET EXACT &lcString

ENDDEFINE
*_BLD
*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c A b s t r a c t B u i l d e r
* Version..: Feb 27 1997
*-- Roles of a builder
*--   Created by the Director
*--   Handles build request from the director
*--   Passes it back to the director
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cAbstractBuilder AS Relation
  Visible= .F.

 *====================================
 *-- cAbstractBuilder::Build( oo)
 *====================================
 * Define the interface...
 *
  FUNCTION Build( to1, to2)
    RETURN .NULL.

 *====================================
 *-- cAbstractBuilder::Release()
 *====================================
 * Release this object
 *
  FUNCTION RELEASE
    RELEASE THIS

ENDDEFINE

*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c A b s t r a c t M s g B u i l d e r
* Version..: April 5 1996
*-- Roles of a builder
*--   Created by the Director
*--   Handles request from the director
*--   Creates the appropriate dialog
*--   Passes it back to the director
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cAbstractMsgBuilder AS cAbstractBuilder


  cFormClass  =  ""
  cButtonClass=  ""
  cImageClass =  ""
  cTextClass  =  ""
  cThermClass=   ""
  cTimerClass =  ""


  cTitleProp  =  "cTitle"
  cErrorProp  =  "cErrNo"

  lButtons= .F.
  lText   = .F.
  lTitle  = .T.
  lImage  = .T.
  lArrange= .T.
  lTimer  = .T.

  FUNCTION AddButtons( toDialog, toSpecPackage)
  FUNCTION AddImage( toDialog, toSpecPackage)
  FUNCTION Addtext( toDialog, toSpecPackage)
  FUNCTION AddTherm( toDialog, toSpecPackage)
  FUNCTION AddTimer( toDialog, toSpecPackage)
  FUNCTION AddTitle( toDialog, toSpecPackage)
  FUNCTION Arrange( toDialogPackage)
  FUNCTION Build( toDialog, toSpecPackage)


 *====================================
 *-- cAbstractMsgBuilder::Init()
 *====================================
 * Constructor
 *
  FUNCTION INIT

  FUNCTION SetReturnType(toDialog, toSpecPackage)
ENDDEFINE


*//////////////////////////////////////////////////////////////////////////////
* CLASS....: c G e n e r i c M s g  B u i l d e r
* Version..: April 5 1996
* Assumes..: Image is to left of text
*            Buttons are below text
*//////////////////////////////////////////////////////////////////////////////
DEFINE CLASS cGenericMsgBuilder AS cAbstractMsgBuilder
  cFormClass  =  "cFrmMsgSvc"
  cButtonClass=  "cCtrCommandButton"
  cImageClass =  "cImgMsgSvc"
  cTextClass  =  "cEdtMsgSvc"
  cThermClass =  "cCtrTherm"
  cTimerClass =  "cTmrMsgSvc"

  lButtons= .T.
  lText   = .T.

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

    *-- Process special cases
    *-- Go through the call parameters, looking for special
    *-- Button and Text cookies
    LOCAL lni, lci, lxtest

    FOR lni= 1 TO loCallParameters.ItemCount
      lcI= STR( lni, 1)
      lxTest= loCallParameters.GetItem( "Parameter"+lcI)

      IF TYPE("lxTest")<> "C"
        LOOP
      ELSE
        lxTest= UPPER( STRTRAN(lxTest," "))
      ENDIF
      IF "NOBUTTON" $ lxTest
        THIS.lButtons= .F.
      ENDIF
      IF "NOTEXT" $ lxTest
        THIS.lText= .F.
      ENDIF
    ENDFOR

    *-- Create the dialog
    toDialog=CREATE( THIS.cFormClass)

    *-- Tile details
    IF THIS.lTitle
      THIS.AddTitle( @toDialog, @toSpecPackage)
    ENDIF

    *-- Add an image
    IF THIS.lImage
      THIS.AddImage( @toDialog, @toSpecPackage)
    ENDIF

    *-- Add text
    IF THIS.lText
      THIS.Addtext( @toDialog, @toSpecPackage)
    ENDIF

    *-- Thermometer
    IF "THERM" $ UPPER( loMessageSpec.cFunction)
      THIS.AddTherm( @toDialog, @toSpecPackage)
      loMessageSpec.cFunction= LEFT(loMessageSpec.cFunction, MAX(0,ATC("Therm",loMessageSpec.cFunction)-1))
    ENDIF

    *-- Buttons
    IF THIS.lButtons
      THIS.AddButtons( @toDialog, @toSpecPackage)
    ENDIF

    *-- Timer
    IF THIS.lTimer
      THIS.AddTimer( @toDialog, @toSpecPackage)
    ENDIF

    *-- Return values
    THIS.SetReturnType( @toDialog, @toSpecPackage)

    *-- Position the dialog
    THIS.PositionDialog( @toDialog, @toSpecPackage)

    *-- Set the focus if required
    *? IN VFP 5.0a this causes a  visible screen resize! Commented out 3.20.97
    * Workaround: Moved to the director
    *THIS.SetButtonFocus( @toDialog, @toSpecPackage)

 *====================================
 *-- cGenericMsgBuilder::Arrange(o)
 *====================================
 *
  FUNCTION Arrange( toDialog)
  IF ISNULL( toDialog)
    RETURN .NULL.
  ENDIF
  LOCAL lnI, lnOldMemoWidth, lnMaxWidth, lnMaxHeight, lnWidestLine, llDone

  *-- Position the graphic
  IF TYPE("toDialog.oImage")= "O"
    WITH toDialog.oImage
      .Top = 7* toDialog.nVDBU
      .Left= 7* toDialog.nHDBU
      .Visible= .T.
    ENDWITH
  ENDIF

  *-- Position the text
  IF TYPE("toDialog.oText")= "O"
    WITH toDialog.oText
      .Top = 7* toDialog.nVDBU

      IF TYPE("toDialog.oImage")="O"
        .Left= toDialog.oImage.Left+ toDialog.oImage.Width+ (4* toDialog.nHDBU)
      ELSE
        .Left= 7* toDialog.nHDBU
      ENDIF

      *-- Size the text portion
      lnOldmemoWidth= SET("MemoWidth")
      lnMaxWidth= toDialog.MaxWidth- (7* toDialog.nHDBU)- .Left