/* * Proyecto: Propósito general * Fichero: Messages.prg * Descripción: Mensajes en general para las aplicaciones * Autor: Bingen Ugaldebere * Última revisión: 09/02/2009 */ #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" If Valtype(uVar)="A" Asize(uVar,3) 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, 35 OF oForm VALIGNMENT vaCenter @ 40, 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, 45 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, 50 OF oForm VALIGNMENT vaCenter MultiLine If uVar oEdit:lChecked:=.T. Endif OtherWise MsgInfo("No se puede editar un valor de tipo "+Valtype(uVar)) EndCase Endif If ValType(uVar)<>"L" oEdit:Value:=uVar Endif If !Empty(cImage) @ 70,10 Image oImage Size 45, 45 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)="L" .Or. (ValType(uVar)<>"L" .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)<>"L" uVar:=oEdit:Value Else uVar:=oEdit:lChecked Endif Endif Return lOk //------------------------------------------------------------------------------ Static Function MsgEditValid(uValue, uLimitInf, uLimitSup) If uLimitInf=Nil .And. uLimitSup=Nil Return .T. Endif If uLimitInf<>Nil .And. uValueNil .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 40, 40 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 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 40, 40 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 MsgMemo(cText, cTitle, lEditable) Local oForm , oMemo , lOk := .f., cInitText:=cText Default cTitle To LT(XA_MSG_WARNING) Default lEditable To .F. DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ; SIZE 320, 190 BORDERSTYLE bsDIALOG @ 10, 10 MEMO oMemo PROMPT cText SIZE 295, 115 OF oForm oMemo:lReadOnly:=!lEditable @ 130, 120 BUTTON CAPTION LT( XA_MSG_ACEPTAR ) SIZE 80, 25 OF oForm ; ACTION (cText:=oMemo:Value, lOk := .T., oForm:Close()) Default ACTIVATE FORM oForm MODAL CENTER Return If(lOk, cText, 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 40, 40 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 40, 40 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()+"\Media\Chord.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, oFont 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) DEFINE FONT oFont NAME "Arial" oFont:nSize := 12 oFont:lBold := .F. oFont:lUnderline := .F. //Calcular tamaños respecto al fuente nTitleWidth := oFont:GetTextWidth( cTitle ) * .8 nTitleHeight := oFont:GetTextHeight( cTitle ) * .8 nHeight := oFont:GetTextHeight( cTitle ) * .8 nTotalHeight := Max( ( nHeight * ( Mlcount(cText) + 1 ) ) + 35 , If( !Empty(cImage), 85,0) ) nWidth := nTitleWidth For nLine:=1 to Mlcount(cText) nWidth:= Max( nWidth, oFont:GetTextWidth(Alltrim( Memoline(cText,,nLine) ))*.8 ) Next nTotalWidth := nWidth +IF( !Empty(cImage), 68, 0) + 50 //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 //Janela de mensagem com espera até que se execute WaitOff DEFINE FORM oFormWait SIZE nTotalWidth, nTotalHeight BORDERSTYLE bsSPLASH Of Application:oActiveform IF !Empty(cTitle) @ 1, 55 LABEL cTitle VAR oWaitTitle SIZE nTitleWidth, nTitleHeight OF oFormWait oWaitTitle:nVAlignment := vaCenter //oWaitTitle:oFont := oFont ENDIF If !Empty(cImage) @ 20,10 Image oImage Size 40, 48 FILE cImage Transparent NONE NoTabStop OF oFormWait @ nHeight+10, 55 LABEL cText VAR oWaitSay SIZE nWidth+20, nHeight*Mlcount(cText)+10 OF oFormWait Alignment taCenter oWaitSay:nVAlignment:= vaCenter oWaitSay:oFont := oFont Else @ nHeight+10, 10 Label cText VAR oWaitSay Size nWidth,nHeight*Mlcount(cText)+Len(cText) Of oFormWait Alignment taCenter oWaitSay:nVAlignment := vaCenter oWaitSay:oFont := oFont 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 /* Exemplo Local n:=0 WaitonMeter("Se crea el form con la barra de progreso"+CRLF+"adaptada a la anchura del form",; "WaitOn con Meter",10000) For n:=1 to 10000 AppData:oWaitOnMeter:nValue=n Next WaitOff() MsgSave( "Ha probado WaitOnMeter/WaitOff a las "+Time()) */ 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) @ 20,10 Image oImage Size 48, 48 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,lFilterBar,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)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 If lFilterBar @ 345, 10 CHECKBOX oFilter Caption "Permitir búsquedas por filtro" SIZE 170, 20 OF oForm oFilter:onClick:={|| oBrw:lFilterBar:=!oBrw:lFilterBar} Endif @ 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 (lOk := .T., nAt:=oBrw:aArrayData[If(oBrw:nArrayOrgAt()<>0,oBrw:nArrayOrgAt(),oBrw:nArrayAt),Len(oBrw:aArrayData[1])], 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,aHeads,cTitle,cText) 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 oBrw:lFilterBar:=.F. oBrw:lAutoOrder:=.t. oForm:nWidth:=Max(oForm:nWidth,nWidth) oForm:nWidth:=Min(oForm:nWidth,Screen:nWidth-100) ACTIVATE FORM oForm MODAL CENTER CursorArrow() Return If(lOk,nAt,0) ******* IMPRIMIR ARRAY STATIC FUNCTION IMPARRAY(aItems,aHeads,cTitle,cText) Local ofrmPreview, oFont, oPen, n := 100, nItem:=0, cHead:="" Local aDatos:={}, aLen:={}, nL:=0, nC:=0, cTexto:="", lSalir:=.F., nNumpage:=0 DEFAULT aHeads To {} 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) 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 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() 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 ) Local oForm, oBTN1, oBTN2, oTree, lOK:=.F., aArray:={}, oSay 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. //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 CursorWait() 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. :Create() :nAnchors:=akALL END @ 60, 305 BUTTON oTodo CAPTION "&Todos" SIZE 50, 25 OF oForm ; ACTION (TreeSelectall(oTree), oTree:Refresh()) oTodo:nAnchors:=akRIGHT oTodo:cToolTip:="Selecciona todos los elementos" @ 100, 305 BUTTON oNada CAPTION "&Ninguno" SIZE 50, 25 OF oForm ; ACTION (TreeUnSelectall(oTree), oTree:Refresh()) oNada:nAnchors:=akRIGHT oNada:cToolTip:="Ningún elemento seleccionado" @ 140, 305 BUTTON oInvert CAPTION "In&Vertir" SIZE 50, 25 OF oForm ; ACTION (TreeInvert(oTree), oTree:Refresh()) 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 oForm:nWidth:=Max(oForm:nWidth,nWidth) oForm:nWidth:=Min(oForm:nWidth,Screen:nWidth-100) ACTIVATE FORM oForm MODAL CENTER CursorArrow() //Reconstruir tabla a devolver If lOk For nItem:=1 to Len(oTree:aItems) aItems[nItem,1]:=oTree:aItems[nItem]:lChecked Next Else aItems:={} Endif Return aItems //------------------------------------------------------------------------------ Static Function TreeSelectall(oTree) Local nItem:=1 For nItem:=1 to Len(oTree:aItems) oTree:aItems[nItem]:lChecked:=.T. Next Return Nil Static Function TreeUnSelectall(oTree) Local nItem:=1 For nItem:=1 to Len(oTree:aItems) oTree:aItems[nItem]:lChecked:=.F. Next Return Nil Static Function TreeInvert(oTree) Local nItem:=1 For nItem:=1 to Len(oTree:aItems) oTree:aItems[nItem]:lChecked:=!oTree:aItems[nItem]:lChecked Next Return Nil //------------------------------------------------------------------------------ //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 := .T. :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 := .T. :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 40, 40 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 // Para BCC /* //----------------------------------------------------------------------------// #pragma BEGINDUMP #include #include 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 //----------------------------------------------------------------------------// */ // Para MinGw #pragma BEGINDUMP #define WINVER 0x0500 #include #include 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(cText, cTitle, cImage, aOptions, 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, oFont, oTexto 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 oFont:= TFont():Create( "Tahoma",11,, 2 ) //Calcular anchura máxima de un botón para igualarlos todos For nItem:=1 To Len(aOptions) aOptions[nItem]:= aOptions[nItem] // nBtnWidth:= Max( Application:oFont:GetTextWidth(aOptions[nItem]), nBtnWidth ) nBtnWidth:= Max( oFont:GetTextWidth(aOptions[nItem]), nBtnWidth ) Next nBtnWidth:= nBtnWidth+7 nButtonsWidth:=(Len(aOptions)*(10+nBtnWidth)) For nItem:=1 to Mlcount(cText) nTextWidth:= Max( oFont:GetTextWidth(Alltrim( Memoline(cText,,nItem) )), Application:oFont:GetTextWidth( cTitle )+60 )+10 Next nFormWidth:= Max(nButtonsWidth+15,nTextWidth+30+If(!Empty(cImage),45,0)) nBtnPosX:=(nFormWidth-nButtonsWidth)/2 DEFINE FORM oForm TITLE cTitle OF Application:oActiveform ; SIZE nFormWidth, 155 BORDERSTYLE bsDIALOG If !Empty(cImage) // oImage:= TPicture():Create( cImage ) // oImage:SetBounds( 20, 12, 10, 60 ) // oImage:lTransparent:= .T. @ 20,12 Image oImage OF oForm Size 50, 50 FILE cImage NONE NOTABSTOP transparent @ 10,60 LABEL cText VAR oTexto SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter oTexto:lParentFont:= .F. oTexto:oFont:= oFont Else @ 10, 10 LABEL cText VAR oTexto SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter // @ 10, 10 LABEL cText VAR oTexto SIZE nTextWidth, 70 OF oForm ALIGNMENT taCenter VALIGNMENT vaCenter oTexto:lParentFont:= .F. oTexto:oFont:= oFont Endif For nItem:=1 To Len(aOptions) @ nBtnPosY, nBtnPosX BUTTON aBtn[nItem] CAPTION aOptions[nItem] SIZE nBtnWidth, 30 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 oFont:End() 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 ); hb_storvc( 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 ) LOCAL hBitmap, oBitMap Default lPreview To .T. Default cTitle To "Impresión de pantalla" Application:lBusy := .T. hBitmap := If(oForm=Nil,XA_CaptureBitmap( GetDesktopWindow(),0,0,Screen:PaperRes()[2],Screen:PaperRes()[1] ),; XA_CaptureBitmap( oForm:Handle, -10, -25, oForm:nHeight ,oForm:nWidth) ) oBitmap := TBitmap():CreateFromHandle( hBitmap ) Printer:lPreview := lPreview Printer:nPreviewShowMode := smMAXIMIZE Printer:nPrintQuality := DMRES_HIGH Printer:cJobTitle := cTitle Printer:nOrientation := DMORIENT_LANDSCAPE Printer:StartDoc() Printer:oCanvas:nMapMode := mmPIXELS Printer:StartPage() Printer:oCanvas:DrawPicture( { 100,100,Printer:PaperRes()[1],Printer:PaperRes()[2] }, oBitmap ) 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", 11,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() 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 #include XA_FUNC( PLAYSOUNDWAIT ) { // char * szSound = hb_parc( 1 ); const char * szSound = hb_parc( 1 ); if( szSound ) hb_retl( PlaySound( szSound, NULL, SND_SYNC | SND_FILENAME | SND_NODEFAULT ) ); } XA_FUNC( PLAYSOUND ) { // char * szSound = hb_parc( 1 ); const char * szSound = hb_parc( 1 ); if( szSound ) hb_retl( PlaySound( szSound, NULL, SND_ASYNC | SND_FILENAME | SND_NODEFAULT ) ); } #pragma ENDDUMP //------------------------------------------------------------------------------