In order for this site to work correctly we need to store a small file (called a cookie) on your computer. Most every site in the world does this, however since the 25th of May 2011, by law we have to get your permission first. Please abandon the forum if you disagree.

Para que este foro funcione correctamente es necesario guardar un pequeño fichero (llamado cookie) en su ordenador. La mayoría de los sitios de Internet lo hacen, no obstante desde el 25 de Marzo de 2011 y por ley, necesitamos de su permiso con antelación. Abandone este foro si no está conforme.

funcion MsgWait

Foro público de Xailer en español
carloskds
Mensajes: 19
Registrado: Mié Abr 05, 2023 2:53 am

funcion MsgWait

Mensaje 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

//-------------------------------------------------------------------------
Responder