*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="messagebox.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS messagebox_boton AS _commandbutton OF "_baza.vcx" *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> * Caption = "Command1" FontCharSet = 238 Name = "messagebox_boton" Width = 80 * PROCEDURE Click THIS.PARENT.Boton_Click(THIS) ENDPROC ENDDEFINE DEFINE CLASS messagebox_edtmensaje AS _editbox OF "_baza.vcx" *< CLASSDATA: Baseclass="editbox" Timestamp="" Scale="Pixels" Uniqueid="" /> * BackColor = 236,233,216 BackStyle = 0 BorderStyle = 0 DisabledBackColor = 236,233,216 FontCharSet = 238 Height = 23 Name = "messagebox_edtmensaje" ReadOnly = .T. SpecialEffect = 1 TabStop = .F. Width = 165 * ENDDEFINE DEFINE CLASS messagebox_form AS form && Sustituye al messagebox y acepta timeout *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="cmgBotones" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="edtMensaje" UniqueID="" Timestamp="" /> * *m: boton_click && Este evento se dispara cuando se hace click en un botón de comando. *p: idopcion && Guarda el ID de la opción elegida * * AlwaysOnTop = .T. AutoCenter = .T. BorderStyle = 3 Caption = "Form2" ControlBox = .F. DoCreate = .T. FontCharSet = 238 Height = 88 idopcion = 2 MaxButton = .F. MinButton = .F. Name = "messagebox_form" ShowWindow = 1 Width = 198 * ADD OBJECT 'cmgBotones' AS messagebox_grupobotones WITH ; Height = 29, ; Left = 8, ; Name = "cmgBotones", ; Top = 44, ; Width = 94 *< END OBJECT: ClassLib="messagebox.vcx" BaseClass="commandgroup" /> ADD OBJECT 'edtMensaje' AS messagebox_edtmensaje WITH ; Left = 18, ; Name = "edtMensaje", ; ScrollBars = 2, ; Top = 9 *< END OBJECT: ClassLib="messagebox.vcx" BaseClass="editbox" /> PROCEDURE boton_click && Este evento se dispara cuando se hace click en un botón de comando. LPARAMETERS toBoton THISFORM.oImp.Boton_Click(@toBoton) ENDPROC PROCEDURE Init LPARAMETERS tcMensaje, tiBotones, tcTitulo, tcFont, tnTimeout ,tnTimeoutValue THIS.NEWOBJECT("oImp", "messagebox_Implem", "MessageBox.vcx", "", ; @tcMensaje, @tiBotones, @tcTitulo, @tcFont, @tnTimeout ,@tnTimeoutValue) ENDPROC PROCEDURE QueryUnload NODEFAULT THISFORM.oImp.Form_Hide() ENDPROC PROCEDURE Resize THISFORM.oImp.Form_Resize() ENDPROC ENDDEFINE DEFINE CLASS messagebox_form_desktop AS messagebox_form OF "messagebox.vcx" *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> * Desktop = .T. DoCreate = .T. Name = "messagebox_form_desktop" cmgBotones.Name = "cmgBotones" edtMensaje.Name = "edtMensaje" * ENDDEFINE DEFINE CLASS messagebox_grupobotones AS commandgroup *< CLASSDATA: Baseclass="commandgroup" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: boton_click * * BackStyle = 0 BorderStyle = 0 ButtonCount = 0 Height = 66 Name = "messagebox_grupobotones" SpecialEffect = 1 Value = 0 Width = 94 * PROCEDURE boton_click LPARAMETERS toBoton IF VARTYPE(toBoton) = "O" AND NOT ISNULL(toBoton) THIS.PARENT.Boton_Click(toBoton) ENDIF ENDPROC PROCEDURE Click *THIS.PARENT.Boton_Click(THIS.VALUE) ENDPROC ENDDEFINE DEFINE CLASS messagebox_icono AS image *< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" /> * BackStyle = 0 Height = 32 Name = "messagebox_icono" Stretch = 1 Width = 32 * ENDDEFINE DEFINE CLASS messagebox_implem AS custom && Implementación del messagebox *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "messagebox.h" * *m: boton_click && Este evento ocurre cuando se clickea un botón de opción *m: form_activate && Ocurre cuando un objeto FormSet, Form o Page se activa o cuando se muestra un objeto ToolBar. *m: form_hide && Método para ocultart el form *m: form_resize && Este evento se dispara cuando se hace un resize del form *m: get_estilofuente *m: timeout && Este evento se dispara al finalizar el tiempo de timeout, si es que se indicó un valor de timeout para el mensaje. *p: botones && Valor numérico que indica que botones mostrar, icono y botón por defecto *p: cmgbotones_mbot *p: edtmensaje_mbot *p: edtmensaje_mright *p: form_activated && Indica si ya se ejecutó el Activate del form *p: timeoutvalue && Valor por defecto a usar si se alcanza el timeout del mensaje. *p: titulo && Titulo de la ventana * * botones = 0 cmgbotones_mbot = 0 edtmensaje_mbot = 0 edtmensaje_mright = 0 Height = 31 Name = "messagebox_implem" timeoutvalue = 0 titulo = Width = 100 * PROCEDURE boton_click && Este evento ocurre cuando se clickea un botón de opción LPARAMETERS toBoton LOCAL lcNombreBoton lcNombreBoton = STRTRAN(UPPER(toBoton.NAME), "\<", "") DO CASE CASE VARTYPE(toBoton) = "N" THISFORM.IDOpcion = toBoton CASE lcNombreBoton = "CMDOK" THISFORM.IDOpcion = 1 CASE lcNombreBoton = "CMDABORT" THISFORM.IDOpcion = 3 CASE lcNombreBoton = "CMDRETRY" THISFORM.IDOpcion = 4 CASE lcNombreBoton = "CMDIGNORE" THISFORM.IDOpcion = 5 CASE lcNombreBoton = "CMDYES" THISFORM.IDOpcion = 6 CASE lcNombreBoton = "CMDNO" THISFORM.IDOpcion = 7 OTHERWISE && CANCEL THISFORM.IDOpcion = 2 ENDCASE THIS.Form_Hide() ENDPROC PROCEDURE form_activate && Ocurre cuando un objeto FormSet, Form o Page se activa o cuando se muestra un objeto ToolBar. WITH THIS IF NOT .Form_Activated .Form_Activated = .T. .PARENT.SETALL("TABSTOP", .T.) ENDIF ENDWITH && THIS ENDPROC PROCEDURE form_hide && Método para ocultart el form IF PEMSTATUS(THIS, "tmrTarea", 5) THIS.tmrTarea.ResetParams() ENDIF THISFORM.HIDE() ENDPROC PROCEDURE form_resize && Este evento se dispara cuando se hace un resize del form WITH THIS.PARENT .edtMensaje.MOVE(.edtMensaje.LEFT, ; .edtMensaje.TOP, ; .WIDTH - THIS.edtMensaje_mRight - .edtMensaje.LEFT, ; .HEIGHT - THIS.edtMensaje_mBot - .edtMensaje.TOP) .cmgBotones.MOVE((.WIDTH - .cmgBotones.WIDTH) / 2, ; .HEIGHT - THIS.cmgBotones_mBot) ENDWITH ENDPROC PROCEDURE get_estilofuente LPARAMETERS tlFontBold, tlFontItalic, tlFontUnderline, tlFontStrikeThru *-- Devuelve un código de Estilo de Fuente para uso de FONTMETRIC u otras *-- funciones que requieren este tipo de código. *-- PARAMETROS: *-- tlFontBold Referencia de Objeto del control de edición o letra Negrita *-- tlFontItalic Si tlFontBold indica letra Negrita, indica letra Itálica (Cursiva) *-- tlFontUnderline Si tlFontBold indica letra Negrita, indica letra Subrayada *-- tlFontStrikeThru Si tlFontBold indica letra Negrita, indica letra Tachada LOCAL ; lcEstilo, ; llFontBold, ; llFontItalic, ; llFontUnderline, ; llFontStrikeThru lcEstilo = "" DO CASE CASE PCOUNT() = 0 =MESSAGEBOX("No se indicaron parámetros", MB_OK + MB_ICONEXCLAMATION, PROGRAM()) CASE VARTYPE(tlFontBold) = "O" AND NOT PEMSTATUS(tlFontBold, "FONTNAME", 5) =MESSAGEBOX("El objeto indicado no es un control de Edición de datos", MB_OK + MB_ICONEXCLAMATION, PROGRAM()) CASE VARTYPE(tlFontBold) = "O" *-- Se indicó un Objeto llFontBold = tlFontBold.FONTBOLD llFontItalic = tlFontBold.FONTITALIC llFontUnderline = tlFontBold.FONTUNDERLINE llFontStrikeThru = tlFontBold.FONTSTRIKETHRU OTHERWISE *-- Se indicó un Nombre de Fuente llFontBold = tlFontBold llFontItalic = tlFontItalic llFontUnderline = tlFontUnderline llFontStrikeThru = tlFontStrikeThru ENDCASE lcEstilo = lcEstilo + IIF(llFontBold, "B", "") lcEstilo = lcEstilo + IIF(llFontItalic, "I", "N") lcEstilo = lcEstilo + IIF(llFontUnderline, "U", "") lcEstilo = lcEstilo + IIF(llFontStrikeThru, "-", "") RETURN lcEstilo ENDPROC PROCEDURE Init LPARAMETERS tcMensaje, tiBotones, tcTitulo, tcFont, tnTimeout, tnTimeoutValue WITH THIS.PARENT LOCAL lnMargen, lnLeft_Anterior, lnTamañoIcono, lnBotonesWidth, lnMaxTxtWidth, lnAnchoScrollbar, ; laLines(1), lnEditboxWidth, lnEditboxHeight, I, lnCantLineas, lnAnchoMedioFuente, lnTotalTXTHeight, ; lnFormWidth, lnFormHeight, lnBotonesHeight, lcFontName, liFontSize, lcFontStyle, lnMargenEditbox, ; llSalidaDeEmergencia, lnAreaWidth, lnAreaHeight, llExisteActiveForm lnMargen = 10 && Margen de los controles al borde del form lnAnchoScrollbar = SYSMETRIC(5) IF !EMPTY(tcFont) AND VARTYPE(tcFont) = [C] .edtMensaje.FONTNAME = tcFont ENDIF *!* modificare 16.01.2014 : diacritice If Afont(laFontMsgBox,.FontName,238,1) .FontCharSet = 238 Endif For i = 1 To .Objects.Count If Pemstatus(.Objects[i],"FontName",5) If Afont(laFontMsgBox,.Objects[i].FontName,238,1) .Objects[i].FontCharSet = 238 Endif Endif Endfor Release laFontMsgBox *!* modificare 16.01.2014 : diacritice ^ IF EMPTY(tiBotones) tiBotones = 0 ENDIF *-- MENSAJE IF EMPTY(tcMensaje) tcMensaje = "(nimic)" ELSE *!* 12.02.2008 && DACA AM IN MESAJ DOAR LF-URI SE STRICA FORMATAREA && TREBUIE FACUT CU REGEX DA - DACA EXISTA DOAR LF-UL LA SFARSITUL LINIEI SA IL INLOCUIASCA CU CRLF IF .F. tcMensaje = STRTRAN(tcMensaje, LF, "") tcMensaje = STRTRAN(tcMensaje, CR, CRLF) ENDIF *!* 12.02.2008 ^ ENDIF .edtMensaje.VALUE = tcMensaje *-- TITULO .CAPTION = IIF(EMPTY(tcTitulo), APPLICATION.CAPTION, tcTitulo) *-- GUARDO LOS VALORES DE LOS PARÁMETROS THIS.Botones = tiBotones THIS.Titulo = tcTitulo THIS.TimeoutValue = tnTimeoutValue *-- Este timer ejecuta una tarea por única vez, que consiste en activar *-- los TabStop de todos los controles, que están en .F. excepto *-- el botón por defecto, que ya tiene .T. *-- Este truco es para ubicar el foco en el botón por defecto *-- sin usar SETFOCUS, ya que como la intención de esta ventana es *-- que sirva para mostrar mensajes de error, de ocurrir uno *-- en el VALID de algún control, el SETFOCUS causaría otro error más. THIS.ADDOBJECT("tmrFoco", "o_Timer_Tareas") THIS.tmrFoco.DOCMD("Form_Activate", THIS, 100, 1) *-- BOTONES DE OPCIÓN WITH .cmgBotones DO CASE CASE BITAND(tiBotones, 5) = 5 && RETRY/CANCEL .ADDOBJECT("cmdRetry", "messagebox_Boton") .cmdRetry.CAPTION = MB_CAPTION_RETRY .ADDOBJECT("cmdCancel", "messagebox_Boton") .cmdCancel.CAPTION = MB_CAPTION_CANCEL .cmdCancel.CANCEL = .T. CASE BITAND(tiBotones, 4) = 4 && YES/NO .ADDOBJECT("cmdYes", "messagebox_Boton") .cmdYes.CAPTION = MB_CAPTION_YES .ADDOBJECT("cmdNo", "messagebox_Boton") .cmdNo.CAPTION = MB_CAPTION_NO .cmdNo.CANCEL = .T. .PARENT.CLOSABLE = .F. CASE BITAND(tiBotones, 3) = 3 && YES/NO/CANCEL .ADDOBJECT("cmdYes", "messagebox_Boton") .cmdYes.CAPTION = MB_CAPTION_YES .ADDOBJECT("cmdNo", "messagebox_Boton") .cmdNo.CAPTION = MB_CAPTION_NO .ADDOBJECT("cmdCancel", "messagebox_Boton") .cmdCancel.CAPTION = MB_CAPTION_CANCEL .cmdCancel.CANCEL = .T. CASE BITAND(tiBotones, 2) = 2 && ABORT/RETRY/IGNORE .ADDOBJECT("cmdAbort", "messagebox_Boton") .cmdAbort.CAPTION = MB_CAPTION_ABORT .ADDOBJECT("cmdRetry", "messagebox_Boton") .cmdRetry.CAPTION = MB_CAPTION_RETRY .ADDOBJECT("cmdIgnore", "messagebox_Boton") .cmdIgnore.CAPTION = MB_CAPTION_IGNORE .PARENT.CLOSABLE = .F. CASE BITAND(tiBotones, 1) = 1 && OK/CANCEL .ADDOBJECT("cmdOk", "messagebox_Boton") .cmdOK.CAPTION = MB_CAPTION_OK .ADDOBJECT("cmdCancel", "messagebox_Boton") .cmdCancel.CAPTION = MB_CAPTION_CANCEL .cmdCancel.CANCEL = .T. OTHERWISE && OK .ADDOBJECT("cmdOk", "messagebox_Boton") .cmdOK.CAPTION = MB_CAPTION_OK .cmdOK.CANCEL = .T. ENDCASE ENDWITH && .cmgBotones *-- ICONOS DO CASE CASE BITAND(tiBotones, 64) = 64 && ICONINFORMATION .ADDOBJECT("imgIcono", "messagebox_Icono") .imgIcono.PICTURE = MB_ICONINFORMATION_BMP CASE BITAND(tiBotones, 48) = 48 && ICONEXCLAMATION .ADDOBJECT("imgIcono", "messagebox_Icono") .imgIcono.PICTURE = MB_ICONEXCLAMATION_BMP CASE BITAND(tiBotones, 32) = 32 && ICONQUESTION .ADDOBJECT("imgIcono", "messagebox_Icono") .imgIcono.PICTURE = MB_ICONQUESTION_BMP CASE BITAND(tiBotones, 16) = 16 && ICONSTOP .ADDOBJECT("imgIcono", "messagebox_Icono") .imgIcono.PICTURE = MB_ICONSTOP_BMP ENDCASE IF PEMSTATUS(THIS.PARENT, "ImgIcono", 5) .imgIcono.MOVE(5, 5, 32, 32) .imgIcono.VISIBLE = .T. lnTamañoIcono = 32 &&+ lnMargen ELSE lnTamañoIcono = 0 ENDIF IF TYPE('oChatBot') = 'O' .ADDOBJECT("imgChatBot", "messagebox_Icono") .imgChatBot.PICTURE = MB_ICONCHATBOT_BMP .imgChatBot.MOVE(5, 35, 32, 32) .imgChatBot.VISIBLE = .T. .imgChatBot.ToolTipText = "Click pentru ChatBot Suport Tehnic" BINDEVENT(.imgChatBot,"Click", oChatbot, "launch") ENDIF *-- CALCULO EL TAMAÑO DEL EDITBOX lcFontName = .edtMensaje.FONTNAME liFontSize = .edtMensaje.FONTSIZE lcFontStyle = THIS.Get_EstiloFuente(.edtMensaje) lnAnchoMedioFuente = FONTMETRIC(6, lcFontName, liFontSize, lcFontStyle) && Ancho medio fuente lnAnchoMedioFuente = lnAnchoMedioFuente * 1.5 && maresc cu 20% pentru cazul in care am multe caractere inguste lnAlturaMaxFuente = FONTMETRIC(1, lcFontName, liFontSize, lcFontStyle) && Alto fuente lnEditboxWidth = 0 lnMaxTxtWidth = 0 lnMargenEditbox = .edtMensaje.MARGIN * 2 + .edtMensaje.BORDERSTYLE * 2 lnCantLineas = ALINES(laLines, .edtMensaje.VALUE, .T.) lnTotalTXTHeight = lnCantLineas * lnAlturaMaxFuente + lnMargenEditbox lnBotonesHeight = .cmgBotones.BUTTONS(1).HEIGHT lnBotonesWidth = .cmgBotones.BUTTONCOUNT * (.cmgBotones.BUTTONS(1).WIDTH + lnMargen) - lnMargen *-- Calculo el ancho en pixels de la línea más larga del mensaje FOR I = 1 TO lnCantLineas lnMaxTxtWidth = MAX(lnMaxTxtWidth, TXTWIDTH(laLines(I), lcFontName, liFontSize, lcFontStyle) * lnAnchoMedioFuente) ENDFOR *-- Determino respecto de qué contenedor muestro el mensaje: *-- Objeto _SCREEN, Objeto u ActiveForm. *-- IMPORTANTE: En el caso de que no se pueda mostrar el mensaje *-- se creará automáticamente un timeout para que salga por Cancelar. *| llExisteActiveForm = TYPE("_SCREEN.ACTIVEFORM") = "O" *| DO CASE *| CASE _SCREEN.VISIBLE AND (NOT llExisteActiveForm OR llExisteActiveForm AND _SCREEN.ACTIVEFORM.SHOWWINDOW = 0) *| *-- Centro respecto de _Screen (cuando _SCREEN es visible y el form activo *| *-- se muestra dentro de la pantalla principal de VFP) *| lnAreaWidth = _SCREEN.WIDTH *| lnAreaHeight = _SCREEN.HEIGHT *| *| CASE llExisteActiveForm AND _SCREEN.ACTIVEFORM.SHOWWINDOW > 0 *| *-- Centro respecto del Form activo (cuando el form activo se muestra *| *-- en un formulario de nivel superior o como un formulario de nivel superior) *| lnAreaWidth = _SCREEN.ACTIVEFORM.WIDTH *| lnAreaHeight = _SCREEN.ACTIVEFORM.HEIGHT *| *| OTHERWISE *| *-- SALIDA DE EMERGENCIA: No puedo determinar *| *-- respecto de qué container mostrar el mensaje, *| *-- el el container no es visible. *| llSalidaDeEmergencia = .T. *| ENDCASE *| *| IF llExisteActiveForm *| _SCREEN.ACTIVEFORM.LOCKSCREEN = .F. && SI ESTAN BLOQUEADAS LAS ACTUALIZACIONES NO SE VE EL MENSAJE *| ENDIF *| _SCREEN.LOCKSCREEN = .F. && SI ESTAN BLOQUEADAS LAS ACTUALIZACIONES NO SE VE EL MENSAJE *| *| IF llSalidaDeEmergencia *| *-- SALIDA DE EMERGENCIA *| IF EMPTY(THIS.TimeoutValue) *| THIS.TimeoutValue = 2 && Es CANCEL si no se indicó valor por defecto. *| ENDIF *| THIS.ADDOBJECT("tmrTarea", "o_Timer_Tareas") *| THIS.tmrTarea.DOCMD("TimeOut", THIS, 100, 1) *| ELSE *-- SI SE INDICO UN TIMEOUT AGREGO UN TIMER IF NOT EMPTY(tnTimeout) THIS.ADDOBJECT("tmrTarea", "o_Timer_Tareas") THIS.tmrTarea.DOCMD("TimeOut", THIS, tnTimeout * 1000, 1) ENDIF *| ENDIF lnAreaWidth = SYSMETRIC(1) lnAreaHeight = SYSMETRIC(2) *| lnAreaWidth = _SCREEN.WIDTH *| lnAreaHeight = _SCREEN.HEIGHT *-- Calculo el ancho de la ventana del mensaje lnFormWidth = MAX(lnBotonesWidth + lnMargen * 2, MIN(lnAreaWidth - SYSMETRIC(3) * 2 - 40, ; lnMaxTxtWidth + lnMargenEditbox + lnAnchoScrollbar + IIF(lnTamañoIcono = 0, 0, lnTamañoIcono + lnMargen) + lnMargen * 2 + SYSMETRIC(3) * 0)) lnFormHeight = MIN(lnAreaHeight - SYSMETRIC(4) * 2 - 40, (MAX(lnTamañoIcono, lnTotalTXTHeight) + lnBotonesHeight + lnMargen * 3 + SYSMETRIC(4) * 0)) *!* 14.05.2007 *!* Inaltimea formularului sa nu depaseasca 2/3 din ecran lnFormHeight = MIN(lnFormHeight, ROUND(_SCREEN.Height * 0.66, 0)) lnEditboxHeight = lnFormHeight - lnBotonesHeight - lnMargen * 3 lnEditboxWidth = lnFormWidth - lnMargen * 2 - IIF(lnTamañoIcono = 0, 0, lnTamañoIcono + lnMargen) .edtMensaje.MOVE(IIF(lnTamañoIcono = 0, 0, lnTamañoIcono + lnMargen) + lnMargen, lnMargen, lnEditboxWidth, lnEditboxHeight) *-- Determino si mostrar las Scrollbars en el Editbox .edtMensaje.SCROLLBARS = IIF(lnTotalTXTHeight > lnEditboxHeight, 2, 0) *-- Ubico la ventana del mensaje .MOVE((lnAreaWidth - lnFormWidth - SYSMETRIC(3) * 2) / 2, ; (lnAreaHeight - lnFormHeight - SYSMETRIC(4) * 2 - SYSMETRIC(9)) / 2, ; lnFormWidth, ; lnFormHeight) .AutoCenter = .T. WITH .cmgBotones *-- Ubico cada botón, uno al lado del otro FOR EACH loBoton IN .BUTTONS loBoton.MOVE(loBoton.WIDTH * (loBoton.TABINDEX - 1) + (loBoton.TABINDEX - 1) * lnMargen) loBoton.VISIBLE = .T. ENDFOR *-- Ubico el grupo de botones de la ventana del mensaje .MOVE((lnFormWidth - lnBotonesWidth) / 2, lnFormHeight - lnBotonesHeight - lnMargen, lnBotonesWidth, lnBotonesHeight) DO CASE CASE (BITAND(tiBotones, 2) = 2 ; OR BITAND(tiBotones, 3) = 3) ; AND BITAND(tiBotones, 512) = 512 *-- 3er.BOTÓN POR DEFECTO loBoton = .BUTTONS(3) CASE (BITAND(tiBotones, 1) = 1 ; OR BITAND(tiBotones, 2) = 2 ; OR BITAND(tiBotones, 3) = 3 ; OR BITAND(tiBotones, 4) = 4 ; OR BITAND(tiBotones, 5) = 5) ; AND BITAND(tiBotones, 256) = 256 *-- 2do.BOTÓN POR DEFECTO loBoton = .BUTTONS(2) OTHERWISE && First button is DEFAULT *-- 1er.BOTÓN POR DEFECTO loBoton = .BUTTONS(1) ENDCASE ENDWITH && .cmgBotones loBoton.TABSTOP = .T. .TABINDEX = 1 *-- Asigno el ID por defecto LOCAL lcNombreBoton lcNombreBoton = STRTRAN(UPPER(loBoton.NAME), "\<", "") DO CASE CASE lcNombreBoton = "CMDOK" .IDOpcion = 1 CASE lcNombreBoton = "CMDCANCEL" .IDOpcion = 2 CASE lcNombreBoton = "CMDABORT" .IDOpcion = 3 CASE lcNombreBoton = "CMDRETRY" .IDOpcion = 4 CASE lcNombreBoton = "CMDIGNORE" .IDOpcion = 5 CASE lcNombreBoton = "CMDYES" .IDOpcion = 6 CASE lcNombreBoton = "CMDNO" .IDOpcion = 7 ENDCASE *-- Guardo las posiciones de los controles *-- para usarlas en caso de Resize del usuario .MINWIDTH = lnBotonesWidth + lnMargen * 2 + lnMargenEditbox .MINHEIGHT = MAX(lnAlturaMaxFuente, lnTamañoIcono) + lnBotonesHeight + lnMargenEditbox + lnMargen * 3 THIS.cmgBotones_mBot = .HEIGHT - .cmgBotones.TOP THIS.edtMensaje_mBot = .HEIGHT - (.edtMensaje.TOP + .edtMensaje.HEIGHT) THIS.edtMensaje_mRight = .WIDTH - (.edtMensaje.LEFT + .edtMensaje.WIDTH) ENDWITH && THIS.PARENT ENDPROC PROCEDURE timeout && Este evento se dispara al finalizar el tiempo de timeout, si es que se indicó un valor de timeout para el mensaje. WITH THIS *-- Si no hay asignado un valor por defecto para el timeout, le asigno uno. IF NOT EMPTY(.TimeOutValue) .PARENT.IDOpcion = .TimeOutValue ENDIF .Form_Hide() ENDWITH && THIS.PARENT ENDPROC ENDDEFINE DEFINE CLASS o_timer_tareas AS timer *< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: docmd && Ejecuta un método en el objeto indicado. Parámetros: cMetodo, eContexto, iIntervalo, iIteración *m: resetparams *p: cmetodo && Nombre del método a ejecutar (P.Ej: Actualizar) *p: econtexto && Nombre o Referencia del contexto donde ejecutar el método (P.Ej: THIS) *p: icontador *p: iiteracion && Cantidad de veces que se debe ejecutar el método (Por defecto: 1) *p: lerror *p: locupado && Flag que indica si el timer está libre u ocupado. *p: nsaltearerror *a: aerrores[1,7] * * cmetodo = econtexto = THIS Height = 23 icontador = 0 iiteracion = 1 Name = "o_timer_tareas" nsaltearerror = 0 Width = 23 * PROCEDURE Destroy THIS.ResetParams() *_SCREEN.PRINT(PROGRAM() + CHR(13)) ENDPROC PROCEDURE docmd && Ejecuta un método en el objeto indicado. Parámetros: cMetodo, eContexto, iIntervalo, iIteración LPARAMETERS tcMetodo, teContexto, tiIntervalo, tiIteracion *-- Parámetros: *-- cMetodo Nombre del método a ejecutar (P.Ej: Actualizar) *-- eContexto Nombre o Referencia del contexto donde ejecutar el método (P.Ej: THIS) *-- iIntervalo Valor del intervalo en milisegundos *-- iIteracion Cantidad de veces que se debe ejecutar el método (Por defecto: 1) *-- Si se indica iIteracion = 0 el timer permanecerá activo hasta que *-- se le asigne otra tarea. *-- EJEMPLO DE USO: *-- * Ejecutar el método 'Actualizar_Imagen' del control actual. *-- * Sintaxis: oTimer.DoCmd(cMétodo, oObjeto, nMilisegundos [,iIteración]) *-- _SCREEN.oTimer_ControlesXP.DoCmd("Actualizar_Imagen", THIS, 200, 1) WITH THIS IF PCOUNT() = 0 *STRTOFILE(TTOC(DATETIME()) + " - Pedido de Cancelación de tarea" + CHR(13) + CHR(10), "TIMER.TXT", .T.) .ResetParams() ELSE IF tiIteracion = 0 *STRTOFILE(TTOC(DATETIME()) + " - Pedido de Asignación de tarea sin fin" + CHR(13) + CHR(10), "TIMER.TXT", .T.) ELSE *STRTOFILE(TTOC(DATETIME()) + " - Pedido de Asignación de tarea" + CHR(13) + CHR(10), "TIMER.TXT", .T.) ENDIF IF .lOcupado AND .iIteracion > 0 *STRTOFILE(TTOC(DATETIME()) + " - Se quiso asignar una tarea, pero el timer está ocupado." + CHR(13) + CHR(10), "TIMER.TXT", .T.) ELSE IF .iIteracion = 0 IF tiIteracion = 0 *STRTOFILE(TTOC(DATETIME()) + " - Reemplazo de tarea sin fin e Inicio de Tarea sin fin" + CHR(13) + CHR(10), "TIMER.TXT", .T.) ELSE *STRTOFILE(TTOC(DATETIME()) + " - Reemplazo de tarea sin fin e Inicio de Tarea" + CHR(13) + CHR(10), "TIMER.TXT", .T.) ENDIF ELSE *STRTOFILE(TTOC(DATETIME()) + " - Inicio de tarea" + CHR(13) + CHR(10), "TIMER.TXT", .T.) ENDIF .ResetParams() .cMetodo = tcMetodo .eContexto = teContexto .INTERVAL = tiIntervalo .iIteracion = tiIteracion .lOcupado = .T. .ENABLED = .T. ENDIF ENDIF ENDWITH && THIS ENDPROC PROCEDURE resetparams WITH THIS .ENABLED = .F. .INTERVAL = 0 .iIteracion = 1 .iContador = 0 .cMetodo = "" .eContexto = NULL .eContexto = "THIS" .lOcupado = .F. .RESET() ENDWITH && THIS ENDPROC PROCEDURE Timer WITH THIS IF .lOcupado LOCAL lcMetodo .RESET() LOCAL loContexto IF VARTYPE(.eContexto) = "O" loContexto = .eContexto ELSE loContexto = EVALUATE(.eContexto) ENDIF IF .lError .lError = .F. .ResetParams() RETURN ENDIF lcMetodo = IIF("(" $ .cMetodo, .cMetodo, .cMetodo + "()") WITH loContexto *=EVALUATE("." + THIS.cMetodo + "()") =EVALUATE("." + lcMetodo) ENDWITH && loContexto IF .lError .ResetParams() RETURN ENDIF .iContador = .iContador + 1 IF .iContador = .iIteracion .lError = .F. .ResetParams() *STRTOFILE(TTOC(DATETIME()) + " - Fin de tarea" + CHR(13) + CHR(10), "TIMER.TXT", .T.) ENDIF ELSE .RESET() *STRTOFILE(TTOC(DATETIME()) + " - Se intentó ejecutar una tarea retrasada luego de haber finalizado." + CHR(13) + CHR(10), "TIMER.TXT", .T.) ENDIF ENDWITH && THIS ENDPROC ENDDEFINE