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
//-------------------------------------------------------------------------