Buenos dias:
Alguien me puede proporcionar un pequeño ejemplo para hacer un listado de una matriz,
Muchas gracias.
Emilio Gil.
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.
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.
Imprimir matrices
-
Bingen Ugaldebere
- Mensajes: 1310
- Registrado: Mié Sep 26, 2007 7:12 pm
Imprimir matrices
/*
* Proyecto: BiSoftLib Librería de propósito general
* Fichero: Messages.prg
* Descripción: Mensajes en general para las aplicaciones
* Autor: Bingen Ugaldebere
* Última revisión: 12/11/2010
*/
#include "Xailer.ch"
#include "Language.ch"
STATIC oFormWait, oPrevForm, oWaitTitle, oWaitSay
CLASS TForm FROM XForm
METHOD FlashForm( nBlinks )
ENDCLASS
METHOD FlashForm( nBlinks ) CLASS TForm
DEFAULT nBlinks TO 10
FlashWindow( Self:Handle, nBlinks )
RETURN Nil
//---------------------------------------------------------- --------------------
Function MsgEdit(cText, cTitle, uVar, cImage, lPASSWORD ,lNoCancel, cPicture)
Local oForm , oEdit, lOk := .f., oImage, uLimitInf:=Nil, uLimitSup:=Nil
Default cText To "Introduzca un valor"
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default lPassWord To .F.
Default lNoCancel To .F.
Default cPicture To "@E 999,999.99"
//Si se recibe un array con 3 números o fechas se consideran valor a mostrar en edición, valor mínimo y valor máximo a cumplir
//Si es un array con textos se mostrará un Combobox
If Valtype(uVar)="A" .And. LEN(uVar)=3 .And. ValType(uVar[1])$"ND" .And. ValType(uVar[2])$"ND" .And. ValType(uVar[3])$"ND"
uLimitInf:=uVar[2]
uLimitSup:=uVar[3]
uVar:=uVar[1]
Endif
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 150 BORDERSTYLE bsDIALOG
If lPassWord
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42, 10 EDIT oEdit SIZE 295, 25 OF oForm PassWord
Else
DO Case
Case ValType(uVar)=="C"
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42, 10 EDIT oEdit SIZE 295, 25 OF oForm
oEdit:nMaxLength := Len(uVar)
Case ValType(uVar)=="N"
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42,105 MASKEDIT oEdit SIZE 120, 25 OF oForm ALIGNMENT taRight Picture cPicture
Case ValType(uVar)=="D"
@ 15, 30 LABEL cText SIZE 140, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 25,170 DATEEDIT oEdit SIZE 95, 25 OF oForm
Case ValType(uVar)=="L"
@ 35, 15 CHECKBOX oEdit SIZE 25, 25 OF oForm
@ 22, 40 LABEL cText SIZE 260, 40 OF oForm VALIGNMENT vaCenter MultiLine
If uVar
oEdit:lChecked:=.T.
Endif
Case ValType(uVar)=="A"
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42, 10 COMBOBOX oEdit SIZE 295, 25 OF oForm iTEMS uVar Style csDROPDOWNLIST
OtherWise
MsgInfo("No se puede editar un valor de tipo "+Valtype(uVar))
EndCase
Endif
If ValType(uVar)$"CND"
oEdit:Value:=uVar
Endif
If !Empty(cImage)
@ 70,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
Endif
If lNoCancel
@ 80, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (If(ValType(uVar)="L" .Or. (ValType(uVar)<>"L" .And. MsgEditValid(oEdit:Value, uLimitInf, uLimitSup)),;
(lOk := .T., oForm:Close()),;
(oEdit:SetFocus(),oEdit:SelectAll())) ) Default
Else
@ 80, 60 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (If(ValType(uVar)$"LA" .Or. (ValType(uVar)$"CND" .And. MsgEditValid(oEdit:Value, uLimitInf, uLimitSup)),;
(lOk := .T., oForm:Close()),;
(oEdit:SetFocus(),oEdit:SelectAll())) ) Default
@ 80, 180 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
ACTIVATE FORM oForm MODAL CENTER
If lOk
If ValType(uVar)$"CND"
uVar:=oEdit:Value
ElseIf ValType(uVar)="L"
uVar:=oEdit:lChecked
Else
uVar:={oEdit:nIndex,oEdit:cText}
Endif
Endif
Return lOk
Static Function MsgEditValid(uValue, uLimitInf, uLimitSup)
If uLimitInf=Nil .And. uLimitSup=Nil
Return .T.
Endif
If uLimitInf<>Nil .And. uValue<uLimitInf
MsgInfo("El límite inferior es "+ToString( uLimitInf ),"Valor incorrecto")
Return .F.
Endif
If uLimitSup<>Nil .And. uValue>uLimitSup
MsgInfo("El límite superior es "+ToString( uLimitSup ),"Valor incorrecto")
Return .F.
Endif
Return .T.
//---------------------------------------------------------- --------------------
Function MsgLimit(cText, cTitle, uVarIni, uVarFin, cPicture, cTextIni, cTextFin, cImage, lNoCancel)
Local oForm , oIni, oFin, lOk := .f., oImage
Default cText To "Introduzca valores"
Default cTitle To LT(XA_MSG_WARNING)
Default cTEXTINI To "DESDE ......................."
Default cTEXTFIN To "HASTA ......................."
Default lNoCancel To .F.
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 175 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText SIZE 295, 35 OF oForm VALIGNMENT vaCenter
@ 43, 10 LABEL cTextIni SIZE 155, 25 OF oForm
@ 73, 10 LABEL cTextFin SIZE 155, 25 OF oForm
@ 40, 170 MaskEdit oIni SIZE 90, 25 OF oForm
@ 70, 170 MaskEdit oFin SIZE 90, 25 OF oForm
If cPicture<>Nil
oIni:cPicture:=cPicture
oFin:cPicture:=cPicture
Endif
oIni:Value:=uVarIni
oFin:Value:=uVarFin
If !Empty(cImage)
@ 100, 10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
Endif
If lNoCancel
@ 110, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (lOk := .T., oForm:Close()) Default
Else
@ 110, 60 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (lOk := .T., oForm:Close()) Default
@ 110, 180 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
ACTIVATE FORM oForm MODAL CENTER
If lOk
uVarIni:=oIni:Value
uVarFin:=oFin:Value
Endif
Return lOk
//---------------------------------------------------------- --------------------
Function MsgDate(cText, cTitle, uVarIni, uVarFin, cTextIni, cTextFin, cImage, lNoCancel)
Local oForm , oIni, oFin, lOk := .f., oImage
Local cTxtError:="Rango de fechas incorrecto"
Default cText To "Límites de fechas"
Default cTitle To "Introduzca fechas"
Default cTEXTINI To "DESDE ......................."
Default cTEXTFIN To "HASTA ......................."
Default lNoCancel To .F.
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 175 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText SIZE 295, 35 OF oForm VALIGNMENT vaCenter
@ 43, 10 LABEL cTextIni SIZE 155, 25 OF oForm
@ 73, 10 LABEL cTextFin SIZE 155, 25 OF oForm
@ 40, 170 DateEdit oIni SIZE 90, 25 OF oForm
@ 70, 170 DateEdit oFin SIZE 90, 25 OF oForm
oIni:Value:=uVarIni
oFin:Value:=uVarFin
If !Empty(cImage)
@ 100, 10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
Endif
If lNoCancel
@ 110, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION If(oFin:Value>=oIni:Value,(lOk := .T., oForm:Close()),;
(MsgInfo(cTxtError) , MsgSound()) ) Default
Else
@ 110, 60 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION If(oFin:Value>=oIni:Value,(lOk := .T., oForm:Close()),;
(MsgInfo(cTxtError) , MsgSound()) ) Default
@ 110, 180 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
ACTIVATE FORM oForm MODAL CENTER
If lOk
uVarIni:=oIni:Value
uVarFin:=oFin:Value
Endif
Return lOk
//---------------------------------------------------------- --------------------
Function MsgMemo(cText, cTitle, lEditable)
Local oForm , oMemo , lOk := .f., cInitText:=cText
Local nHeight:=0, nWidth:=0, nLine:=1
Default cTitle To LT(XA_MSG_WARNING)
Default lEditable To .F.
nHeight:=Min((Application:oFont:GetTextHeight( cTitle )*1.2)*Mlcount(cText),Screen:nHeight*0.70)
nHeight:=Max(nHeight,50)
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nWidth:=Min(nWidth,Screen:nWidth*0.80)
nWidth:=Max(nWidth,280)
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE nWidth+22, nHeight+90 BORDERSTYLE bsDIALOG
@ nHeight+20, (nWidth+22)-180 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (cText:=oMemo:Value, lOk := .T., oForm:Close()) Default
If lEditable
@ nHeight+20,(nWidth+22)-90 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
@ 10, 10 MEMO oMemo PROMPT cText SIZE nWidth, nHeight OF oForm
oMemo:lReadOnly:=!lEditable
If !oMemo:lReadOnly .And. Len(Alltrim(cText))=0
oMemo:SetFocus()
Endif
ACTIVATE FORM oForm MODAL CENTER
Return If(lOk, cText, If(!lEditable,.F.,cInitText) )
//---------------------------------------------------------- --------------------
Function MsgWait(cText, cTitle, nSeconds, cImage, cSound )
Local oForm, oImage, oTimer
Local nWidth:=0, nHeight:=0, nLine:=1
Local nTitleWidth:=0, nTitleHeight:=0
Local nTextWidth :=0, nTextHeight :=0
Local nTotalWidth:=0, nTotalHeight:=0
Default cText To ""
Default cTitle To "Espere un momento por favor..."
Default cImage To ""
Default nSeconds To 2
Default cSound To ""
//Calcular tamaños respecto al fuente
nTitleWidth:=Application:oFont:GetTextWidth( cTitle )*1.2
nTitleHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nTotalHeight:=Max( (nHeight*(Mlcount(cText)+1))+35 , If(!Empty(cImage),85,0) )
nWidth:=nTitleWidth
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nTotalWidth:=nWidth+If(!Empty(cImage),55,0)+20
nTotalWidth:=If( nTotalWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nTotalWidth )
Application:lBusy:=.T.
DEFINE FORM oForm SIZE nTotalWidth,nTotalHeight BORDERSTYLE bsSPLASH Of Application:oActiveform
@ 1, 5 LABEL cTitle SIZE nTitleWidth, nTitleHeight OF oForm
If !Empty(cImage)
@ 30,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ nHeight+10, 55 LABEL cText SIZE nWidth,nHeight*Mlcount(cText) OF oForm VALIGNMENT vaCenter
Else
@ nHeight+10, 10 LABEL cText SIZE nWidth,nHeight*Mlcount(cText) OF oForm VALIGNMENT vaCenter
Endif
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
Activate Timer oTimer
If !Empty(cSound)
PlaySound(cSound)
Endif
ACTIVATE FORM oForm MODAL CENTER
DeActivate Timer oTimer
Application:lBusy:=.F.
Return Nil
//---------------------------------------------------------- --------------------
Function MsgPostit(cText, cTitle, cImage, lFlash, nColor, cSound )
Local oForm, oImage
Default cText To ""
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default lFlash To .T.
Default nColor To CLR_YELLOW
Default cSound To ""
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 280 BORDERSTYLE bsTOOLWINDOW Color CLR_BLACK,nColor
If !Empty(cImage)
@ 5,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 5, 55 LABEL cText SIZE 250, 250 OF oForm MultiLine VALIGNMENT vaCenter
Else
@ 5, 10 LABEL cText SIZE 295, 250 OF oForm MultiLine VALIGNMENT vaCenter
Endif
If !Empty(cSound)
PlaySound(cSound)
Endif
If lFlash
oForm:OnShow := { || oForm:FlashForm(300) }
Endif
ACTIVATE FORM oForm MODAL CENTER
Return Nil
//---------------------------------------------------------- --------------------
Function MsgSound( cSound )
Default cSound To GetWindowsDirectory()+"MediaChord.Wav"
PlaySound(cSound)
Return Nil
//---------------------------------------------------------- ------------------//
Function MsgToolTip(oSender, cText, cTitle, nColor, nSeconds )
Local oForm, oTitle, oText, oTimer
Local nWidth, nHeight, n:=1, nLines:=1
Local nXPos:=0, nYPos:=0
Default cText To ""
Default cTitle To ""
Default nColor To CLR_YELLOW
Default nSeconds To 3
cText :=Alltrim(cText)
cTitle :=Alltrim(cTitle)
//Calcular tamaño respecto al fuente
nHeight:=Application:oFont:GetTextHeight( " " )*1.2
For n:=1 to Mlcount(cText)
nWidth:=Max( Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,n) )), Application:oFont:GetTextWidth( cTitle ) )+60
Next
nWidth:=If( nWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nWidth )
nLines:=MlCount(cText)+If(Len(cTitle)>0,1,0)
//Cálculo de posicionamiento
Do Case
Case oSender:IsKindOf( "TBevel" ) .Or. ;
oSender:IsKindOf( "TGroupbox" ) .Or. ;
oSender:IsKindOf( "TPages" ) .Or. ;
oSender:IsKindOf( "TArrayBrowse" )
nXPos:=oSender:nLeft+(oSender:nWidth)
nYPos:=oSender:nTop+(oSender:nHeight)
Otherwise
nXPos:=oSender:nLeft+(oSender:nWidth/2)
nYPos:=oSender:nTop+(oSender:nHeight*2)
EndCase
//Reposicionamiento si el tooltip se va a salir de la pantalla
Do While Application:oActiveform:nTop+nYPos+nHeight*(nLines+1)>Screen:nHeight
--nYpos
EndDo
Do While Application:oActiveform:nLeft+nXPos+nWidth+30>Screen:nWidth
--nXpos
EndDo
//Mostrar falso tooltip en ventana
DEFINE FORM oForm From Application:oActiveform:nTop+nYPos, Application:oActiveform:nLeft+nXPos ;
SIZE nWidth+30,nHeight*(nLines+1) BORDERSTYLE bsSPLASH ;
Color CLR_BLACK,nColor Of Application:oActiveform
If Len(cTitle)>0
@ 0,5 Label cTitle VAR oTitle Size nWidth,nHeight Of oForm
oTitle:OnCLick:={|| oForm:Close() }
@ nHeight+.5,5 Label cText VAR oText Size nWidth,nHeight*(nLines-1) Of oForm Alignment taCenter
Else
@ nHeight/2,5 Label cText VAR oText Size nWidth,nHeight*nLines Of oForm Alignment taCenter
Endif
oText:OnCLick:={|| oForm:Close() }
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
Activate Timer oTimer
oForm:OnCLick:={|| oForm:Close() }
ACTIVATE FORM oForm modal
DeActivate Timer oTimer
Return Nil
//---------------------------------------------------------- ------------------//
************************************************************ ***
* MENSAJE QUE QUEDA PERMANENTE EN PANTALLA MIENTRAS SE HACE *
* CUALQUIER OTRO PROCESO Y HASTA QUE SE EJECUTE WAITOFF() *
************************************************************ ***
FUNCTION WaitOn( cText, cTitle, cImage, cSound )
Local oImage
Local nWidth:=0, nHeight:=0, nLine:=1
Local nTitleWidth:=0, nTitleHeight:=0
Local nTextWidth :=0, nTextHeight :=0
Local nTotalWidth:=0, nTotalHeight:=0
Default cText To ""
Default cTitle To "Espere un momento por favor..."
Default cImage To ""
Default cSound To ""
If Application:oActiveform<>Nil
oPrevForm:=Application:oActiveform
oPrevForm:lEnabled := .F.
Endif
Application:lBusy :=.T.
cText :=Alltrim(cText)
cTitle :=Alltrim(cTitle)
//Calcular tamaños respecto al fuente
nTitleWidth:=Application:oFont:GetTextWidth( cTitle )*1.2
nTitleHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nTotalHeight:=Max( (nHeight*(Mlcount(cText)+1))+35 , If(!Empty(cImage),85,0) )
nWidth:=nTitleWidth
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nTotalWidth:=nWidth+If(!Empty(cImage),55,0)+20
nTotalWidth:=If( nTotalWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nTotalWidth )
//Si no se ha llamado a Waitoff antes de un segundo WaitOn se provoca
If Valtype(oFormWait) <> 'U'
WaitOff()
EndIf
//Ventana de mensaje con espera hasta que se ejecuta WaitOff
DEFINE FORM oFormWait SIZE nTotalWidth,nTotalHeight BORDERSTYLE bsSPLASH Of Application:oActiveform
@ 1, 5 LABEL cTitle VAR oWaitTitle SIZE nTitleWidth, nTitleHeight OF oFormWait
If !Empty(cImage)
@ 30,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oFormWait
@ nHeight+10, 55 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Else
@ nHeight+10, 10 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Endif
If !Empty(cSound)
PlaySound(cSound)
Endif
ACTIVATE FORM oFormWait CENTER
Return Nil
************************************************************ *****
* MENSAJE CON BARRA DE PROGRESO QUE QUEDA EN PANTALLA MIENTRAS *
* SE HACE OTRO PROCESO Y HASTA QUE SE EJECUTE WAITOFF() *
************************************************************ *****
FUNCTION WaitOnMeter( cText, cTitle, nTotalValue, cImage, cSound )
Local oImage
Local nWidth:=0, nHeight:=0, nLine:=1
Local nTitleWidth:=0, nTitleHeight:=0
Local nTextWidth :=0, nTextHeight :=0
Local nTotalWidth:=0, nTotalHeight:=0
Default cText To ""
Default cTitle To "Espere un momento por favor..."
Default nTotalValue To 100
Default cImage To ""
Default cSound To ""
If Application:oActiveform<>Nil
oPrevForm:=Application:oActiveform
oPrevForm:lEnabled := .F.
Endif
Appdata:AddData("oWaitOnMeter",Nil)
Application:lBusy :=.T.
cText :=Alltrim(cText)
cTitle :=Alltrim(cTitle)
//Calcular tamaños respecto al fuente
nTitleWidth:=Application:oFont:GetTextWidth( cTitle )*1.2
nTitleHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nTotalHeight:=Max( (nHeight*(Mlcount(cText)+1))+35 , If(!Empty(cImage),85,0) )
nWidth:=nTitleWidth
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nTotalWidth:=nWidth+If(!Empty(cImage),55,0)+20
nTotalWidth:=If( nTotalWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nTotalWidth )
//Si no se ha llamado a Waitoff antes de un segundo WaitOn se provoca
If Valtype(oFormWait) <> 'U'
WaitOff()
EndIf
//Ventana de mensaje con barra de progreso en espera hasta que se ejecuta WaitOff
DEFINE FORM oFormWait SIZE nTotalWidth,nTotalHeight+20 BORDERSTYLE bsSPLASH Of Application:oActiveform
@ 1, 5 LABEL cTitle VAR oWaitTitle SIZE nTitleWidth, nTitleHeight OF oFormWait
If !Empty(cImage)
@ 30,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oFormWait
@ nHeight+10, 55 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Else
@ nHeight+10, 10 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Endif
If !Empty(cSound)
PlaySound(cSound)
Endif
@ nTotalHeight-10 , 10 PROGRESSBAR Appdata:oWaitOnMeter OF oFormWait ;
SIZE nTotalWidth-25, 15 ;
RANGE 0, nTotalvalue ;
SMOOTH
Appdata:oWaitOnMeter:nStep:=nTotalValue/100
Appdata:oWaitOnMeter:nValue=0
ACTIVATE FORM oFormWait CENTER
Return Nil
// PARA CERRAR EL WAITON()
//Solo se puede usar si antes se ha llamado antes a WaitOn
FUNCTION WAITOFF()
If Valtype(oFormWait) <> 'U'
oFormWait:Close()
oFormWait := Nil
ENDIF
If Valtype(oPrevForm) <> 'U'
oPrevForm:lEnabled:=.T.
oPrevForm := Nil
ENDIF
Application:lBusy:=.F.
Return Nil
//---------------------------------------------------------- --------------------
// Graba directamente al disco un mensaje línea a línea sin
// cargarlo previamente a una variable asi no hay problema
// de exceder el tamaño de cadena en la variable
//---------------------------------------------------------- --------------------
Function MsgSave( xText, cNomFile ,lCreate)
Local nHd
Local cText := ToString( xText )
Default cNomFile To "Message.Txt"
Default lCreate To .F.
If Empty( cText )
Return ( .F. )
EndIf
If lCreate .And. File( cNomFile )
Ferase( cNomFile )
EndIf
If !File( cNomFile )
nHd := FCreate( cNomFile )
If FError() != 0
MsgBeep()
return ( .F. )
EndIf
Else
nHd := FOpen( cNomFile, 2 )
If FError() != 0
MsgBeep()
return ( .F. )
EndIf
FSeek( nHd, 0, 2 ) //Al final del archivo
If ( FWrite( nHd, CRLF ) != 2 ) //una línea nueva
MsgBeep()
Return ( .F. )
EndIf
EndIf
If ( FWrite( nHd, cText ) != len(cText) ) //Escribe texto en una linea nueva
MsgBeep()
Return ( .F. )
EndIf
FClose( nHd )
Return .T.
//---------------------------------------------------------- --------------------
* MUESTRA UN ARRAY POR PANTALLA O IMPRESORA *
//---------------------------------------------------------- --------------------
FUNCTION MsgArray(aItems,aHeads,cText,cTitle,lCancel,lPrint,lFilterBa r,lRecno,lExcel )
Local oForm, oBTN1, oBTN2, oBrw, lOK:=.F., aArray:={}, oSay
Local oAceptar, oCancelar, oImprimir, oExcel
Local nAt:=0, oFilter, nWidth:=0, nCol:=0
DEFAULT aHeads To {}
DEFAULT cText To ""
DEFAULT cTitle To "Listado del contenido de la tabla"
DEFAULT lCancel To .T.
DEFAULT lPrint To .T.
DEFAULT lFilterbar To .F.
DEFAULT lRecNo To .F.
DEFAULT lExcel To .F.
//Controles previos
If Len(aItems)=0 //Si esta vacio
LogDebug("Imposible mostrar ARRAY vacio en MsgArray()")
Return 0
Endif
If Valtype(aItems)<>"A" //Si no es un array
MsgStop("Imposible mostrar datos que no son un ARRAY en MsgArray()"+CRLF+CRLF+;
"Tipo de datos "+Valtype(aItems))
Return 0
Endif
CursorWait()
If Valtype(aItems[1])="A" //Array de 2 dimensiones lo clono como está
aArray:=aClone(aItems)
Else //Array de 1 dimensión no vale lo convierto en 2
For nAt:=1 To Len(aItems)
Aadd(aArray,{aItems[nAt]})
Next
Endif
//Creo cabeceras para las columnas si no las tienen
Do While Len(aHeads)<Len(aArray[1])
Aadd(aHeads,If(Len(aArray[1])>2,"Col_"+StrZero(++nCol,2), ""))
EndDo
If !lRecNo //Si no se ha suministrado la primera columna con RecNo()
For nAt:=1 To Len(aItems) //Aumentar el array en 1 elemento mas para meter el ordinal
ASize(aArray[nAt],Len(aArray[nAt])+1)
aArray[nAt,Len(aArray[nAt])]:=nAt
Next
nAt:=0
Endif
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 366, 427 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText Var oSay SIZE 343, 40 OF oForm VALIGNMENT vaCenter Multiline
oSay:nAnchors:=akALL
@ 45, 10 ARRAYBROWSE oBrw Size 343,300 Items aArray Headers aHeads OF oForm
oBrw:nAnchors:=akALL
oBrw:DelCol(Len(aArray[1]))
oBrw:lRecordSelector :=.F.
oBrw:lHeader :=!(Len(aHeads)=0)
oBrw:nMarqueeStyle :=bmHIGHLROWRC
oBrw:nClrAltPane :=clLtGray
oBrw:OnDblClick :={|| (lOk := .T., nAt:=If(oBrw:nArrayOrgAt()<>0,oBrw:nArrayOrgAt(),oBrw:nArrayAt), oForm:Close()) }
@ 364, 10 BUTTON oAceptar CAPTION LT( XA_MSG_ACEPTAR ) SIZE 70, 25 OF oForm ;
ACTION oBrw:OnDblClick() Default
oAceptar:nAnchors:=akRIGHT
oAceptar:lDefault:=.t.
If lCANCEL
@ 364, 90 BUTTON oCancelar CAPTION LT( XA_MSG_CANCELAR ) SIZE 70, 25 OF oForm ;
ACTION oForm:Close()
oCancelar:nAnchors:=akRIGHT
Endif
If lPrint
@ 364, 170 BUTTON oImprimir CAPTION LT( XA_MSG_IMPRIMIR ) SIZE 70, 25 OF oForm ;
ACTION IMPARRAY(aItems,aHeads,cTitle,cText,oBrw)
oImprimir:nAnchors:=akRIGHT
Endif
If lExcel
@ 364, 250 BUTTON oExcel CAPTION "Excel" SIZE 70, 25 OF oForm ;
ACTION IMPARRAYExcel(aItems,aHeads,cTitle,cText)
oExcel:nAnchors:=akRIGHT
Endif
If Len(aHeads)>0
For nAt:=1 To Len(oBrw:aCols)
oBrw:aCols[nAt]:AdjustWidth()
nWidth:=nWidth+oBrw:aCols[nAt]:nWidth+9
Next
Endif
If lFilterBar
@ 345, 10 CHECKBOX oFilter Caption "Permitir búsquedas por filtro" SIZE 170, 20 OF oForm
oFilter:lChecked := .T.
oBrw:lFilterBar := .T.
oFilter:onClick := {|| oBrw:lFilterBar:=!oBrw:lFilterBar}
Endif
oBrw:lAutoOrder:=.t.
oForm:nWidth:=Max(oForm:nWidth,nWidth)
oForm:nWidth:=Min(oForm:nWidth,Screen:nWidth-100)
oBrw:OnKeyUp := {|oSender, nKey, nFlags| If(nKey=13, oBrw:OnDblClick(),Nil) }
ACTIVATE FORM oForm MODAL CENTER
CursorArrow()
Return If(lOk,nAt,0)
******* IMPRIMIR ARRAY
STATIC FUNCTION IMPARRAY(aItems,aHeads,cTitle,cText,oBrw)
Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:=""
Local aDatos:={}, aLen:={}, nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0
DEFAULT aHeads To {}
//Intentar imprimir con FR o si no con Xailer
Try
oBrw:FastReport(,cTitle)
Catch
CursorWait()
//Calcular Numero de columnas e inicializar longitudes de columna
aSize(aLen,If(ValType(aItems[1])="A",Len(aItems[1]),1))
aFill(aLen,0)
//Si no hay cabeceras crear un array de cabeceras a ""
If Len(aHeads)=0
aSize(aHeads,Len(aLen))
aFill(aHeads,"")
EndIf
//Calcular anchura máxima de cada columna
For nC:=1 to Len(aLen)
If Len(aLen)=1
aLen[nC]:=Max(aLen[nC],Len(Alltrim(ToString(aItems[nC]))))
Else
For nL:=1 to Len(aItems)
aLen[nC]:=Max(aLen[nC],Len(Alltrim(ToString(aItems[nL,nC]))) )
aLen[nC]:=Max(aLen[nC],Len(Alltrim(aHeads[nC])))
Next
Endif
Next
//Si hay cabeceras crear el literal de cabecera
If Len(aHeads)>0
For nC:=1 to Len(aLen)
cHead:=cHead+PadR(aHeads[nC],aLen[nC])+" "
Next
Endif
//Crear el literal de cada línea del Array y cargar a aDatos
For nL:=1 to Len(aItems)
cTexto:=""
If Len(aLen)=1
cTexto:=cTexto+ToString(aItems[nL])
Else
For nC:=1 to Len(aLen)
Do Case
Case ValType(aItems[nL,nC])="C"
cTexto:=cTexto+PadR(aItems[nL,nC],aLen[nC])+" "
Case ValType(aItems[nL,nC])="N"
cTexto:=cTexto+Padl(Alltrim(Str(aItems[nL,nC])),aLen[nC])+" "
Case ValType(aItems[nL,nC])="D"
cTexto:=cTexto+PadR(Dtoc(aItems[nL,nC]),10)+" "
EndCase
Next
Endif
Aadd(aDatos,cTexto)
Next
//Comienza impresión
DEFINE FONT oFont NAME "COURIER NEW"
Printer:cJobTitle := cTitle
Printer:lPreview := .t.
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmHIMETRICS
Do While !lSalir
Printer:StartPage()
WITH OBJECT Printer:oCanvas
:oFont := oFont
:oPen := oPen
:nMapMode := mmSIMULCHAR
:nTextAlignment:=taCENTER
:oFont:nSize := 14
:oFont:lBold := .T.
:oFont:lUnderline := .T.
:TextOut( 1, 1, cTitle,70, CLR_BLUE)
:nTextAlignment:=taLEFT
:oFont:nSize := 12
:TextOut( 2.5, 3, AllTrim(cHead),30, CLR_BLACK)
:oFont:lBold := .F.
:oFont:lUnderline := .F.
For n := 1 to :TextLines()-5
If ++nItem<=Len(aDatos)
:TextOut( 2.5, n+4, aDatos[nItem],30, CLR_BLACK)
Else
lSalir:=.T.
Exit
Endif
Next
:nTextAlignment:=taCENTER
:TextOut( 1, :TextLines(), "- "+Alltrim(ToString(++nNumpage))+" -",80, CLR_BLUE)
END WITH
Printer:EndPage()
Enddo
Printer:EndDoc()
Printer:Preview()
oFont:Destroy()
CursorArrow()
End
Return Nil
******* IMPRIMIR ARRAY A EXCEL
STATIC FUNCTION IMPARRAYEXCEL(aItems,aHeads,cTitle,cText)
Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:=""
LOCAL oExcel, oWorkBook, oSheet, oClp
Local aDatos:={}, nLen:=0, nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0
DEFAULT aHeads To {}
CursorWait()
//Calcular Numero de columnas e inicializar longitudes de columna
nLen:=If(ValType(aItems[1])="A",Len(aItems[1]),1)
TRY
oExcel := GetActiveObject( "Excel.Application" )
CATCH
TRY
oExcel := CreateObject( "Excel.Application" )
CATCH
Alert( "ERROR! Excel no disponible. [" + Ole2TxtError()+ "]" )
RETURN .F.
END
END
TRY
oWorkBook := oExcel:Workbooks:Add()
oSheet := oWorkBook:WorkSheets( 1 )
CATCH
Alert( "ERROR! Hoja Excel no disponible. [" + Ole2TxtError()+ "]" )
oExcel := NIL
RETURN .F.
END
oClp := TClipboard():Create( )
// Titulares
oSheet:Cells( 1, 1 ):Value := cTitle
oSheet:Cells( 1, 1 ):Font:Bold := .T.
oSheet:Cells( 1, 1 ):Font:Size := 14
oSheet:Cells( 2, 1 ):Value := cText
oSheet:Cells( 2, 1 ):Font:Bold := .T.
oSheet:Cells( 2, 1 ):Font:Size := 14
oSheet:Cells( 1, 1 ):HorizontalAlignment := 3 //Center
oSheet:Cells( 2, 1 ):HorizontalAlignment := 3 //Center
oSheet:Range( "A1:"+ExcelColumn(nLen)+"1" ):Merge( .T. )
oSheet:Range( "A2:"+ExcelColumn(nLen)+"2" ):Merge( .T. )
//Cabeceras de columna
For nC:=1 to Len(aHeads)
oSheet:Cells( 4, nC ):Value:=aHeads[nC]
oSheet:Cells( 4, nC ):HorizontalAlignment := 3 //Center
oSheet:Cells( 4, nC ):Font:Bold := .T.
oSheet:Cells( 4, nC ):Interior:Color := clLtGray
Next
//Lineas de datos
For nL:=1 to Len(aItems)
For nC:=1 to nLen
Do Case
Case ValType(aItems[nL,nC])="C"
oSheet:Cells( 4+nL, nC ):Value:=aItems[nL,nC]
Case ValType(aItems[nL,nC])="N"
oSheet:Cells( 4+nL, nC ):Value:=Alltrim(TransForm(aItems[nL,nC],"@E 999,999,999.99999999"))
Case ValType(aItems[nL,nC])="D"
oSheet:Cells( 4+nL, nC ):Value:=Dtoc(aItems[nL,nC])
EndCase
Next
Next
// Autoajustar columnas del rango
oSheet:Columns( "A:"+ExcelColumn(nLen) ):AutoFit()
//Mostrar hoja
oExcel:Visible := .T.
oSheet := NIL
oWorkBook := NIL
oExcel := NIL
oClp:End()
ProcessMessages()
CursorArrow()
Return Nil
//Cálculo de la letra de columna de Excel en base a su ordinal
Static Function ExcelColumn(nCol)
Local cCol:="", nResto:=0
If nCol=0 .Or. nCol>256
MsgInfo("Valor de columna "+Tostring(nCol)+" fuera de rango 1-256")
Return ""
Endif
If nCol<=26 //Hasta la columna 26 letra de la A a la Z
cCol:=Chr(64+nCol)
Else
//Por encima de la col 26 doble letra
If Mod(nCol,26)>0 //Si hay resto de dividir por 26
cCol:=Chr(64+(Int(nCol/26))) //Primera letra parte entera
cCol:=cCol+Chr(64+Mod(nCol,26)) //Segunda letra por el resto
Else
cCol:=Chr(64+(Int(nCol/26))-1) //Sin resto es la última de la serie anterior
cCol:=cCol+"Z" //y por lo tanto termina en Z
Endif
Endif
Return cCol
//---------------------------------------------------------- --------------------
* MUESTRA UN TREE CON CHECKBOX DE SELECCIÓN *
//---------------------------------------------------------- --------------------
FUNCTION MsgListCheck(aItems,cText,cTitle,lCancel,lPrint,lExcel,lDele teNoChecked, nColTotal )
Local oForm, oBTN1, oBTN2, oTree, lOK:=.F., aArray:={}, oSay, oTotal
Local oAceptar, oCancelar, oImprimir, oExcel, oTodo, oNada, oInvert
Local nWidth:=0, nItem:=0
DEFAULT cText To ""
DEFAULT cTitle To "Seleccione elementos deseados"
DEFAULT lCancel To .T.
DEFAULT lPrint To .T.
DEFAULT lExcel To .F.
DEFAULT lDeleteNoChecked To .F.
DEFAULT nColTotal To 0
//Controles previos
If Len(aItems)=0 //Si esta vacio
LogDebug("Imposible mostrar ARRAY vacio en MsgListCheck()")
Return {}
Endif
If Valtype(aItems)<>"A" //Si no es un array
MsgStop("Imposible mostrar datos que no son un ARRAY en MsgListCheck()"+CRLF+CRLF+;
"Tipo de datos "+Valtype(aItems))
Return {}
Endif
If Valtype(aItems[1])<>"A" //Si no es un array cada elemento
MsgStop("Cada elemento de MsgListCheck() ha de ser un array de 2 elementos { .T. o .F., Texto a mostrar}"+CRLF+CRLF+;
"Tipo de datos "+Valtype(aItems))
Return {}
Endif
If nColTotal>0 .And. ValType(aItems[1,nColTotal])<>"N"
LogDebug("Imposible calcular totales en MsgListCheck() con una columna que no es numérica")
nColtotal:=0
Endif
CursorWait()
//Calcula máximo ancho
For nItem:=1 to Len(aItems)
nWidth:=Max(nWidth,Application:oFont:GetTextWidth( aItems[nItem,2] )*1.2)
Next
nWidth+=70
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 366, 427 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText Var oSay SIZE 343, 40 OF oForm VALIGNMENT vaCenter Multiline
oSay:nAnchors:=akALL
WITH OBJECT oTree := TTreeView():New( oForm )
:SetBounds( 10, 50 , 290, 300 )
For nItem:=1 to Len(aItems)
:AddItem( aItems[nItem,2],,,,aItems[nItem,1])
Next
:lCheckBoxes := .T.
:lLinesAtRoot := .F.
:Create()
:nAnchors :=akALL
:OnKeyUp := {|| oForm:cText:=cTitle+" "+SelectItem(oTree, aItems, nColTotal) }
:OnlButtonUp := {|| oForm:cText:=cTitle+" "+SelectItem(oTree, aItems, nColTotal) }
END
@ 60, 305 BUTTON oTodo CAPTION "&Todos" SIZE 50, 25 OF oForm ;
ACTION (oForm:cText:=cTitle+" "+TreeSelectall(oTree,aItems,nColTotal), oTree:Refresh(),oTree:SetFocus())
oTodo:nAnchors:=akRIGHT
oTodo:cToolTip:="Selecciona todos los elementos"
@ 100, 305 BUTTON oNada CAPTION "&Ninguno" SIZE 50, 25 OF oForm ;
ACTION (oForm:cText:=cTitle+" "+TreeUnSelectall(oTree,aItems,nColTotal), oTree:Refresh(),oTree:SetFocus())
oNada:nAnchors:=akRIGHT
oNada:cToolTip:="Ningún elemento seleccionado"
@ 140, 305 BUTTON oInvert CAPTION "In&Vertir" SIZE 50, 25 OF oForm ;
ACTION (oForm:cText:=cTitle+" "+TreeInvert(oTree,aItems,nColTotal), oTree:Refresh(),oTree:SetFocus())
oInvert:nAnchors:=akRIGHT
oInvert:cToolTip:="Invertir elementos seleccionados"
@ 364, 10 BUTTON oAceptar CAPTION LT( XA_MSG_ACEPTAR ) SIZE 70, 25 OF oForm ;
ACTION (lOk := .T., oForm:Close()) Default
oAceptar:nAnchors:=akRIGHT
oAceptar:lDefault:=.t.
If lCANCEL
@ 364, 90 BUTTON oCancelar CAPTION LT( XA_MSG_CANCELAR ) SIZE 70, 25 OF oForm ;
ACTION oForm:Close()
oCancelar:nAnchors:=akRIGHT
Endif
If lPrint
@ 364, 170 BUTTON oImprimir CAPTION LT( XA_MSG_IMPRIMIR ) SIZE 70, 25 OF oForm ;
ACTION IMPARRAY(aItems,,cTitle,cText)
oImprimir:nAnchors:=akRIGHT
Endif
If lExcel
@ 364, 250 BUTTON oExcel CAPTION "Excel" SIZE 70, 25 OF oForm ;
ACTION IMPARRAYExcel(aItems,,cTitle,cText)
oExcel:nAnchors:=akRIGHT
Endif
//Totales iniciales
If nColTotal>0
oForm:cText:=cTitle+" "+Alltrim(Str(TreeTotal(oTree, aItems, nColTotal)))
Endif
oForm:nWidth:=Max(oForm:nWidth,nWidth)
oForm:nWidth:=Min(oForm:nWidth,Screen:nWidth-100)
oTree:OnKeyUp := {|oSender, nKey, nFlags| If(nKey=13, oAceptar:Click(),Nil) }
CursorArrow()
ACTIVATE FORM oForm MODAL CENTER
//Reconstruir tabla a devolver
If lOk
For nItem:=1 to Len(oTree:aItems)
aItems[nItem,1]:=oTree:aItems[nItem]:lChecked
Next
//Si se ha pedido borrar lo que no estan marcados
If lDeleteNoChecked
For nItem:=1 to Len(aItems)
If !aItems[nItem,1]
Adel(aItems,nItem,.T.)
nItem--
Endif
Next
Endif
Else
aItems:={}
Endif
Return aItems
//Seleccionar o deseleccionar un elemento
Static Function SelectItem(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
If nColtotal>0
nTotal:=TreeTotal(oTree, aItems, nColTotal)
Endif
Return If(nColtotal>0,Alltrim(Str(nTotal)),"")
//Botón de seleccionar todos los check
Static Function TreeSelectall(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
CursorWait()
For nItem:=1 to Len(oTree:aItems)
oTree:aItems[nItem]:lChecked:=.T.
If nColtotal>0
nTotal+=aItems[nItem,nColTotal]
Endif
Next
CursorArrow()
Return If(nColtotal>0,Alltrim(Str(nTotal)),"")
//Botón de seleccionar ningun check
Static Function TreeUnSelectall(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
CursorWait()
For nItem:=1 to Len(oTree:aItems)
oTree:aItems[nItem]:lChecked:=.F.
Next
CursorArrow()
Return If(nColtotal>0,"0","")
//Botón de invertir la seleccion de los check
Static Function TreeInvert(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
CursorWait()
For nItem:=1 to Len(oTree:aItems)
oTree:aItems[nItem]:lChecked:=!oTree:aItems[nItem]:lChecked
Next
nTotal:=TreeTotal(oTree, aItems, nColTotal)
CursorArrow()
Return If(nColtotal>0,Alltrim(Str(nTotal)),"")
Static Function TreeTotal(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
If nColtotal=0
Return 0
Endif
CursorWait()
For nItem:=1 to Len(oTree:aItems)
If oTree:aItems[nItem]:lChecked
nTotal+=aItems[nItem,nColTotal]
Endif
Next
CursorArrow()
Return nTotal
//---------------------------------------------------------- --------------------
//Copia archivos de origen a destino mostrando el diálogo de copia animado estandar de Windows
Function MsgCopy(acOrigName, acDestName, cTitle, lFilesOnly, lOkToAll, lAlarm )
Local oFileOperation, aFrom:={}, aTo:={}, lResult:=.F.
Default cTitle To "Copiando archivos"
DEFAULT acOrigName To ""
DEFAULT acDestName To ""
DEFAULT lFilesOnly To .T.
DEFAULT lOkToAll To .T.
DEFAULT lAlarm To .F.
//Cargar los Array
If ValType(acOrigName)="C"
Aadd(aFrom,acOrigName)
ElseIf ValType(acOrigName)="A"
aFrom:=acOrigName
Endif
If ValType(acDestName)="C"
Aadd(aTo,acDestName)
ElseIf ValType(acDestName)="A"
aTo:=acDestName
Endif
WITH OBJECT oFileOperation := TFileOperationDlg():New( Application:oActiveform )
:nAction := foCOPY
:aFrom := aFrom
:aTo := aTo
If cTitle<>""
:cText := cTitle
Endif
:lAutoRename := .F.
:lFilesOnly := lFilesOnly
:lNoConfirmation := lOkToAll
:lNoConfirmMkDir := lOkToAll
:lNoErrorUI := lAlarm
:Create()
lResult:=:Run()
END
If oFileOperation:lAborted
lResult:=.F.
Endif
Return lResult
//---------------------------------------------------------- --------------------
//Mueve archivos de origen a destino mostrando el diálogo de copia animado estandar de Windows
Function MsgMove(acOrigName, acDestName, cTitle, lFilesOnly, lOkToAll, lAlarm )
Local oFileOperation, aFrom:={}, aTo:={}, lResult:=.F.
Default cTitle To "Moviendo archivos"
DEFAULT acOrigName To ""
DEFAULT acDestName To ""
DEFAULT lFilesOnly To .T.
DEFAULT lOkToAll To .T.
DEFAULT lAlarm To .F.
//Cargar los Array
If ValType(acOrigName)="C"
Aadd(aFrom,acOrigName)
ElseIf ValType(acOrigName)="A"
aFrom:=acOrigName
Endif
If ValType(acDestName)="C"
Aadd(aTo,acDestName)
ElseIf ValType(acDestName)="A"
aTo:=acDestName
Endif
WITH OBJECT oFileOperation := TFileOperationDlg():New( Application:oActiveform )
:nAction := foMove
:aFrom := aFrom
:aTo := aTo
If cTitle<>""
:cText := cTitle
Endif
:lAutoRename := .F.
:lFilesOnly := lFilesOnly
:lNoConfirmation := lOkToAll
:lNoConfirmMkDir := lOkToAll
:lNoErrorUI := lAlarm
:Create()
lResult:=:Run()
END
If oFileOperation:lAborted
lResult:=.F.
Endif
Return lResult
//---------------------------------------------------------- --------------------
//Elimina archivos a la papelera mostrando el diálogo de copia animado estandar de Windows
Function MsgDelete(acOrigName, cTitle, lFilesOnly, lOkToAll, lAlarm )
Local oFileOperation, aFrom:={}, aTo:={}, lResult:=.F.
Default cTitle To "Enviando archivos a papelera"
DEFAULT acOrigName To ""
DEFAULT lFilesOnly To .T.
DEFAULT lOkToAll To .T.
DEFAULT lAlarm To .F.
//Cargar los Array
If ValType(acOrigName)="C"
Aadd(aFrom,acOrigName)
ElseIf ValType(acOrigName)="A"
aFrom:=acOrigName
Endif
WITH OBJECT oFileOperation := TFileOperationDlg():New( Application:oActiveform )
:nAction := foDELETE
:aFrom := aFrom
If cTitle<>""
:cText := cTitle
Endif
:lAllowUndo := .T.
:lFilesOnly := lFilesOnly
:lNoConfirmation := lOkToAll
:lNoErrorUI := lAlarm
:Create()
lResult:=:Run()
END
If oFileOperation:lAborted
lResult:=.F.
Endif
Return lResult
//---------------------------------------------------------- ------------------//
Function MsgLogo( cImage, nSeconds )
Local oForm, oImagen, oTimer
DEFAULT nSeconds To 5
DEFINE FORM oForm OF Application:oActiveform BORDERSTYLE bsSPLASH
oForm:oBkgnd := cImage
oForm:SetClientSize( oForm:oBkgnd:nWidth, oForm:oBkgnd:nHeight )
oForm:OnLButtonDown := { || oForm:Close() }
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
Activate Timer oTimer
ACTIVATE FORM oForm MODAL CENTER
DeActivate Timer oTimer
Return Nil
//---------------------------------------------------------- ------------------//
Function MsgDesktop(cText, cTitle, cImage, lFlash )
Local oForm, oImage
Default cText To ""
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default lFlash To .T.
DEFINE FORM oForm TITLE cTitle OF Application ;
SIZE 330, 290 BORDERSTYLE bsDIALOG
If !Empty(cImage)
@ 5,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 5, 55 LABEL cText SIZE 250, 250 OF oForm MultiLine VALIGNMENT vaCenter
Else
@ 5, 10 LABEL cText SIZE 295, 250 OF oForm MultiLine VALIGNMENT vaCenter
Endif
If lFlash
oForm:OnShow := { || oForm:FlashForm(300) }
Endif
ACTIVATE FORM oForm CENTER
SetActiveWindow(GetDesktopWindow())
Return Nil
//---------------------------------------------------------- ------------------//
#pragma BEGINDUMP
#include <windows.h>
#include <xailer.h>
XA_FUNC( FLASHWINDOW )
{
FLASHWINFO fi;
fi.cbSize = sizeof( FLASHWINFO );
fi.hwnd = (HWND) hb_parnl( 1 );
fi.uCount = hb_parnl( 2 );
fi.dwFlags = FLASHW_ALL;
fi.dwTimeout = XA_IsWin9X() ? 0 : 200;
FlashWindowEx( &fi );
}
#pragma ENDDUMP
//---------------------------------------------------------- ------------------//
Function MsgOptions(aOptions, cText, cTitle, cImage, nDefaultOption, nSeconds )
Local oForm, oImage, nOption:=0, nItem:=0, nBtnWidth:=0, aBtn:=Array(Len(aOptions))
Local nBtnPosX:=0, nBtnPosY:=85, cOption:="", oTimer
Local nButtonsWidth:=0, nTextWidth:=0, nFormWidth:=0
Default cText To "Seleccione una opción......"
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default nDefaultOption To 1
Default nSeconds To 0
//Calcular anchura máxima de un botón para igualarlos todos
For nItem:=1 To Len(aOptions)
aOptions[nItem]:=Alltrim(aOptions[nItem])
nBtnWidth:=Max( Application:oFont:GetTextWidth(aOptions[nItem]), nBtnWidth )
Next
nBtnWidth:=nBtnWidth+7
nButtonsWidth:=(Len(aOptions)*(10+nBtnWidth))
For nItem:=1 to Mlcount(cText)
nTextWidth:=Max( Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nItem) )), Application:oFont:GetTextWidth( cTitle )+60 )+10
Next
nFormWidth:=Max(nButtonsWidth+15+If(!Empty(cImage),45,0),nTe xtWidth+20+If(!Empty(cImage),45,0))
nBtnPosX:=(nFormWidth-nButtonsWidth)/2
nTextWidth:=nFormWidth-20-If(!Empty(cImage),45,0)
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE nFormWidth, 155 BORDERSTYLE bsDIALOG
If !Empty(cImage)
@ 20,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 10, 55 LABEL cText SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter MultiLine
Else
@ 10, 10 LABEL cText SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter MultiLine
Endif
For nItem:=1 To Len(aOptions)
@ nBtnPosY, nBtnPosX BUTTON aBtn[nItem] CAPTION aOptions[nItem] SIZE nBtnWidth, 25 OF oForm ;
ACTION ( cOption:=oForm:oActivecontrol:cText, oForm:Close() )
nBtnPosX:=nBtnPosX+10+nBtnWidth
Next
aBtn[nDefaultOption]:SetFocus()
If nSeconds>0
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ;
ACTION ( cOption:=aOptions[nDefaultOption], oForm:Close() )
Activate Timer oTimer
Endif
ACTIVATE FORM oForm MODAL CENTER
If nSeconds>0
DeActivate Timer oTimer
Endif
If !Empty(cOption)
nOption:=Ascan(aOptions,Alltrim(cOption))
Endif
Return nOption
//---------------------------------------------------------- ------------------//
Function MsgRadio(aOptions, cText, cTitle, cImage, nDefaultOption, nSeconds )
Local oForm, oImage, nOption:=0, nItem:=0, oTimer
Local oRadio, nRadioWidth:=0, nRadioHeight:=0
Local nTextWidth:=0, nTextHeight:=0, nFormWidth:=0, nFormHeight:=0
Default cText To "Seleccione una opción......"
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default nDefaultOption To 1
Default nSeconds To 0
//Control de entrada de datos
If Valtype(aOptions)<>"A" .Or. Len(aOptions)=0
LogDebug("Imposible crear un MsgRadio sin un array de opciones")
Return 0
Endif
//Calcular anchura y altura máxima del título
For nItem:=1 to Mlcount(cText)
nTextWidth:=Max( Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nItem) )), Application:oFont:GetTextWidth( cTitle )+60 )+10
Next
nTextHeight:=Application:oFont:GetTextHeight(Memoline(cText, ,1))*Mlcount(cText)
//Calcular anchura máxima de un radio y altura para el radio menu
For nItem:=1 To Len(aOptions)
aOptions[nItem]:=Alltrim(aOptions[nItem])
nRadioWidth:=Max( Application:oFont:GetTextWidth(Alltrim(aOptions[nItem])), nRadioWidth )
Next
nRadioWidth :=nRadioWidth+30 //Espacio para el radio
nRadioHeight:=(Application:oFont:GetTextHeight(Alltrim(aOpti ons[1]))+10)*Len(aOptions)
If Len(aOptions)>10
nRadioWidth := nRadioWidth*2
nRadioHeight:= nRadioHeight/2
Endif
//Altura y anchura del form
nFormWidth:=Max(nRadioWidth,nTextWidth)+If(!Empty(cImage),45 ,0)+50
nFormHeight:=10+nTextHeight+10+nRadioHeight+80
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE Max(nFormWidth,195), nFormHeight BORDERSTYLE bsDIALOG
If !Empty(cImage)
@ 10,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 10, 55 LABEL cText SIZE nTextWidth, nTextHeight OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter
Else
@ 10, 10 LABEL cText SIZE nTextWidth, nTextHeight OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter
Endif
WITH OBJECT oRadio := TRadioMenu():New( oForm )
:SetBounds( If(!Empty(cImage),50,20) , 10+nTextHeight+10 , nRadioWidth, nRadioHeight )
:aItems := aOptions
If Len(aOptions)>10
:nColumns:=2
Endif
:Create()
END
oRadio:nIndex:=nDefaultOption
@ 10+nTextHeight+10+nRadioHeight+10, nFormWidth-180 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION ( nOption:=oRadio:nIndex, oForm:Close() ) Default
@ 10+nTextHeight+10+nRadioHeight+10, nFormWidth-90 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION ( nOption:=0, oForm:Close() )
If nSeconds>0
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ;
ACTION ( nOption:=nDefaultOption, oForm:Close() )
Activate Timer oTimer
Endif
ACTIVATE FORM oForm MODAL CENTER
If nSeconds>0
DeActivate Timer oTimer
Endif
Return nOption
//---------------------------------------------------------- ------------------//
//Mensaje a todos los usuarios de una red
Function NewMsg2All()
Local oForm, lSave := .F., oEdit:=Array(4)
Local cMessage:=Space(250), cFrom:=Space(30), nValidity:=10
//Si no existe el archivo crearlo
If !File("Messages.Dbf")
DbCreate( "Messages.Dbf",;
{ { "Date" , "D", 8, 0 },;
{ "Time" , "C", 5, 0 },;
{ "From" , "C", 30, 0 },;
{ "Message" , "C", 250, 0 },;
{ "ValidDays", "N", 2, 0 },;
{ "IP" , "C", 400, 0 } } , "DBFNTX" )
Endif
DEFINE FORM oForm TITLE "Nuevo mensaje" OF Application:oActiveform ;
SIZE 300, 250 BORDERSTYLE bsDIALOG
@ 5, 10 Label "Texto del Mensaje" SIZE 270, 20 OF oForm
@ 25, 10 Memo oEdit[1] SIZE 270, 60 OF oForm
oEdit[1]:Value:=cMessage
oEdit[1]:nMaxLength := Len(cMessage)
@ 90, 10 Label "Autor" SIZE 270, 20 OF oForm
@ 110, 10 EDIT oEdit[2] SIZE 270, 20 OF oForm
oEdit[2]:Value:=cFrom
oEdit[2]:nMaxLength := Len(cFrom)
@ 150, 10 Label "Días de Validez" SIZE 90, 20 OF oForm
@ 150, 110 MASKEDIT oEdit[3] SIZE 40, 20 OF oForm ALIGNMENT taRight Picture "99"
oEdit[3]:Value:=nValidity
@ 190, 50 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (lSave := .T., oForm:Close()) Default
@ 190, 150 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
ACTIVATE FORM oForm MODAL CENTER
If !lSave
Return Nil
Endif
DbUseArea(.T.,"DBFNTX","Messages.Dbf","Messages")
If NetErr()
Return Nil
Endif
Messages->( DbAppend() )
Messages->Date := Date()
Messages->Time := Time()
Messages->From := oEdit[2]:Value
Messages->Message := oEdit[1]:Value
Messages->ValidDays:= oEdit[3]:Value
Messages->( DbCloseArea() )
Return Nil
//Muestra el mensaje a una IP no mostrada aun
Function Msg2All()
Local cLocalIP:=GetLocalIp()[1], cFinalIP:=SubStr(cLocalIP,Rat(".",cLocalIP))+"."
Local oForm, oEdit, lOk:=.F.
If !File("Messages.Dbf")
Return Nil
Endif
DbUseArea(.T.,"DBFNTX","Messages.Dbf","Messages")
If NetErr()
Return Nil
Endif
Do While !Eof()
If Messages->Date+Messages->ValidDays < Date()
//Borrar mensajes caducados
Do While !Rlock()
Enddo
Messages->(DbDelete())
Else
//Buscar la IP y mostrar el mensaje si no se encuentra
If At( cFinalIP,Messages->IP )=0
DEFINE FORM oForm OF Application:oActiveform ;
SIZE 300, 190 BORDERSTYLE bsDIALOG ;
TITLE "Mensaje de "+Alltrim(Messages->From)+" "+Dtoc(Messages->Date)+" "+Messages->Time
@ 5, 10 Label "Mensaje de "+Alltrim(Messages->From) SIZE 270, 20 OF oForm
@ 25, 10 Label "De fecha "+Dtoc(Messages->Date)+" "+Messages->Time SIZE 270, 20 OF oForm
@ 45, 10 Memo oEdit SIZE 270, 60 OF oForm
oEdit:Value:=Alltrim(Messages->Message)
@ 120, 20 BUTTON CAPTION LT( XA_MSG_IMPRIMIR ) SIZE 80, 25 OF oForm ;
ACTION ( Msg2AllPrn( oForm:cText, Alltrim(Messages->Message) ) )
@ 120,105 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION ( lOk:=.T., oForm:Close() ) Default
@ 120,190 BUTTON CAPTION "Demorar" SIZE 80, 25 OF oForm ;
ACTION oForm:Close() Default
ACTIVATE FORM oForm MODAL CENTER
IF lOk //Mensaje aceptado
Do While !Rlock()
Enddo
Messages->IP := Left(Alltrim(Messages->IP),Len(Alltrim(Messages->IP))-1)+cFinalIP
ENDIF
Endif
Endif
Messages->( DbSkip() )
Enddo
Messages->( DbCloseArea() )
Return Nil
//---------------------------------------------------------- --------------------
#pragma BEGINDUMP
#include "windows.h"
#include "xailer.h"
#include "winsock2.h"
XA_FUNC( GETLOCALIP )
{
WSADATA wsa;
char cHost[256];
struct hostent *h;
int nAddr = 0, n = 0;
WSAStartup( MAKEWORD( 2, 0 ), &wsa );
if( gethostname( cHost, 256 ) == 0 )
{
h = gethostbyname( cHost );
if( h )
while( h->h_addr_list[ nAddr ] )
nAddr++;
}
hb_reta( nAddr );
if( nAddr )
while( h->h_addr_list[n] )
{
char cAddr[256];
wsprintf( cAddr, "%d.%d.%d.%d", (BYTE) h->h_addr_list[n][0],
(BYTE) h->h_addr_list[n][1],
(BYTE) h->h_addr_list[n][2],
(BYTE) h->h_addr_list[n][3] );
hb_storc( cAddr, -1, ++n );
}
WSACleanup();
}
#pragma ENDDUMP
//Prints a Message
Function Msg2AllPrn( cTitle, cText )
Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:=""
Local nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0
CursorWait()
DEFINE FONT oFont NAME "Times New Roman"
Printer:cJobTitle := cTitle
Printer:lPreview := .t.
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmHIMETRICS
Printer:StartPage()
WITH OBJECT Printer:oCanvas
:oFont := oFont
:oPen := oPen
:nMapMode := mmSIMULCHAR
:nTextAlignment:=taCENTER
:oFont:nSize := 14
:oFont:lBold := .T.
:oFont:lUnderline := .T.
:TextOut( 1, 1, cTitle,65, CLR_BLUE)
:oFont:lBold := .F.
:oFont:lUnderline := .F.
:nTextAlignment:=taLEFT
:oFont:nSize := 12
For n:=1 to MlCount(cText,80)
:TextOut( 12, n+4, MemoLine(cText,80,n),80, CLR_BLACK)
Next
END WITH
Printer:EndPage()
Printer:EndDoc()
Printer:Preview()
oFont:Destroy()
CursorArrow()
Return Nil
// Imprime el escritorio completo o el formulario que se indique
// Por ejemplo Hardcopy(Self) imprime el form actual
Function HardCopy( oForm, lPreview, cTitle,nOrientacion )
LOCAL hBitmap, oBitMap,nZoomV,nZoomH
Default lPreview To .T.
Default cTitle To "Impresión de pantalla"
Default nOrientacion to 0 //0.-Auto 1.-Portrait 2.-Landscape
Application:lBusy := .T.
hBitmap := If(oForm=Nil,XA_CaptureBitmap( GetDesktopWindow(),0,0,Screen:PaperRes()[2],Screen:PaperRes( )[1] ),;
XA_CaptureBitmap( oForm:Handle, 0, 0, oForm:nVirtualHeight ,oForm:nVirtualWidth) )
oBitmap := TBitmap():CreateFromHandle( hBitmap )
if oBitMap:nWidth > oBitMap:nHeight
nZoomV := oBitMap:nHeight / oBitMap:nWidth
nZoomH := 1
else
nZoomH := oBitMap:nWidth / oBitMap:nHeight
nZoomV := 1
endif
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
if nOrientacion == 2 .or. (nOrientacion == 0 .and. nZoomH > nZoomV)
Printer:nOrientation := DMORIENT_LANDSCAPE
nOrientacion := 2
else
Printer:nOrientation := DMORIENT_PORTRAIT // LANDSCAPE
endif
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
* Printer:oCanvas:TextOut(cTitle,50,50)
if nOrientacion == 2 //Apaisado
Printer:oCanvas:DrawPicture( { 100,100,Printer:PaperRes()[1]*nZoomH,Printer:PaperRes()[2]*n ZoomV }, oBitmap )
else
Printer:oCanvas:DrawPicture( { 100,100,Printer:PaperRes()[1]*nZoomH,Printer:PaperRes()[1]*n ZoomV }, oBitmap )
endif
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
If lPreview
Printer:Preview()
Endif
oBitmap:Destroy()
DeleteObject( hBitmap )
Return Nil
// Crea un fichero de incidencias y graba las incidencias del programa
Function Incidencia(cMensaje,nLimite)
Local oIncidencia,nTOTAL
DEFAULT nLIMITE To 10
If !FILE(Application:cDirectory+"Incidencias.Ctl")
DbCreate(Application:cDirectory+"Incidencias.Ctl",;
{{"Usuario" ,"C", 25,0},;
{"Fecha" ,"D", 8,0},;
{"Hora" ,"C", 8,0},;
{"Incidencia","C",200,0} })
ENDIF
DbUseArea(.T.,"DBFNTX","Incidencias.Ctl","Incidencias")
Incidencias->( DbAppend() )
Try
Incidencias->USUARIO :=AppData:cUserName
Catch
Incidencias->USUARIO :=NetName(1)
End
Incidencias->FECHA :=DATE()
Incidencias->HORA :=TIME()
Incidencias->Incidencia :=UPPER(cMENSAJE)
//Solo se graban las últimas n incidencias indicadas en nLIMITE
If FLock()
COUNT TO nTOTAL FOR !DELETED()
Do While nTOTAL>nLIMITE
Incidencias->( DbGOTOP() )
Incidencias->( DbDELETE() )
COUNT TO nTOTAL FOR !DELETED()
EndDo
**** Pack
Endif
Incidencias->( DbCloseArea() )
Return Nil
//---------------------------------------------------------- --------------------
#pragma BEGINDUMP
#include <windows.h>
#include <xailer.h>
HB_FUNC( PLAYSOUNDWAIT )
{
char * szSound = hb_parc( 1 );
if( szSound )
hb_retl( PlaySound( szSound, NULL, SND_SYNC | SND_FILENAME | SND_NODEFAULT ) );
}
#pragma ENDDUMP
//---------------------------------------------------------- --------------------
#pragma BEGINDUMP
#include <windows.h>
#include <xailer.h>
HB_FUNC( PLAYSOUND )
{
char * szSound = hb_parc( 1 );
if( szSound )
hb_retl( PlaySound( szSound, NULL, SND_ASYNC | SND_FILENAME | SND_NODEFAULT ) );
}
#pragma ENDDUMP
//---------------------------------------------------------- --------------------
**/
* FUNCION que Envia un Email con la classe TMapi
* @author JJG
* @param aPersonas Array Multidimensional {"Nombre destinatario","Correo Destinatario"} ó Solo "Correo Destinatario"
* @param cAsunto Asunto del Email
* @param cMensaje Mensaje del Email
* @param cDePersona Nombre que aparece como remitente
* @param cDeCorreo Direccion del correo desde la que se envia
* @param aAttach Array de adjuntos o solo un adjunto
* @return lExito .t. ó .f.
*/
Function MsgEmail(aPersonas,cAsunto,cMensaje,cDePersona,cDeCorreo,xAt tach)
Local oMapi
local lExito := .f.
LOCAL aDestinos := {}, aAttach := {}
LOCAL nK
DEFAULT cAsunto TO ""
DEFAULT cMensaje TO ""
DEFAULT cDePErsona TO ""
DEFAULT cDeCorreo TO ""
//--- Definir array a Destinos
if Valtype(aPersonas) == "C"
Aadd(aDestinos,{aPersonas,aPersonas,mapiTO})
Else
for nK := 1 to Len(aPersonas)
Aadd(aDestinos,{aPersonas[nK,1],aPersonas[nK,2],if(nK==1,map iTO,mapiBCC)})
next nK
Endif
//--- Definir array de adjuntos
If xAttach<>Nil
if Valtype(xAttach) == "C"
Aadd(aAttach,{xAttach,xAttach})
Else
for nK := 1 to Len(aAttach)
Aadd(aAttach,{aAttach[nK,1],aAttach[nK,1]})
next nK
Endif
Endif
oMapi := TMapi():New()
Sleep(1000)
If !oMapi:Installed()
MsgInfo("No es posible el envio de email desde este equpo, Revise la configuración de correo electrónico.")
oMapi:Destroy()
RETURN Nil
EndIf
WITH OBJECT oMapi
:Create()
If :Logon()
:cFromName := cDePersona
:cFromAddress := cDeCorreo
:cSubject := cAsunto
:cMessage := cMensaje
If Len(aAttach)>0
:aAttachments :=aAttach
Endif
:lAskRecipients:=.T.
:aReceipts:=aDestinos
If !:Send()
MsgInfo("Error al enviar el correo.","Lo siento...")
lExito := .f.
Endif
:Logoff()
Else
lExito := .f.
Endif
End
RETURN lExito
//---------------------------------------------------------- --------------------
**/
* FUNCION que muestra una panel con un mensaje de gran tamaño y que al pulsar encima se cierra
* @author Bingen
* @param cText Texto a mostrar
* @param cTitle [Opcional] Título de la ventana, por defecto "Un momento por favor..."
* @param nFont [Opcional] Tamaño del font del texto, por defecto 20 y la mitad para el título
* @param nSeconds [Opcional] Segundos antes de cerrar la ventana, por defecto 5. Si se indica 0 no se autocierra.
* @param xColor [Opcional] Color del texto de la ventana, por defecto clBlack, si es un array será el color de letra y el del fondo
*/
Function MsgPanel( cText, cTitle, nFont, nSeconds, xColor )
Local oForm, oTimer, oTitulo, oLabel
Local nHeight:=0, nWidth:=0 , nLine:=0
Local oFont, oFontTitle, nClrText ,nClrPane
Default cTitle To "Un momento por favor..."
DEFAULT nSeconds To 5
Default nFont To 20
Default xColor To clBlack
//Definir fuentes el del título tendrá la mitad de tamaño
oFontTitle:=TFont():Create( "Arial", Max(nFont/2 ,8))
oFont:=TFont():Create( "Arial", nFont )
//Calcular tamaño de la ventana
nHeight:=(oFontTitle:GetTextHeight( "B" )*1.2)+((oFont:GetTextHeight( "B" ))*Mlcount(cText))
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nWidth:=Min(nWidth,Screen:nWidth*0.80)
nWidth:=Max(nWidth,280)
If Valtype(xColor)="A"
nClrText := xColor[1]
nClrPane := xColor[2]
Else
nClrText := xColor
nClrPane := clBtnFace
Endif
//Crear la ventana
DEFINE FORM oForm OF Application:oActiveform BORDERSTYLE bsSPLASH
oForm:SetBounds( 12, 16, nWidth+20, nHeight+20 )
oForm:nClrPane := nClrPane
WITH OBJECT oTitulo := TLabel():New( oForm )
:SetBounds( 0, 0, nWidth , oFontTitle:GetTextHeight( "B" )*1.2 )
:cText := cTitle
:lParentFont :=.F.
:oFont := oFontTitle
:nClrText := nClrText
:nClrPane := nClrPane
:lAutoSize := .F.
:OnLButtonDown := { || oForm:Close() }
:Create()
END
WITH OBJECT oLabel := TLabel():New( oForm )
:SetBounds( 0, oFontTitle:GetTextHeight( "B" )*1.2, nWidth , (oFont:GetTextHeight( "B" ))*Mlcount(cText) )
:cText := cText
:lParentFont :=.F.
:oFont := oFont
:nClrText := nClrText
:nClrPane := nClrPane
:nAlignment := taCENTER
:nVAlignment := vaCENTER
:lAutoSize := .F.
:lMultiLine := .T.
:OnLButtonDown := { || oForm:Close() }
:Create()
END
oForm:OnLButtonDown := { || oForm:Close() }
oForm:OnKeyDown := { |oSender,nKey| If(nKey=13 .Or. nKey=27, oForm:Close(),) }
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
If nSeconds>0
Activate Timer oTimer
Endif
ACTIVATE FORM oForm MODAL CENTER
DeActivate Timer oTimer
oFont:Destroy()
oFontTitle:Destroy()
Return Nil
//---------------------------------------------------------- ------------------//
**/
* FUNCION que muestra un MsgInfo solo para el desarrollador
* @author Bingen
* @param cText Texto a mostrar
*/
Function MsgTest( cText )
Try
If !AppData:lUser
MsgPanel( ToString(cText), "Información para el desarrollador...", 10, 0, {clWhite,clBlack} )
Endif
Catch
MsgInfo(cText)
End
Return Nil
//---------------------------------------------------------- ------------------//
**/
* FUNCION que muestra múltiples mensajes de un array en folders
* @author Bingen
* @param aMensajes Array con los mensajes a mostrar
*/
Function MsgMultiple( aMensajes, cTitle )
Local oItems, nItem, oForm, oFolder, oFolderpage, oMemo
Default cTitle To LT(XA_MSG_WARNING)
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 500, 200+(Len(aMensajes)*20) BORDERSTYLE bsDIALOG
WITH OBJECT oFolder := TFolder():New( oForm )
:nAlign := alCLIENT
:lMultiLine := .T.
:Create()
END
For nItem:=1 to Len(aMensajes)
WITH OBJECT oFolderPage := TFolderPage():New( oFolder )
:cText := "Msg "+AllString(nItem)
:Create()
END
WITH OBJECT oMemo := TMemo():New( oFolderPage )
:nAlign := alCLIENT
:Value := AllString(aMensajes[nItem])
:Create()
END
Next
ACTIVATE FORM oForm MODAL CENTER
Return Nil
//---------------------------------------------------------- ------------------//
* Proyecto: BiSoftLib Librería de propósito general
* Fichero: Messages.prg
* Descripción: Mensajes en general para las aplicaciones
* Autor: Bingen Ugaldebere
* Última revisión: 12/11/2010
*/
#include "Xailer.ch"
#include "Language.ch"
STATIC oFormWait, oPrevForm, oWaitTitle, oWaitSay
CLASS TForm FROM XForm
METHOD FlashForm( nBlinks )
ENDCLASS
METHOD FlashForm( nBlinks ) CLASS TForm
DEFAULT nBlinks TO 10
FlashWindow( Self:Handle, nBlinks )
RETURN Nil
//---------------------------------------------------------- --------------------
Function MsgEdit(cText, cTitle, uVar, cImage, lPASSWORD ,lNoCancel, cPicture)
Local oForm , oEdit, lOk := .f., oImage, uLimitInf:=Nil, uLimitSup:=Nil
Default cText To "Introduzca un valor"
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default lPassWord To .F.
Default lNoCancel To .F.
Default cPicture To "@E 999,999.99"
//Si se recibe un array con 3 números o fechas se consideran valor a mostrar en edición, valor mínimo y valor máximo a cumplir
//Si es un array con textos se mostrará un Combobox
If Valtype(uVar)="A" .And. LEN(uVar)=3 .And. ValType(uVar[1])$"ND" .And. ValType(uVar[2])$"ND" .And. ValType(uVar[3])$"ND"
uLimitInf:=uVar[2]
uLimitSup:=uVar[3]
uVar:=uVar[1]
Endif
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 150 BORDERSTYLE bsDIALOG
If lPassWord
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42, 10 EDIT oEdit SIZE 295, 25 OF oForm PassWord
Else
DO Case
Case ValType(uVar)=="C"
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42, 10 EDIT oEdit SIZE 295, 25 OF oForm
oEdit:nMaxLength := Len(uVar)
Case ValType(uVar)=="N"
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42,105 MASKEDIT oEdit SIZE 120, 25 OF oForm ALIGNMENT taRight Picture cPicture
Case ValType(uVar)=="D"
@ 15, 30 LABEL cText SIZE 140, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 25,170 DATEEDIT oEdit SIZE 95, 25 OF oForm
Case ValType(uVar)=="L"
@ 35, 15 CHECKBOX oEdit SIZE 25, 25 OF oForm
@ 22, 40 LABEL cText SIZE 260, 40 OF oForm VALIGNMENT vaCenter MultiLine
If uVar
oEdit:lChecked:=.T.
Endif
Case ValType(uVar)=="A"
@ 1, 10 LABEL cText SIZE 295, 40 OF oForm VALIGNMENT vaCenter MultiLine
@ 42, 10 COMBOBOX oEdit SIZE 295, 25 OF oForm iTEMS uVar Style csDROPDOWNLIST
OtherWise
MsgInfo("No se puede editar un valor de tipo "+Valtype(uVar))
EndCase
Endif
If ValType(uVar)$"CND"
oEdit:Value:=uVar
Endif
If !Empty(cImage)
@ 70,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
Endif
If lNoCancel
@ 80, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (If(ValType(uVar)="L" .Or. (ValType(uVar)<>"L" .And. MsgEditValid(oEdit:Value, uLimitInf, uLimitSup)),;
(lOk := .T., oForm:Close()),;
(oEdit:SetFocus(),oEdit:SelectAll())) ) Default
Else
@ 80, 60 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (If(ValType(uVar)$"LA" .Or. (ValType(uVar)$"CND" .And. MsgEditValid(oEdit:Value, uLimitInf, uLimitSup)),;
(lOk := .T., oForm:Close()),;
(oEdit:SetFocus(),oEdit:SelectAll())) ) Default
@ 80, 180 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
ACTIVATE FORM oForm MODAL CENTER
If lOk
If ValType(uVar)$"CND"
uVar:=oEdit:Value
ElseIf ValType(uVar)="L"
uVar:=oEdit:lChecked
Else
uVar:={oEdit:nIndex,oEdit:cText}
Endif
Endif
Return lOk
Static Function MsgEditValid(uValue, uLimitInf, uLimitSup)
If uLimitInf=Nil .And. uLimitSup=Nil
Return .T.
Endif
If uLimitInf<>Nil .And. uValue<uLimitInf
MsgInfo("El límite inferior es "+ToString( uLimitInf ),"Valor incorrecto")
Return .F.
Endif
If uLimitSup<>Nil .And. uValue>uLimitSup
MsgInfo("El límite superior es "+ToString( uLimitSup ),"Valor incorrecto")
Return .F.
Endif
Return .T.
//---------------------------------------------------------- --------------------
Function MsgLimit(cText, cTitle, uVarIni, uVarFin, cPicture, cTextIni, cTextFin, cImage, lNoCancel)
Local oForm , oIni, oFin, lOk := .f., oImage
Default cText To "Introduzca valores"
Default cTitle To LT(XA_MSG_WARNING)
Default cTEXTINI To "DESDE ......................."
Default cTEXTFIN To "HASTA ......................."
Default lNoCancel To .F.
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 175 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText SIZE 295, 35 OF oForm VALIGNMENT vaCenter
@ 43, 10 LABEL cTextIni SIZE 155, 25 OF oForm
@ 73, 10 LABEL cTextFin SIZE 155, 25 OF oForm
@ 40, 170 MaskEdit oIni SIZE 90, 25 OF oForm
@ 70, 170 MaskEdit oFin SIZE 90, 25 OF oForm
If cPicture<>Nil
oIni:cPicture:=cPicture
oFin:cPicture:=cPicture
Endif
oIni:Value:=uVarIni
oFin:Value:=uVarFin
If !Empty(cImage)
@ 100, 10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
Endif
If lNoCancel
@ 110, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (lOk := .T., oForm:Close()) Default
Else
@ 110, 60 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (lOk := .T., oForm:Close()) Default
@ 110, 180 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
ACTIVATE FORM oForm MODAL CENTER
If lOk
uVarIni:=oIni:Value
uVarFin:=oFin:Value
Endif
Return lOk
//---------------------------------------------------------- --------------------
Function MsgDate(cText, cTitle, uVarIni, uVarFin, cTextIni, cTextFin, cImage, lNoCancel)
Local oForm , oIni, oFin, lOk := .f., oImage
Local cTxtError:="Rango de fechas incorrecto"
Default cText To "Límites de fechas"
Default cTitle To "Introduzca fechas"
Default cTEXTINI To "DESDE ......................."
Default cTEXTFIN To "HASTA ......................."
Default lNoCancel To .F.
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 175 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText SIZE 295, 35 OF oForm VALIGNMENT vaCenter
@ 43, 10 LABEL cTextIni SIZE 155, 25 OF oForm
@ 73, 10 LABEL cTextFin SIZE 155, 25 OF oForm
@ 40, 170 DateEdit oIni SIZE 90, 25 OF oForm
@ 70, 170 DateEdit oFin SIZE 90, 25 OF oForm
oIni:Value:=uVarIni
oFin:Value:=uVarFin
If !Empty(cImage)
@ 100, 10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
Endif
If lNoCancel
@ 110, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION If(oFin:Value>=oIni:Value,(lOk := .T., oForm:Close()),;
(MsgInfo(cTxtError) , MsgSound()) ) Default
Else
@ 110, 60 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION If(oFin:Value>=oIni:Value,(lOk := .T., oForm:Close()),;
(MsgInfo(cTxtError) , MsgSound()) ) Default
@ 110, 180 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
ACTIVATE FORM oForm MODAL CENTER
If lOk
uVarIni:=oIni:Value
uVarFin:=oFin:Value
Endif
Return lOk
//---------------------------------------------------------- --------------------
Function MsgMemo(cText, cTitle, lEditable)
Local oForm , oMemo , lOk := .f., cInitText:=cText
Local nHeight:=0, nWidth:=0, nLine:=1
Default cTitle To LT(XA_MSG_WARNING)
Default lEditable To .F.
nHeight:=Min((Application:oFont:GetTextHeight( cTitle )*1.2)*Mlcount(cText),Screen:nHeight*0.70)
nHeight:=Max(nHeight,50)
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nWidth:=Min(nWidth,Screen:nWidth*0.80)
nWidth:=Max(nWidth,280)
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE nWidth+22, nHeight+90 BORDERSTYLE bsDIALOG
@ nHeight+20, (nWidth+22)-180 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (cText:=oMemo:Value, lOk := .T., oForm:Close()) Default
If lEditable
@ nHeight+20,(nWidth+22)-90 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
Endif
@ 10, 10 MEMO oMemo PROMPT cText SIZE nWidth, nHeight OF oForm
oMemo:lReadOnly:=!lEditable
If !oMemo:lReadOnly .And. Len(Alltrim(cText))=0
oMemo:SetFocus()
Endif
ACTIVATE FORM oForm MODAL CENTER
Return If(lOk, cText, If(!lEditable,.F.,cInitText) )
//---------------------------------------------------------- --------------------
Function MsgWait(cText, cTitle, nSeconds, cImage, cSound )
Local oForm, oImage, oTimer
Local nWidth:=0, nHeight:=0, nLine:=1
Local nTitleWidth:=0, nTitleHeight:=0
Local nTextWidth :=0, nTextHeight :=0
Local nTotalWidth:=0, nTotalHeight:=0
Default cText To ""
Default cTitle To "Espere un momento por favor..."
Default cImage To ""
Default nSeconds To 2
Default cSound To ""
//Calcular tamaños respecto al fuente
nTitleWidth:=Application:oFont:GetTextWidth( cTitle )*1.2
nTitleHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nTotalHeight:=Max( (nHeight*(Mlcount(cText)+1))+35 , If(!Empty(cImage),85,0) )
nWidth:=nTitleWidth
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nTotalWidth:=nWidth+If(!Empty(cImage),55,0)+20
nTotalWidth:=If( nTotalWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nTotalWidth )
Application:lBusy:=.T.
DEFINE FORM oForm SIZE nTotalWidth,nTotalHeight BORDERSTYLE bsSPLASH Of Application:oActiveform
@ 1, 5 LABEL cTitle SIZE nTitleWidth, nTitleHeight OF oForm
If !Empty(cImage)
@ 30,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ nHeight+10, 55 LABEL cText SIZE nWidth,nHeight*Mlcount(cText) OF oForm VALIGNMENT vaCenter
Else
@ nHeight+10, 10 LABEL cText SIZE nWidth,nHeight*Mlcount(cText) OF oForm VALIGNMENT vaCenter
Endif
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
Activate Timer oTimer
If !Empty(cSound)
PlaySound(cSound)
Endif
ACTIVATE FORM oForm MODAL CENTER
DeActivate Timer oTimer
Application:lBusy:=.F.
Return Nil
//---------------------------------------------------------- --------------------
Function MsgPostit(cText, cTitle, cImage, lFlash, nColor, cSound )
Local oForm, oImage
Default cText To ""
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default lFlash To .T.
Default nColor To CLR_YELLOW
Default cSound To ""
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 320, 280 BORDERSTYLE bsTOOLWINDOW Color CLR_BLACK,nColor
If !Empty(cImage)
@ 5,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 5, 55 LABEL cText SIZE 250, 250 OF oForm MultiLine VALIGNMENT vaCenter
Else
@ 5, 10 LABEL cText SIZE 295, 250 OF oForm MultiLine VALIGNMENT vaCenter
Endif
If !Empty(cSound)
PlaySound(cSound)
Endif
If lFlash
oForm:OnShow := { || oForm:FlashForm(300) }
Endif
ACTIVATE FORM oForm MODAL CENTER
Return Nil
//---------------------------------------------------------- --------------------
Function MsgSound( cSound )
Default cSound To GetWindowsDirectory()+"MediaChord.Wav"
PlaySound(cSound)
Return Nil
//---------------------------------------------------------- ------------------//
Function MsgToolTip(oSender, cText, cTitle, nColor, nSeconds )
Local oForm, oTitle, oText, oTimer
Local nWidth, nHeight, n:=1, nLines:=1
Local nXPos:=0, nYPos:=0
Default cText To ""
Default cTitle To ""
Default nColor To CLR_YELLOW
Default nSeconds To 3
cText :=Alltrim(cText)
cTitle :=Alltrim(cTitle)
//Calcular tamaño respecto al fuente
nHeight:=Application:oFont:GetTextHeight( " " )*1.2
For n:=1 to Mlcount(cText)
nWidth:=Max( Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,n) )), Application:oFont:GetTextWidth( cTitle ) )+60
Next
nWidth:=If( nWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nWidth )
nLines:=MlCount(cText)+If(Len(cTitle)>0,1,0)
//Cálculo de posicionamiento
Do Case
Case oSender:IsKindOf( "TBevel" ) .Or. ;
oSender:IsKindOf( "TGroupbox" ) .Or. ;
oSender:IsKindOf( "TPages" ) .Or. ;
oSender:IsKindOf( "TArrayBrowse" )
nXPos:=oSender:nLeft+(oSender:nWidth)
nYPos:=oSender:nTop+(oSender:nHeight)
Otherwise
nXPos:=oSender:nLeft+(oSender:nWidth/2)
nYPos:=oSender:nTop+(oSender:nHeight*2)
EndCase
//Reposicionamiento si el tooltip se va a salir de la pantalla
Do While Application:oActiveform:nTop+nYPos+nHeight*(nLines+1)>Screen:nHeight
--nYpos
EndDo
Do While Application:oActiveform:nLeft+nXPos+nWidth+30>Screen:nWidth
--nXpos
EndDo
//Mostrar falso tooltip en ventana
DEFINE FORM oForm From Application:oActiveform:nTop+nYPos, Application:oActiveform:nLeft+nXPos ;
SIZE nWidth+30,nHeight*(nLines+1) BORDERSTYLE bsSPLASH ;
Color CLR_BLACK,nColor Of Application:oActiveform
If Len(cTitle)>0
@ 0,5 Label cTitle VAR oTitle Size nWidth,nHeight Of oForm
oTitle:OnCLick:={|| oForm:Close() }
@ nHeight+.5,5 Label cText VAR oText Size nWidth,nHeight*(nLines-1) Of oForm Alignment taCenter
Else
@ nHeight/2,5 Label cText VAR oText Size nWidth,nHeight*nLines Of oForm Alignment taCenter
Endif
oText:OnCLick:={|| oForm:Close() }
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
Activate Timer oTimer
oForm:OnCLick:={|| oForm:Close() }
ACTIVATE FORM oForm modal
DeActivate Timer oTimer
Return Nil
//---------------------------------------------------------- ------------------//
************************************************************ ***
* MENSAJE QUE QUEDA PERMANENTE EN PANTALLA MIENTRAS SE HACE *
* CUALQUIER OTRO PROCESO Y HASTA QUE SE EJECUTE WAITOFF() *
************************************************************ ***
FUNCTION WaitOn( cText, cTitle, cImage, cSound )
Local oImage
Local nWidth:=0, nHeight:=0, nLine:=1
Local nTitleWidth:=0, nTitleHeight:=0
Local nTextWidth :=0, nTextHeight :=0
Local nTotalWidth:=0, nTotalHeight:=0
Default cText To ""
Default cTitle To "Espere un momento por favor..."
Default cImage To ""
Default cSound To ""
If Application:oActiveform<>Nil
oPrevForm:=Application:oActiveform
oPrevForm:lEnabled := .F.
Endif
Application:lBusy :=.T.
cText :=Alltrim(cText)
cTitle :=Alltrim(cTitle)
//Calcular tamaños respecto al fuente
nTitleWidth:=Application:oFont:GetTextWidth( cTitle )*1.2
nTitleHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nTotalHeight:=Max( (nHeight*(Mlcount(cText)+1))+35 , If(!Empty(cImage),85,0) )
nWidth:=nTitleWidth
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nTotalWidth:=nWidth+If(!Empty(cImage),55,0)+20
nTotalWidth:=If( nTotalWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nTotalWidth )
//Si no se ha llamado a Waitoff antes de un segundo WaitOn se provoca
If Valtype(oFormWait) <> 'U'
WaitOff()
EndIf
//Ventana de mensaje con espera hasta que se ejecuta WaitOff
DEFINE FORM oFormWait SIZE nTotalWidth,nTotalHeight BORDERSTYLE bsSPLASH Of Application:oActiveform
@ 1, 5 LABEL cTitle VAR oWaitTitle SIZE nTitleWidth, nTitleHeight OF oFormWait
If !Empty(cImage)
@ 30,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oFormWait
@ nHeight+10, 55 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Else
@ nHeight+10, 10 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Endif
If !Empty(cSound)
PlaySound(cSound)
Endif
ACTIVATE FORM oFormWait CENTER
Return Nil
************************************************************ *****
* MENSAJE CON BARRA DE PROGRESO QUE QUEDA EN PANTALLA MIENTRAS *
* SE HACE OTRO PROCESO Y HASTA QUE SE EJECUTE WAITOFF() *
************************************************************ *****
FUNCTION WaitOnMeter( cText, cTitle, nTotalValue, cImage, cSound )
Local oImage
Local nWidth:=0, nHeight:=0, nLine:=1
Local nTitleWidth:=0, nTitleHeight:=0
Local nTextWidth :=0, nTextHeight :=0
Local nTotalWidth:=0, nTotalHeight:=0
Default cText To ""
Default cTitle To "Espere un momento por favor..."
Default nTotalValue To 100
Default cImage To ""
Default cSound To ""
If Application:oActiveform<>Nil
oPrevForm:=Application:oActiveform
oPrevForm:lEnabled := .F.
Endif
Appdata:AddData("oWaitOnMeter",Nil)
Application:lBusy :=.T.
cText :=Alltrim(cText)
cTitle :=Alltrim(cTitle)
//Calcular tamaños respecto al fuente
nTitleWidth:=Application:oFont:GetTextWidth( cTitle )*1.2
nTitleHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nHeight:=Application:oFont:GetTextHeight( cTitle )*1.2
nTotalHeight:=Max( (nHeight*(Mlcount(cText)+1))+35 , If(!Empty(cImage),85,0) )
nWidth:=nTitleWidth
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nTotalWidth:=nWidth+If(!Empty(cImage),55,0)+20
nTotalWidth:=If( nTotalWidth>=Screen:nWidth, Application:oMainform:nClientWidth-60, nTotalWidth )
//Si no se ha llamado a Waitoff antes de un segundo WaitOn se provoca
If Valtype(oFormWait) <> 'U'
WaitOff()
EndIf
//Ventana de mensaje con barra de progreso en espera hasta que se ejecuta WaitOff
DEFINE FORM oFormWait SIZE nTotalWidth,nTotalHeight+20 BORDERSTYLE bsSPLASH Of Application:oActiveform
@ 1, 5 LABEL cTitle VAR oWaitTitle SIZE nTitleWidth, nTitleHeight OF oFormWait
If !Empty(cImage)
@ 30,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oFormWait
@ nHeight+10, 55 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Else
@ nHeight+10, 10 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText) Of oFormWait Alignment taCenter
oWaitSay:nVAlignment:=vaCenter
Endif
If !Empty(cSound)
PlaySound(cSound)
Endif
@ nTotalHeight-10 , 10 PROGRESSBAR Appdata:oWaitOnMeter OF oFormWait ;
SIZE nTotalWidth-25, 15 ;
RANGE 0, nTotalvalue ;
SMOOTH
Appdata:oWaitOnMeter:nStep:=nTotalValue/100
Appdata:oWaitOnMeter:nValue=0
ACTIVATE FORM oFormWait CENTER
Return Nil
// PARA CERRAR EL WAITON()
//Solo se puede usar si antes se ha llamado antes a WaitOn
FUNCTION WAITOFF()
If Valtype(oFormWait) <> 'U'
oFormWait:Close()
oFormWait := Nil
ENDIF
If Valtype(oPrevForm) <> 'U'
oPrevForm:lEnabled:=.T.
oPrevForm := Nil
ENDIF
Application:lBusy:=.F.
Return Nil
//---------------------------------------------------------- --------------------
// Graba directamente al disco un mensaje línea a línea sin
// cargarlo previamente a una variable asi no hay problema
// de exceder el tamaño de cadena en la variable
//---------------------------------------------------------- --------------------
Function MsgSave( xText, cNomFile ,lCreate)
Local nHd
Local cText := ToString( xText )
Default cNomFile To "Message.Txt"
Default lCreate To .F.
If Empty( cText )
Return ( .F. )
EndIf
If lCreate .And. File( cNomFile )
Ferase( cNomFile )
EndIf
If !File( cNomFile )
nHd := FCreate( cNomFile )
If FError() != 0
MsgBeep()
return ( .F. )
EndIf
Else
nHd := FOpen( cNomFile, 2 )
If FError() != 0
MsgBeep()
return ( .F. )
EndIf
FSeek( nHd, 0, 2 ) //Al final del archivo
If ( FWrite( nHd, CRLF ) != 2 ) //una línea nueva
MsgBeep()
Return ( .F. )
EndIf
EndIf
If ( FWrite( nHd, cText ) != len(cText) ) //Escribe texto en una linea nueva
MsgBeep()
Return ( .F. )
EndIf
FClose( nHd )
Return .T.
//---------------------------------------------------------- --------------------
* MUESTRA UN ARRAY POR PANTALLA O IMPRESORA *
//---------------------------------------------------------- --------------------
FUNCTION MsgArray(aItems,aHeads,cText,cTitle,lCancel,lPrint,lFilterBa r,lRecno,lExcel )
Local oForm, oBTN1, oBTN2, oBrw, lOK:=.F., aArray:={}, oSay
Local oAceptar, oCancelar, oImprimir, oExcel
Local nAt:=0, oFilter, nWidth:=0, nCol:=0
DEFAULT aHeads To {}
DEFAULT cText To ""
DEFAULT cTitle To "Listado del contenido de la tabla"
DEFAULT lCancel To .T.
DEFAULT lPrint To .T.
DEFAULT lFilterbar To .F.
DEFAULT lRecNo To .F.
DEFAULT lExcel To .F.
//Controles previos
If Len(aItems)=0 //Si esta vacio
LogDebug("Imposible mostrar ARRAY vacio en MsgArray()")
Return 0
Endif
If Valtype(aItems)<>"A" //Si no es un array
MsgStop("Imposible mostrar datos que no son un ARRAY en MsgArray()"+CRLF+CRLF+;
"Tipo de datos "+Valtype(aItems))
Return 0
Endif
CursorWait()
If Valtype(aItems[1])="A" //Array de 2 dimensiones lo clono como está
aArray:=aClone(aItems)
Else //Array de 1 dimensión no vale lo convierto en 2
For nAt:=1 To Len(aItems)
Aadd(aArray,{aItems[nAt]})
Next
Endif
//Creo cabeceras para las columnas si no las tienen
Do While Len(aHeads)<Len(aArray[1])
Aadd(aHeads,If(Len(aArray[1])>2,"Col_"+StrZero(++nCol,2), ""))
EndDo
If !lRecNo //Si no se ha suministrado la primera columna con RecNo()
For nAt:=1 To Len(aItems) //Aumentar el array en 1 elemento mas para meter el ordinal
ASize(aArray[nAt],Len(aArray[nAt])+1)
aArray[nAt,Len(aArray[nAt])]:=nAt
Next
nAt:=0
Endif
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 366, 427 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText Var oSay SIZE 343, 40 OF oForm VALIGNMENT vaCenter Multiline
oSay:nAnchors:=akALL
@ 45, 10 ARRAYBROWSE oBrw Size 343,300 Items aArray Headers aHeads OF oForm
oBrw:nAnchors:=akALL
oBrw:DelCol(Len(aArray[1]))
oBrw:lRecordSelector :=.F.
oBrw:lHeader :=!(Len(aHeads)=0)
oBrw:nMarqueeStyle :=bmHIGHLROWRC
oBrw:nClrAltPane :=clLtGray
oBrw:OnDblClick :={|| (lOk := .T., nAt:=If(oBrw:nArrayOrgAt()<>0,oBrw:nArrayOrgAt(),oBrw:nArrayAt), oForm:Close()) }
@ 364, 10 BUTTON oAceptar CAPTION LT( XA_MSG_ACEPTAR ) SIZE 70, 25 OF oForm ;
ACTION oBrw:OnDblClick() Default
oAceptar:nAnchors:=akRIGHT
oAceptar:lDefault:=.t.
If lCANCEL
@ 364, 90 BUTTON oCancelar CAPTION LT( XA_MSG_CANCELAR ) SIZE 70, 25 OF oForm ;
ACTION oForm:Close()
oCancelar:nAnchors:=akRIGHT
Endif
If lPrint
@ 364, 170 BUTTON oImprimir CAPTION LT( XA_MSG_IMPRIMIR ) SIZE 70, 25 OF oForm ;
ACTION IMPARRAY(aItems,aHeads,cTitle,cText,oBrw)
oImprimir:nAnchors:=akRIGHT
Endif
If lExcel
@ 364, 250 BUTTON oExcel CAPTION "Excel" SIZE 70, 25 OF oForm ;
ACTION IMPARRAYExcel(aItems,aHeads,cTitle,cText)
oExcel:nAnchors:=akRIGHT
Endif
If Len(aHeads)>0
For nAt:=1 To Len(oBrw:aCols)
oBrw:aCols[nAt]:AdjustWidth()
nWidth:=nWidth+oBrw:aCols[nAt]:nWidth+9
Next
Endif
If lFilterBar
@ 345, 10 CHECKBOX oFilter Caption "Permitir búsquedas por filtro" SIZE 170, 20 OF oForm
oFilter:lChecked := .T.
oBrw:lFilterBar := .T.
oFilter:onClick := {|| oBrw:lFilterBar:=!oBrw:lFilterBar}
Endif
oBrw:lAutoOrder:=.t.
oForm:nWidth:=Max(oForm:nWidth,nWidth)
oForm:nWidth:=Min(oForm:nWidth,Screen:nWidth-100)
oBrw:OnKeyUp := {|oSender, nKey, nFlags| If(nKey=13, oBrw:OnDblClick(),Nil) }
ACTIVATE FORM oForm MODAL CENTER
CursorArrow()
Return If(lOk,nAt,0)
******* IMPRIMIR ARRAY
STATIC FUNCTION IMPARRAY(aItems,aHeads,cTitle,cText,oBrw)
Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:=""
Local aDatos:={}, aLen:={}, nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0
DEFAULT aHeads To {}
//Intentar imprimir con FR o si no con Xailer
Try
oBrw:FastReport(,cTitle)
Catch
CursorWait()
//Calcular Numero de columnas e inicializar longitudes de columna
aSize(aLen,If(ValType(aItems[1])="A",Len(aItems[1]),1))
aFill(aLen,0)
//Si no hay cabeceras crear un array de cabeceras a ""
If Len(aHeads)=0
aSize(aHeads,Len(aLen))
aFill(aHeads,"")
EndIf
//Calcular anchura máxima de cada columna
For nC:=1 to Len(aLen)
If Len(aLen)=1
aLen[nC]:=Max(aLen[nC],Len(Alltrim(ToString(aItems[nC]))))
Else
For nL:=1 to Len(aItems)
aLen[nC]:=Max(aLen[nC],Len(Alltrim(ToString(aItems[nL,nC]))) )
aLen[nC]:=Max(aLen[nC],Len(Alltrim(aHeads[nC])))
Next
Endif
Next
//Si hay cabeceras crear el literal de cabecera
If Len(aHeads)>0
For nC:=1 to Len(aLen)
cHead:=cHead+PadR(aHeads[nC],aLen[nC])+" "
Next
Endif
//Crear el literal de cada línea del Array y cargar a aDatos
For nL:=1 to Len(aItems)
cTexto:=""
If Len(aLen)=1
cTexto:=cTexto+ToString(aItems[nL])
Else
For nC:=1 to Len(aLen)
Do Case
Case ValType(aItems[nL,nC])="C"
cTexto:=cTexto+PadR(aItems[nL,nC],aLen[nC])+" "
Case ValType(aItems[nL,nC])="N"
cTexto:=cTexto+Padl(Alltrim(Str(aItems[nL,nC])),aLen[nC])+" "
Case ValType(aItems[nL,nC])="D"
cTexto:=cTexto+PadR(Dtoc(aItems[nL,nC]),10)+" "
EndCase
Next
Endif
Aadd(aDatos,cTexto)
Next
//Comienza impresión
DEFINE FONT oFont NAME "COURIER NEW"
Printer:cJobTitle := cTitle
Printer:lPreview := .t.
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmHIMETRICS
Do While !lSalir
Printer:StartPage()
WITH OBJECT Printer:oCanvas
:oFont := oFont
:oPen := oPen
:nMapMode := mmSIMULCHAR
:nTextAlignment:=taCENTER
:oFont:nSize := 14
:oFont:lBold := .T.
:oFont:lUnderline := .T.
:TextOut( 1, 1, cTitle,70, CLR_BLUE)
:nTextAlignment:=taLEFT
:oFont:nSize := 12
:TextOut( 2.5, 3, AllTrim(cHead),30, CLR_BLACK)
:oFont:lBold := .F.
:oFont:lUnderline := .F.
For n := 1 to :TextLines()-5
If ++nItem<=Len(aDatos)
:TextOut( 2.5, n+4, aDatos[nItem],30, CLR_BLACK)
Else
lSalir:=.T.
Exit
Endif
Next
:nTextAlignment:=taCENTER
:TextOut( 1, :TextLines(), "- "+Alltrim(ToString(++nNumpage))+" -",80, CLR_BLUE)
END WITH
Printer:EndPage()
Enddo
Printer:EndDoc()
Printer:Preview()
oFont:Destroy()
CursorArrow()
End
Return Nil
******* IMPRIMIR ARRAY A EXCEL
STATIC FUNCTION IMPARRAYEXCEL(aItems,aHeads,cTitle,cText)
Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:=""
LOCAL oExcel, oWorkBook, oSheet, oClp
Local aDatos:={}, nLen:=0, nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0
DEFAULT aHeads To {}
CursorWait()
//Calcular Numero de columnas e inicializar longitudes de columna
nLen:=If(ValType(aItems[1])="A",Len(aItems[1]),1)
TRY
oExcel := GetActiveObject( "Excel.Application" )
CATCH
TRY
oExcel := CreateObject( "Excel.Application" )
CATCH
Alert( "ERROR! Excel no disponible. [" + Ole2TxtError()+ "]" )
RETURN .F.
END
END
TRY
oWorkBook := oExcel:Workbooks:Add()
oSheet := oWorkBook:WorkSheets( 1 )
CATCH
Alert( "ERROR! Hoja Excel no disponible. [" + Ole2TxtError()+ "]" )
oExcel := NIL
RETURN .F.
END
oClp := TClipboard():Create( )
// Titulares
oSheet:Cells( 1, 1 ):Value := cTitle
oSheet:Cells( 1, 1 ):Font:Bold := .T.
oSheet:Cells( 1, 1 ):Font:Size := 14
oSheet:Cells( 2, 1 ):Value := cText
oSheet:Cells( 2, 1 ):Font:Bold := .T.
oSheet:Cells( 2, 1 ):Font:Size := 14
oSheet:Cells( 1, 1 ):HorizontalAlignment := 3 //Center
oSheet:Cells( 2, 1 ):HorizontalAlignment := 3 //Center
oSheet:Range( "A1:"+ExcelColumn(nLen)+"1" ):Merge( .T. )
oSheet:Range( "A2:"+ExcelColumn(nLen)+"2" ):Merge( .T. )
//Cabeceras de columna
For nC:=1 to Len(aHeads)
oSheet:Cells( 4, nC ):Value:=aHeads[nC]
oSheet:Cells( 4, nC ):HorizontalAlignment := 3 //Center
oSheet:Cells( 4, nC ):Font:Bold := .T.
oSheet:Cells( 4, nC ):Interior:Color := clLtGray
Next
//Lineas de datos
For nL:=1 to Len(aItems)
For nC:=1 to nLen
Do Case
Case ValType(aItems[nL,nC])="C"
oSheet:Cells( 4+nL, nC ):Value:=aItems[nL,nC]
Case ValType(aItems[nL,nC])="N"
oSheet:Cells( 4+nL, nC ):Value:=Alltrim(TransForm(aItems[nL,nC],"@E 999,999,999.99999999"))
Case ValType(aItems[nL,nC])="D"
oSheet:Cells( 4+nL, nC ):Value:=Dtoc(aItems[nL,nC])
EndCase
Next
Next
// Autoajustar columnas del rango
oSheet:Columns( "A:"+ExcelColumn(nLen) ):AutoFit()
//Mostrar hoja
oExcel:Visible := .T.
oSheet := NIL
oWorkBook := NIL
oExcel := NIL
oClp:End()
ProcessMessages()
CursorArrow()
Return Nil
//Cálculo de la letra de columna de Excel en base a su ordinal
Static Function ExcelColumn(nCol)
Local cCol:="", nResto:=0
If nCol=0 .Or. nCol>256
MsgInfo("Valor de columna "+Tostring(nCol)+" fuera de rango 1-256")
Return ""
Endif
If nCol<=26 //Hasta la columna 26 letra de la A a la Z
cCol:=Chr(64+nCol)
Else
//Por encima de la col 26 doble letra
If Mod(nCol,26)>0 //Si hay resto de dividir por 26
cCol:=Chr(64+(Int(nCol/26))) //Primera letra parte entera
cCol:=cCol+Chr(64+Mod(nCol,26)) //Segunda letra por el resto
Else
cCol:=Chr(64+(Int(nCol/26))-1) //Sin resto es la última de la serie anterior
cCol:=cCol+"Z" //y por lo tanto termina en Z
Endif
Endif
Return cCol
//---------------------------------------------------------- --------------------
* MUESTRA UN TREE CON CHECKBOX DE SELECCIÓN *
//---------------------------------------------------------- --------------------
FUNCTION MsgListCheck(aItems,cText,cTitle,lCancel,lPrint,lExcel,lDele teNoChecked, nColTotal )
Local oForm, oBTN1, oBTN2, oTree, lOK:=.F., aArray:={}, oSay, oTotal
Local oAceptar, oCancelar, oImprimir, oExcel, oTodo, oNada, oInvert
Local nWidth:=0, nItem:=0
DEFAULT cText To ""
DEFAULT cTitle To "Seleccione elementos deseados"
DEFAULT lCancel To .T.
DEFAULT lPrint To .T.
DEFAULT lExcel To .F.
DEFAULT lDeleteNoChecked To .F.
DEFAULT nColTotal To 0
//Controles previos
If Len(aItems)=0 //Si esta vacio
LogDebug("Imposible mostrar ARRAY vacio en MsgListCheck()")
Return {}
Endif
If Valtype(aItems)<>"A" //Si no es un array
MsgStop("Imposible mostrar datos que no son un ARRAY en MsgListCheck()"+CRLF+CRLF+;
"Tipo de datos "+Valtype(aItems))
Return {}
Endif
If Valtype(aItems[1])<>"A" //Si no es un array cada elemento
MsgStop("Cada elemento de MsgListCheck() ha de ser un array de 2 elementos { .T. o .F., Texto a mostrar}"+CRLF+CRLF+;
"Tipo de datos "+Valtype(aItems))
Return {}
Endif
If nColTotal>0 .And. ValType(aItems[1,nColTotal])<>"N"
LogDebug("Imposible calcular totales en MsgListCheck() con una columna que no es numérica")
nColtotal:=0
Endif
CursorWait()
//Calcula máximo ancho
For nItem:=1 to Len(aItems)
nWidth:=Max(nWidth,Application:oFont:GetTextWidth( aItems[nItem,2] )*1.2)
Next
nWidth+=70
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 366, 427 BORDERSTYLE bsDIALOG
@ 1, 10 LABEL cText Var oSay SIZE 343, 40 OF oForm VALIGNMENT vaCenter Multiline
oSay:nAnchors:=akALL
WITH OBJECT oTree := TTreeView():New( oForm )
:SetBounds( 10, 50 , 290, 300 )
For nItem:=1 to Len(aItems)
:AddItem( aItems[nItem,2],,,,aItems[nItem,1])
Next
:lCheckBoxes := .T.
:lLinesAtRoot := .F.
:Create()
:nAnchors :=akALL
:OnKeyUp := {|| oForm:cText:=cTitle+" "+SelectItem(oTree, aItems, nColTotal) }
:OnlButtonUp := {|| oForm:cText:=cTitle+" "+SelectItem(oTree, aItems, nColTotal) }
END
@ 60, 305 BUTTON oTodo CAPTION "&Todos" SIZE 50, 25 OF oForm ;
ACTION (oForm:cText:=cTitle+" "+TreeSelectall(oTree,aItems,nColTotal), oTree:Refresh(),oTree:SetFocus())
oTodo:nAnchors:=akRIGHT
oTodo:cToolTip:="Selecciona todos los elementos"
@ 100, 305 BUTTON oNada CAPTION "&Ninguno" SIZE 50, 25 OF oForm ;
ACTION (oForm:cText:=cTitle+" "+TreeUnSelectall(oTree,aItems,nColTotal), oTree:Refresh(),oTree:SetFocus())
oNada:nAnchors:=akRIGHT
oNada:cToolTip:="Ningún elemento seleccionado"
@ 140, 305 BUTTON oInvert CAPTION "In&Vertir" SIZE 50, 25 OF oForm ;
ACTION (oForm:cText:=cTitle+" "+TreeInvert(oTree,aItems,nColTotal), oTree:Refresh(),oTree:SetFocus())
oInvert:nAnchors:=akRIGHT
oInvert:cToolTip:="Invertir elementos seleccionados"
@ 364, 10 BUTTON oAceptar CAPTION LT( XA_MSG_ACEPTAR ) SIZE 70, 25 OF oForm ;
ACTION (lOk := .T., oForm:Close()) Default
oAceptar:nAnchors:=akRIGHT
oAceptar:lDefault:=.t.
If lCANCEL
@ 364, 90 BUTTON oCancelar CAPTION LT( XA_MSG_CANCELAR ) SIZE 70, 25 OF oForm ;
ACTION oForm:Close()
oCancelar:nAnchors:=akRIGHT
Endif
If lPrint
@ 364, 170 BUTTON oImprimir CAPTION LT( XA_MSG_IMPRIMIR ) SIZE 70, 25 OF oForm ;
ACTION IMPARRAY(aItems,,cTitle,cText)
oImprimir:nAnchors:=akRIGHT
Endif
If lExcel
@ 364, 250 BUTTON oExcel CAPTION "Excel" SIZE 70, 25 OF oForm ;
ACTION IMPARRAYExcel(aItems,,cTitle,cText)
oExcel:nAnchors:=akRIGHT
Endif
//Totales iniciales
If nColTotal>0
oForm:cText:=cTitle+" "+Alltrim(Str(TreeTotal(oTree, aItems, nColTotal)))
Endif
oForm:nWidth:=Max(oForm:nWidth,nWidth)
oForm:nWidth:=Min(oForm:nWidth,Screen:nWidth-100)
oTree:OnKeyUp := {|oSender, nKey, nFlags| If(nKey=13, oAceptar:Click(),Nil) }
CursorArrow()
ACTIVATE FORM oForm MODAL CENTER
//Reconstruir tabla a devolver
If lOk
For nItem:=1 to Len(oTree:aItems)
aItems[nItem,1]:=oTree:aItems[nItem]:lChecked
Next
//Si se ha pedido borrar lo que no estan marcados
If lDeleteNoChecked
For nItem:=1 to Len(aItems)
If !aItems[nItem,1]
Adel(aItems,nItem,.T.)
nItem--
Endif
Next
Endif
Else
aItems:={}
Endif
Return aItems
//Seleccionar o deseleccionar un elemento
Static Function SelectItem(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
If nColtotal>0
nTotal:=TreeTotal(oTree, aItems, nColTotal)
Endif
Return If(nColtotal>0,Alltrim(Str(nTotal)),"")
//Botón de seleccionar todos los check
Static Function TreeSelectall(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
CursorWait()
For nItem:=1 to Len(oTree:aItems)
oTree:aItems[nItem]:lChecked:=.T.
If nColtotal>0
nTotal+=aItems[nItem,nColTotal]
Endif
Next
CursorArrow()
Return If(nColtotal>0,Alltrim(Str(nTotal)),"")
//Botón de seleccionar ningun check
Static Function TreeUnSelectall(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
CursorWait()
For nItem:=1 to Len(oTree:aItems)
oTree:aItems[nItem]:lChecked:=.F.
Next
CursorArrow()
Return If(nColtotal>0,"0","")
//Botón de invertir la seleccion de los check
Static Function TreeInvert(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
CursorWait()
For nItem:=1 to Len(oTree:aItems)
oTree:aItems[nItem]:lChecked:=!oTree:aItems[nItem]:lChecked
Next
nTotal:=TreeTotal(oTree, aItems, nColTotal)
CursorArrow()
Return If(nColtotal>0,Alltrim(Str(nTotal)),"")
Static Function TreeTotal(oTree, aItems, nColTotal)
Local nItem:=1, nTotal:=0
If nColtotal=0
Return 0
Endif
CursorWait()
For nItem:=1 to Len(oTree:aItems)
If oTree:aItems[nItem]:lChecked
nTotal+=aItems[nItem,nColTotal]
Endif
Next
CursorArrow()
Return nTotal
//---------------------------------------------------------- --------------------
//Copia archivos de origen a destino mostrando el diálogo de copia animado estandar de Windows
Function MsgCopy(acOrigName, acDestName, cTitle, lFilesOnly, lOkToAll, lAlarm )
Local oFileOperation, aFrom:={}, aTo:={}, lResult:=.F.
Default cTitle To "Copiando archivos"
DEFAULT acOrigName To ""
DEFAULT acDestName To ""
DEFAULT lFilesOnly To .T.
DEFAULT lOkToAll To .T.
DEFAULT lAlarm To .F.
//Cargar los Array
If ValType(acOrigName)="C"
Aadd(aFrom,acOrigName)
ElseIf ValType(acOrigName)="A"
aFrom:=acOrigName
Endif
If ValType(acDestName)="C"
Aadd(aTo,acDestName)
ElseIf ValType(acDestName)="A"
aTo:=acDestName
Endif
WITH OBJECT oFileOperation := TFileOperationDlg():New( Application:oActiveform )
:nAction := foCOPY
:aFrom := aFrom
:aTo := aTo
If cTitle<>""
:cText := cTitle
Endif
:lAutoRename := .F.
:lFilesOnly := lFilesOnly
:lNoConfirmation := lOkToAll
:lNoConfirmMkDir := lOkToAll
:lNoErrorUI := lAlarm
:Create()
lResult:=:Run()
END
If oFileOperation:lAborted
lResult:=.F.
Endif
Return lResult
//---------------------------------------------------------- --------------------
//Mueve archivos de origen a destino mostrando el diálogo de copia animado estandar de Windows
Function MsgMove(acOrigName, acDestName, cTitle, lFilesOnly, lOkToAll, lAlarm )
Local oFileOperation, aFrom:={}, aTo:={}, lResult:=.F.
Default cTitle To "Moviendo archivos"
DEFAULT acOrigName To ""
DEFAULT acDestName To ""
DEFAULT lFilesOnly To .T.
DEFAULT lOkToAll To .T.
DEFAULT lAlarm To .F.
//Cargar los Array
If ValType(acOrigName)="C"
Aadd(aFrom,acOrigName)
ElseIf ValType(acOrigName)="A"
aFrom:=acOrigName
Endif
If ValType(acDestName)="C"
Aadd(aTo,acDestName)
ElseIf ValType(acDestName)="A"
aTo:=acDestName
Endif
WITH OBJECT oFileOperation := TFileOperationDlg():New( Application:oActiveform )
:nAction := foMove
:aFrom := aFrom
:aTo := aTo
If cTitle<>""
:cText := cTitle
Endif
:lAutoRename := .F.
:lFilesOnly := lFilesOnly
:lNoConfirmation := lOkToAll
:lNoConfirmMkDir := lOkToAll
:lNoErrorUI := lAlarm
:Create()
lResult:=:Run()
END
If oFileOperation:lAborted
lResult:=.F.
Endif
Return lResult
//---------------------------------------------------------- --------------------
//Elimina archivos a la papelera mostrando el diálogo de copia animado estandar de Windows
Function MsgDelete(acOrigName, cTitle, lFilesOnly, lOkToAll, lAlarm )
Local oFileOperation, aFrom:={}, aTo:={}, lResult:=.F.
Default cTitle To "Enviando archivos a papelera"
DEFAULT acOrigName To ""
DEFAULT lFilesOnly To .T.
DEFAULT lOkToAll To .T.
DEFAULT lAlarm To .F.
//Cargar los Array
If ValType(acOrigName)="C"
Aadd(aFrom,acOrigName)
ElseIf ValType(acOrigName)="A"
aFrom:=acOrigName
Endif
WITH OBJECT oFileOperation := TFileOperationDlg():New( Application:oActiveform )
:nAction := foDELETE
:aFrom := aFrom
If cTitle<>""
:cText := cTitle
Endif
:lAllowUndo := .T.
:lFilesOnly := lFilesOnly
:lNoConfirmation := lOkToAll
:lNoErrorUI := lAlarm
:Create()
lResult:=:Run()
END
If oFileOperation:lAborted
lResult:=.F.
Endif
Return lResult
//---------------------------------------------------------- ------------------//
Function MsgLogo( cImage, nSeconds )
Local oForm, oImagen, oTimer
DEFAULT nSeconds To 5
DEFINE FORM oForm OF Application:oActiveform BORDERSTYLE bsSPLASH
oForm:oBkgnd := cImage
oForm:SetClientSize( oForm:oBkgnd:nWidth, oForm:oBkgnd:nHeight )
oForm:OnLButtonDown := { || oForm:Close() }
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
Activate Timer oTimer
ACTIVATE FORM oForm MODAL CENTER
DeActivate Timer oTimer
Return Nil
//---------------------------------------------------------- ------------------//
Function MsgDesktop(cText, cTitle, cImage, lFlash )
Local oForm, oImage
Default cText To ""
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default lFlash To .T.
DEFINE FORM oForm TITLE cTitle OF Application ;
SIZE 330, 290 BORDERSTYLE bsDIALOG
If !Empty(cImage)
@ 5,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 5, 55 LABEL cText SIZE 250, 250 OF oForm MultiLine VALIGNMENT vaCenter
Else
@ 5, 10 LABEL cText SIZE 295, 250 OF oForm MultiLine VALIGNMENT vaCenter
Endif
If lFlash
oForm:OnShow := { || oForm:FlashForm(300) }
Endif
ACTIVATE FORM oForm CENTER
SetActiveWindow(GetDesktopWindow())
Return Nil
//---------------------------------------------------------- ------------------//
#pragma BEGINDUMP
#include <windows.h>
#include <xailer.h>
XA_FUNC( FLASHWINDOW )
{
FLASHWINFO fi;
fi.cbSize = sizeof( FLASHWINFO );
fi.hwnd = (HWND) hb_parnl( 1 );
fi.uCount = hb_parnl( 2 );
fi.dwFlags = FLASHW_ALL;
fi.dwTimeout = XA_IsWin9X() ? 0 : 200;
FlashWindowEx( &fi );
}
#pragma ENDDUMP
//---------------------------------------------------------- ------------------//
Function MsgOptions(aOptions, cText, cTitle, cImage, nDefaultOption, nSeconds )
Local oForm, oImage, nOption:=0, nItem:=0, nBtnWidth:=0, aBtn:=Array(Len(aOptions))
Local nBtnPosX:=0, nBtnPosY:=85, cOption:="", oTimer
Local nButtonsWidth:=0, nTextWidth:=0, nFormWidth:=0
Default cText To "Seleccione una opción......"
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default nDefaultOption To 1
Default nSeconds To 0
//Calcular anchura máxima de un botón para igualarlos todos
For nItem:=1 To Len(aOptions)
aOptions[nItem]:=Alltrim(aOptions[nItem])
nBtnWidth:=Max( Application:oFont:GetTextWidth(aOptions[nItem]), nBtnWidth )
Next
nBtnWidth:=nBtnWidth+7
nButtonsWidth:=(Len(aOptions)*(10+nBtnWidth))
For nItem:=1 to Mlcount(cText)
nTextWidth:=Max( Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nItem) )), Application:oFont:GetTextWidth( cTitle )+60 )+10
Next
nFormWidth:=Max(nButtonsWidth+15+If(!Empty(cImage),45,0),nTe xtWidth+20+If(!Empty(cImage),45,0))
nBtnPosX:=(nFormWidth-nButtonsWidth)/2
nTextWidth:=nFormWidth-20-If(!Empty(cImage),45,0)
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE nFormWidth, 155 BORDERSTYLE bsDIALOG
If !Empty(cImage)
@ 20,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 10, 55 LABEL cText SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter MultiLine
Else
@ 10, 10 LABEL cText SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter MultiLine
Endif
For nItem:=1 To Len(aOptions)
@ nBtnPosY, nBtnPosX BUTTON aBtn[nItem] CAPTION aOptions[nItem] SIZE nBtnWidth, 25 OF oForm ;
ACTION ( cOption:=oForm:oActivecontrol:cText, oForm:Close() )
nBtnPosX:=nBtnPosX+10+nBtnWidth
Next
aBtn[nDefaultOption]:SetFocus()
If nSeconds>0
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ;
ACTION ( cOption:=aOptions[nDefaultOption], oForm:Close() )
Activate Timer oTimer
Endif
ACTIVATE FORM oForm MODAL CENTER
If nSeconds>0
DeActivate Timer oTimer
Endif
If !Empty(cOption)
nOption:=Ascan(aOptions,Alltrim(cOption))
Endif
Return nOption
//---------------------------------------------------------- ------------------//
Function MsgRadio(aOptions, cText, cTitle, cImage, nDefaultOption, nSeconds )
Local oForm, oImage, nOption:=0, nItem:=0, oTimer
Local oRadio, nRadioWidth:=0, nRadioHeight:=0
Local nTextWidth:=0, nTextHeight:=0, nFormWidth:=0, nFormHeight:=0
Default cText To "Seleccione una opción......"
Default cTitle To LT(XA_MSG_WARNING)
Default cImage To ""
Default nDefaultOption To 1
Default nSeconds To 0
//Control de entrada de datos
If Valtype(aOptions)<>"A" .Or. Len(aOptions)=0
LogDebug("Imposible crear un MsgRadio sin un array de opciones")
Return 0
Endif
//Calcular anchura y altura máxima del título
For nItem:=1 to Mlcount(cText)
nTextWidth:=Max( Application:oFont:GetTextWidth(Alltrim( Memoline(cText,,nItem) )), Application:oFont:GetTextWidth( cTitle )+60 )+10
Next
nTextHeight:=Application:oFont:GetTextHeight(Memoline(cText, ,1))*Mlcount(cText)
//Calcular anchura máxima de un radio y altura para el radio menu
For nItem:=1 To Len(aOptions)
aOptions[nItem]:=Alltrim(aOptions[nItem])
nRadioWidth:=Max( Application:oFont:GetTextWidth(Alltrim(aOptions[nItem])), nRadioWidth )
Next
nRadioWidth :=nRadioWidth+30 //Espacio para el radio
nRadioHeight:=(Application:oFont:GetTextHeight(Alltrim(aOpti ons[1]))+10)*Len(aOptions)
If Len(aOptions)>10
nRadioWidth := nRadioWidth*2
nRadioHeight:= nRadioHeight/2
Endif
//Altura y anchura del form
nFormWidth:=Max(nRadioWidth,nTextWidth)+If(!Empty(cImage),45 ,0)+50
nFormHeight:=10+nTextHeight+10+nRadioHeight+80
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE Max(nFormWidth,195), nFormHeight BORDERSTYLE bsDIALOG
If !Empty(cImage)
@ 10,10 Image oImage Size 50, 50 FILE cImage Transparent NONE ;
NoTabStop OF oForm
@ 10, 55 LABEL cText SIZE nTextWidth, nTextHeight OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter
Else
@ 10, 10 LABEL cText SIZE nTextWidth, nTextHeight OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter
Endif
WITH OBJECT oRadio := TRadioMenu():New( oForm )
:SetBounds( If(!Empty(cImage),50,20) , 10+nTextHeight+10 , nRadioWidth, nRadioHeight )
:aItems := aOptions
If Len(aOptions)>10
:nColumns:=2
Endif
:Create()
END
oRadio:nIndex:=nDefaultOption
@ 10+nTextHeight+10+nRadioHeight+10, nFormWidth-180 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION ( nOption:=oRadio:nIndex, oForm:Close() ) Default
@ 10+nTextHeight+10+nRadioHeight+10, nFormWidth-90 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION ( nOption:=0, oForm:Close() )
If nSeconds>0
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ;
ACTION ( nOption:=nDefaultOption, oForm:Close() )
Activate Timer oTimer
Endif
ACTIVATE FORM oForm MODAL CENTER
If nSeconds>0
DeActivate Timer oTimer
Endif
Return nOption
//---------------------------------------------------------- ------------------//
//Mensaje a todos los usuarios de una red
Function NewMsg2All()
Local oForm, lSave := .F., oEdit:=Array(4)
Local cMessage:=Space(250), cFrom:=Space(30), nValidity:=10
//Si no existe el archivo crearlo
If !File("Messages.Dbf")
DbCreate( "Messages.Dbf",;
{ { "Date" , "D", 8, 0 },;
{ "Time" , "C", 5, 0 },;
{ "From" , "C", 30, 0 },;
{ "Message" , "C", 250, 0 },;
{ "ValidDays", "N", 2, 0 },;
{ "IP" , "C", 400, 0 } } , "DBFNTX" )
Endif
DEFINE FORM oForm TITLE "Nuevo mensaje" OF Application:oActiveform ;
SIZE 300, 250 BORDERSTYLE bsDIALOG
@ 5, 10 Label "Texto del Mensaje" SIZE 270, 20 OF oForm
@ 25, 10 Memo oEdit[1] SIZE 270, 60 OF oForm
oEdit[1]:Value:=cMessage
oEdit[1]:nMaxLength := Len(cMessage)
@ 90, 10 Label "Autor" SIZE 270, 20 OF oForm
@ 110, 10 EDIT oEdit[2] SIZE 270, 20 OF oForm
oEdit[2]:Value:=cFrom
oEdit[2]:nMaxLength := Len(cFrom)
@ 150, 10 Label "Días de Validez" SIZE 90, 20 OF oForm
@ 150, 110 MASKEDIT oEdit[3] SIZE 40, 20 OF oForm ALIGNMENT taRight Picture "99"
oEdit[3]:Value:=nValidity
@ 190, 50 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION (lSave := .T., oForm:Close()) Default
@ 190, 150 BUTTON CAPTION LT( XA_MSG_CANCELAR ) SIZE 80, 25 OF oForm ;
ACTION oForm:Close()
ACTIVATE FORM oForm MODAL CENTER
If !lSave
Return Nil
Endif
DbUseArea(.T.,"DBFNTX","Messages.Dbf","Messages")
If NetErr()
Return Nil
Endif
Messages->( DbAppend() )
Messages->Date := Date()
Messages->Time := Time()
Messages->From := oEdit[2]:Value
Messages->Message := oEdit[1]:Value
Messages->ValidDays:= oEdit[3]:Value
Messages->( DbCloseArea() )
Return Nil
//Muestra el mensaje a una IP no mostrada aun
Function Msg2All()
Local cLocalIP:=GetLocalIp()[1], cFinalIP:=SubStr(cLocalIP,Rat(".",cLocalIP))+"."
Local oForm, oEdit, lOk:=.F.
If !File("Messages.Dbf")
Return Nil
Endif
DbUseArea(.T.,"DBFNTX","Messages.Dbf","Messages")
If NetErr()
Return Nil
Endif
Do While !Eof()
If Messages->Date+Messages->ValidDays < Date()
//Borrar mensajes caducados
Do While !Rlock()
Enddo
Messages->(DbDelete())
Else
//Buscar la IP y mostrar el mensaje si no se encuentra
If At( cFinalIP,Messages->IP )=0
DEFINE FORM oForm OF Application:oActiveform ;
SIZE 300, 190 BORDERSTYLE bsDIALOG ;
TITLE "Mensaje de "+Alltrim(Messages->From)+" "+Dtoc(Messages->Date)+" "+Messages->Time
@ 5, 10 Label "Mensaje de "+Alltrim(Messages->From) SIZE 270, 20 OF oForm
@ 25, 10 Label "De fecha "+Dtoc(Messages->Date)+" "+Messages->Time SIZE 270, 20 OF oForm
@ 45, 10 Memo oEdit SIZE 270, 60 OF oForm
oEdit:Value:=Alltrim(Messages->Message)
@ 120, 20 BUTTON CAPTION LT( XA_MSG_IMPRIMIR ) SIZE 80, 25 OF oForm ;
ACTION ( Msg2AllPrn( oForm:cText, Alltrim(Messages->Message) ) )
@ 120,105 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ;
ACTION ( lOk:=.T., oForm:Close() ) Default
@ 120,190 BUTTON CAPTION "Demorar" SIZE 80, 25 OF oForm ;
ACTION oForm:Close() Default
ACTIVATE FORM oForm MODAL CENTER
IF lOk //Mensaje aceptado
Do While !Rlock()
Enddo
Messages->IP := Left(Alltrim(Messages->IP),Len(Alltrim(Messages->IP))-1)+cFinalIP
ENDIF
Endif
Endif
Messages->( DbSkip() )
Enddo
Messages->( DbCloseArea() )
Return Nil
//---------------------------------------------------------- --------------------
#pragma BEGINDUMP
#include "windows.h"
#include "xailer.h"
#include "winsock2.h"
XA_FUNC( GETLOCALIP )
{
WSADATA wsa;
char cHost[256];
struct hostent *h;
int nAddr = 0, n = 0;
WSAStartup( MAKEWORD( 2, 0 ), &wsa );
if( gethostname( cHost, 256 ) == 0 )
{
h = gethostbyname( cHost );
if( h )
while( h->h_addr_list[ nAddr ] )
nAddr++;
}
hb_reta( nAddr );
if( nAddr )
while( h->h_addr_list[n] )
{
char cAddr[256];
wsprintf( cAddr, "%d.%d.%d.%d", (BYTE) h->h_addr_list[n][0],
(BYTE) h->h_addr_list[n][1],
(BYTE) h->h_addr_list[n][2],
(BYTE) h->h_addr_list[n][3] );
hb_storc( cAddr, -1, ++n );
}
WSACleanup();
}
#pragma ENDDUMP
//Prints a Message
Function Msg2AllPrn( cTitle, cText )
Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:=""
Local nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0
CursorWait()
DEFINE FONT oFont NAME "Times New Roman"
Printer:cJobTitle := cTitle
Printer:lPreview := .t.
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmHIMETRICS
Printer:StartPage()
WITH OBJECT Printer:oCanvas
:oFont := oFont
:oPen := oPen
:nMapMode := mmSIMULCHAR
:nTextAlignment:=taCENTER
:oFont:nSize := 14
:oFont:lBold := .T.
:oFont:lUnderline := .T.
:TextOut( 1, 1, cTitle,65, CLR_BLUE)
:oFont:lBold := .F.
:oFont:lUnderline := .F.
:nTextAlignment:=taLEFT
:oFont:nSize := 12
For n:=1 to MlCount(cText,80)
:TextOut( 12, n+4, MemoLine(cText,80,n),80, CLR_BLACK)
Next
END WITH
Printer:EndPage()
Printer:EndDoc()
Printer:Preview()
oFont:Destroy()
CursorArrow()
Return Nil
// Imprime el escritorio completo o el formulario que se indique
// Por ejemplo Hardcopy(Self) imprime el form actual
Function HardCopy( oForm, lPreview, cTitle,nOrientacion )
LOCAL hBitmap, oBitMap,nZoomV,nZoomH
Default lPreview To .T.
Default cTitle To "Impresión de pantalla"
Default nOrientacion to 0 //0.-Auto 1.-Portrait 2.-Landscape
Application:lBusy := .T.
hBitmap := If(oForm=Nil,XA_CaptureBitmap( GetDesktopWindow(),0,0,Screen:PaperRes()[2],Screen:PaperRes( )[1] ),;
XA_CaptureBitmap( oForm:Handle, 0, 0, oForm:nVirtualHeight ,oForm:nVirtualWidth) )
oBitmap := TBitmap():CreateFromHandle( hBitmap )
if oBitMap:nWidth > oBitMap:nHeight
nZoomV := oBitMap:nHeight / oBitMap:nWidth
nZoomH := 1
else
nZoomH := oBitMap:nWidth / oBitMap:nHeight
nZoomV := 1
endif
Printer:lPreview := lPreview
Printer:nPreviewShowMode := smMAXIMIZE
Printer:nPrintQuality := DMRES_HIGH
Printer:cJobTitle := cTitle
if nOrientacion == 2 .or. (nOrientacion == 0 .and. nZoomH > nZoomV)
Printer:nOrientation := DMORIENT_LANDSCAPE
nOrientacion := 2
else
Printer:nOrientation := DMORIENT_PORTRAIT // LANDSCAPE
endif
Printer:StartDoc()
Printer:oCanvas:nMapMode := mmPIXELS
Printer:StartPage()
* Printer:oCanvas:TextOut(cTitle,50,50)
if nOrientacion == 2 //Apaisado
Printer:oCanvas:DrawPicture( { 100,100,Printer:PaperRes()[1]*nZoomH,Printer:PaperRes()[2]*n ZoomV }, oBitmap )
else
Printer:oCanvas:DrawPicture( { 100,100,Printer:PaperRes()[1]*nZoomH,Printer:PaperRes()[1]*n ZoomV }, oBitmap )
endif
Printer:EndPage()
Printer:EndDoc()
Application:lBusy := .F.
If lPreview
Printer:Preview()
Endif
oBitmap:Destroy()
DeleteObject( hBitmap )
Return Nil
// Crea un fichero de incidencias y graba las incidencias del programa
Function Incidencia(cMensaje,nLimite)
Local oIncidencia,nTOTAL
DEFAULT nLIMITE To 10
If !FILE(Application:cDirectory+"Incidencias.Ctl")
DbCreate(Application:cDirectory+"Incidencias.Ctl",;
{{"Usuario" ,"C", 25,0},;
{"Fecha" ,"D", 8,0},;
{"Hora" ,"C", 8,0},;
{"Incidencia","C",200,0} })
ENDIF
DbUseArea(.T.,"DBFNTX","Incidencias.Ctl","Incidencias")
Incidencias->( DbAppend() )
Try
Incidencias->USUARIO :=AppData:cUserName
Catch
Incidencias->USUARIO :=NetName(1)
End
Incidencias->FECHA :=DATE()
Incidencias->HORA :=TIME()
Incidencias->Incidencia :=UPPER(cMENSAJE)
//Solo se graban las últimas n incidencias indicadas en nLIMITE
If FLock()
COUNT TO nTOTAL FOR !DELETED()
Do While nTOTAL>nLIMITE
Incidencias->( DbGOTOP() )
Incidencias->( DbDELETE() )
COUNT TO nTOTAL FOR !DELETED()
EndDo
**** Pack
Endif
Incidencias->( DbCloseArea() )
Return Nil
//---------------------------------------------------------- --------------------
#pragma BEGINDUMP
#include <windows.h>
#include <xailer.h>
HB_FUNC( PLAYSOUNDWAIT )
{
char * szSound = hb_parc( 1 );
if( szSound )
hb_retl( PlaySound( szSound, NULL, SND_SYNC | SND_FILENAME | SND_NODEFAULT ) );
}
#pragma ENDDUMP
//---------------------------------------------------------- --------------------
#pragma BEGINDUMP
#include <windows.h>
#include <xailer.h>
HB_FUNC( PLAYSOUND )
{
char * szSound = hb_parc( 1 );
if( szSound )
hb_retl( PlaySound( szSound, NULL, SND_ASYNC | SND_FILENAME | SND_NODEFAULT ) );
}
#pragma ENDDUMP
//---------------------------------------------------------- --------------------
**/
* FUNCION que Envia un Email con la classe TMapi
* @author JJG
* @param aPersonas Array Multidimensional {"Nombre destinatario","Correo Destinatario"} ó Solo "Correo Destinatario"
* @param cAsunto Asunto del Email
* @param cMensaje Mensaje del Email
* @param cDePersona Nombre que aparece como remitente
* @param cDeCorreo Direccion del correo desde la que se envia
* @param aAttach Array de adjuntos o solo un adjunto
* @return lExito .t. ó .f.
*/
Function MsgEmail(aPersonas,cAsunto,cMensaje,cDePersona,cDeCorreo,xAt tach)
Local oMapi
local lExito := .f.
LOCAL aDestinos := {}, aAttach := {}
LOCAL nK
DEFAULT cAsunto TO ""
DEFAULT cMensaje TO ""
DEFAULT cDePErsona TO ""
DEFAULT cDeCorreo TO ""
//--- Definir array a Destinos
if Valtype(aPersonas) == "C"
Aadd(aDestinos,{aPersonas,aPersonas,mapiTO})
Else
for nK := 1 to Len(aPersonas)
Aadd(aDestinos,{aPersonas[nK,1],aPersonas[nK,2],if(nK==1,map iTO,mapiBCC)})
next nK
Endif
//--- Definir array de adjuntos
If xAttach<>Nil
if Valtype(xAttach) == "C"
Aadd(aAttach,{xAttach,xAttach})
Else
for nK := 1 to Len(aAttach)
Aadd(aAttach,{aAttach[nK,1],aAttach[nK,1]})
next nK
Endif
Endif
oMapi := TMapi():New()
Sleep(1000)
If !oMapi:Installed()
MsgInfo("No es posible el envio de email desde este equpo, Revise la configuración de correo electrónico.")
oMapi:Destroy()
RETURN Nil
EndIf
WITH OBJECT oMapi
:Create()
If :Logon()
:cFromName := cDePersona
:cFromAddress := cDeCorreo
:cSubject := cAsunto
:cMessage := cMensaje
If Len(aAttach)>0
:aAttachments :=aAttach
Endif
:lAskRecipients:=.T.
:aReceipts:=aDestinos
If !:Send()
MsgInfo("Error al enviar el correo.","Lo siento...")
lExito := .f.
Endif
:Logoff()
Else
lExito := .f.
Endif
End
RETURN lExito
//---------------------------------------------------------- --------------------
**/
* FUNCION que muestra una panel con un mensaje de gran tamaño y que al pulsar encima se cierra
* @author Bingen
* @param cText Texto a mostrar
* @param cTitle [Opcional] Título de la ventana, por defecto "Un momento por favor..."
* @param nFont [Opcional] Tamaño del font del texto, por defecto 20 y la mitad para el título
* @param nSeconds [Opcional] Segundos antes de cerrar la ventana, por defecto 5. Si se indica 0 no se autocierra.
* @param xColor [Opcional] Color del texto de la ventana, por defecto clBlack, si es un array será el color de letra y el del fondo
*/
Function MsgPanel( cText, cTitle, nFont, nSeconds, xColor )
Local oForm, oTimer, oTitulo, oLabel
Local nHeight:=0, nWidth:=0 , nLine:=0
Local oFont, oFontTitle, nClrText ,nClrPane
Default cTitle To "Un momento por favor..."
DEFAULT nSeconds To 5
Default nFont To 20
Default xColor To clBlack
//Definir fuentes el del título tendrá la mitad de tamaño
oFontTitle:=TFont():Create( "Arial", Max(nFont/2 ,8))
oFont:=TFont():Create( "Arial", nFont )
//Calcular tamaño de la ventana
nHeight:=(oFontTitle:GetTextHeight( "B" )*1.2)+((oFont:GetTextHeight( "B" ))*Mlcount(cText))
For nLine:=1 to Mlcount(cText)
nWidth:=Max( nWidth,oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*1.2 )
Next
nWidth:=Min(nWidth,Screen:nWidth*0.80)
nWidth:=Max(nWidth,280)
If Valtype(xColor)="A"
nClrText := xColor[1]
nClrPane := xColor[2]
Else
nClrText := xColor
nClrPane := clBtnFace
Endif
//Crear la ventana
DEFINE FORM oForm OF Application:oActiveform BORDERSTYLE bsSPLASH
oForm:SetBounds( 12, 16, nWidth+20, nHeight+20 )
oForm:nClrPane := nClrPane
WITH OBJECT oTitulo := TLabel():New( oForm )
:SetBounds( 0, 0, nWidth , oFontTitle:GetTextHeight( "B" )*1.2 )
:cText := cTitle
:lParentFont :=.F.
:oFont := oFontTitle
:nClrText := nClrText
:nClrPane := nClrPane
:lAutoSize := .F.
:OnLButtonDown := { || oForm:Close() }
:Create()
END
WITH OBJECT oLabel := TLabel():New( oForm )
:SetBounds( 0, oFontTitle:GetTextHeight( "B" )*1.2, nWidth , (oFont:GetTextHeight( "B" ))*Mlcount(cText) )
:cText := cText
:lParentFont :=.F.
:oFont := oFont
:nClrText := nClrText
:nClrPane := nClrPane
:nAlignment := taCENTER
:nVAlignment := vaCENTER
:lAutoSize := .F.
:lMultiLine := .T.
:OnLButtonDown := { || oForm:Close() }
:Create()
END
oForm:OnLButtonDown := { || oForm:Close() }
oForm:OnKeyDown := { |oSender,nKey| If(nKey=13 .Or. nKey=27, oForm:Close(),) }
DEFINE TIMER oTimer OF oForm Interval nSeconds*1000 ACTION oForm:Close()
If nSeconds>0
Activate Timer oTimer
Endif
ACTIVATE FORM oForm MODAL CENTER
DeActivate Timer oTimer
oFont:Destroy()
oFontTitle:Destroy()
Return Nil
//---------------------------------------------------------- ------------------//
**/
* FUNCION que muestra un MsgInfo solo para el desarrollador
* @author Bingen
* @param cText Texto a mostrar
*/
Function MsgTest( cText )
Try
If !AppData:lUser
MsgPanel( ToString(cText), "Información para el desarrollador...", 10, 0, {clWhite,clBlack} )
Endif
Catch
MsgInfo(cText)
End
Return Nil
//---------------------------------------------------------- ------------------//
**/
* FUNCION que muestra múltiples mensajes de un array en folders
* @author Bingen
* @param aMensajes Array con los mensajes a mostrar
*/
Function MsgMultiple( aMensajes, cTitle )
Local oItems, nItem, oForm, oFolder, oFolderpage, oMemo
Default cTitle To LT(XA_MSG_WARNING)
DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ;
SIZE 500, 200+(Len(aMensajes)*20) BORDERSTYLE bsDIALOG
WITH OBJECT oFolder := TFolder():New( oForm )
:nAlign := alCLIENT
:lMultiLine := .T.
:Create()
END
For nItem:=1 to Len(aMensajes)
WITH OBJECT oFolderPage := TFolderPage():New( oFolder )
:cText := "Msg "+AllString(nItem)
:Create()
END
WITH OBJECT oMemo := TMemo():New( oFolderPage )
:nAlign := alCLIENT
:Value := AllString(aMensajes[nItem])
:Create()
END
Next
ACTIVATE FORM oForm MODAL CENTER
Return Nil
//---------------------------------------------------------- ------------------//
Imprimir matrices
Hola Bingen
Muchas y extensas gracias.
Un saludo,
Emilio Gil.
Muchas y extensas gracias.
Un saludo,
Emilio Gil.