romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
7abec075492629a5166b1533702efcfe0c9fe4e1
comun/clase/MessageBox.vc2

776 lines
25 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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="" />
*<PropValue>
Caption = "Command1"
FontCharSet = 238
Name = "messagebox_boton"
Width = 80
*</PropValue>
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="" />
*<PropValue>
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
*</PropValue>
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="" />
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
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
*</PropValue>
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="" />
*<PropValue>
Desktop = .T.
DoCreate = .T.
Name = "messagebox_form_desktop"
cmgBotones.Name = "cmgBotones"
edtMensaje.Name = "edtMensaje"
*</PropValue>
ENDDEFINE
DEFINE CLASS messagebox_grupobotones AS commandgroup
*< CLASSDATA: Baseclass="commandgroup" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: boton_click
*</DefinedPropArrayMethod>
*<PropValue>
BackStyle = 0
BorderStyle = 0
ButtonCount = 0
Height = 66
Name = "messagebox_grupobotones"
SpecialEffect = 1
Value = 0
Width = 94
*</PropValue>
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="" />
*<PropValue>
BackStyle = 0
Height = 32
Name = "messagebox_icono"
Stretch = 1
Width = 32
*</PropValue>
ENDDEFINE
DEFINE CLASS messagebox_implem AS custom && Implementación del messagebox
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "messagebox.h"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
botones = 0
cmgbotones_mbot = 0
edtmensaje_mbot = 0
edtmensaje_mright = 0
Height = 31
Name = "messagebox_implem"
timeoutvalue = 0
titulo =
Width = 100
*</PropValue>
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="" />
*<DefinedPropArrayMethod>
*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]
*</DefinedPropArrayMethod>
*<PropValue>
cmetodo =
econtexto = THIS
Height = 23
icontador = 0
iiteracion = 1
Name = "o_timer_tareas"
nsaltearerror = 0
Width = 23
*</PropValue>
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
Reference in New Issue View Git Blame Copy Permalink