Página 1 de 1

funcion MsgWait

Publicado: Lun Jul 17, 2023 9:04 pm
por carloskds
Buenas, comparto la funcion MsgWait derivada del trabajo de Bingen, la he modificado, para que solo muestre el mensaje.
Gracias Bingen por Compartir.

Código: Seleccionar todo

/*
 * Proyecto: test
 * Fichero: WaitsFunc.prg
 * Descripción:
 * Autor:
 * Fecha: 17/07/2023
 */

#include "Xailer.ch"

STATIC s_oWaitForm, s_oWaitSay, s_oWaitPrevForm

//-------------------------------------------------------------------------

PROCEDURE WaitOn( cMessage )
   Local oFont
   Local nTextWidth, nTextHeight
   Local nWidth, nHeight

   Default cMessage  To ""

   If Application:oActiveForm <> Nil
      s_oWaitPrevForm := Application:oActiveform
      s_oWaitPrevForm:lEnabled := .F.
   Endif

   Application:lBusy := .T.

   cMessage  := Alltrim( cMessage )

   DEFINE FONT oFont NAME "Tahoma"

   oFont:nSize      := 10
   oFont:lBold      := .T.
   oFont:lUnderline := .F.

   nTextWidth   := oFont:GetTextWidth( cMessage )
   nTextHeight  := oFont:GetTextHeight( cMessage )

   nWidth  := nTextWidth + 100
   nHeight := nTextHeight + 50

   If Valtype( s_oWaitForm ) <> 'U'
      WaitOff()
   EndIf

   If Application:oActiveForm <> Nil
      DEFINE FORM s_oWaitForm BORDERSTYLE bsNONE SIZE nWidth, nHeight Of Application:oActiveForm
   else
      DEFINE FORM s_oWaitForm BORDERSTYLE bsNONE SIZE nWidth, nHeight
   endif

      @ 10, 10 LABEL cMessage VAR s_oWaitSay SIZE nWidth-20, nHeight-20 OF s_oWaitForm ALIGNMENT taCenter

      s_oWaitSay:nVAlignment := vaCenter
      s_oWaitSay:nClrText := clYellow
      s_oWaitSay:oFont := oFont
      s_oWaitSay:nBorderStyle := bvFLAT

      s_oWaitForm:lModal := TRUE
      s_oWaitForm:nGradient := grVERTICAL
      s_oWaitForm:nClrPane := clDeepPink
      s_oWaitForm:nClrPaneEnd := clBlack

   ACTIVATE FORM s_oWaitForm CENTER

RETURN

//-------------------------------------------------------------------------

PROCEDURE WaitOff()
   If Valtype( s_oWaitForm ) <> 'U'
      s_oWaitForm:Close()
      s_oWaitForm := Nil
   ENDIF
   If Valtype( s_oWaitPrevForm ) <> 'U'
      s_oWaitPrevForm:lEnabled := .T.
      s_oWaitPrevForm := Nil
   ENDIF
   Application:lBusy := .F.
RETURN

//-------------------------------------------------------------------------