HMGforum.com

Posted: **Sat Oct 27, 2018 4:27 pm**

Saludos amigos,

Tengo este código:

* ------------------------------------------------------ *
* SISTEMA     :                                          *
* PRG         :                                          *
* CREADO      :                                          *
* ACTUALIZADO :                                          *
* AUTOR       : EDUARDO V. FLORES RIVAS                  *
* COMENTARIOS :                                          *
* ------------------------------------------------------ *

PROC KardUbica
PARA cQueArtCod

IF IsWindowDefined(Win_KardUbic)=.T.
   MINIMIZE WINDOW Win_KardUbic
   RESTORE WINDOW Win_KardUbic
   RETURN
ENDIF

PRIVATE bColor  := { || if ( This.CellRowIndex/2 == int(This.CellRowIndex/2) , Mi_Verde_Nilo , { 255,255,255 } ) }
PRIVATE xOldSlc := SELECT()

DEFINE WINDOW Win_KardUbic ;
   AT 0 , 0 ;
   WIDTH 380 HEIGHT 420 ;
   TITLE "Ubicaciones" ;
   MODAL ;
   FONT "Arial" SIZE 9 ;
   ON INIT KardUbicIniciar() ;
   ON RELEASE KardUbicCerrar()
   
   ON KEY ESCAPE OF Win_KardUbic ACTION KardUbicSalir()
   ON KEY INSERT OF Win_KardUbic ACTION KardUbicClon()
   ON KEY DELETE OF Win_KardUbic ACTION KardUbicDele()

   @ 010 , 010 TEXTBOX TxtStock ;
   WIDTH 100 ;
   HEIGHT 20 ;
   READONLY ;
   DISABLEDBACKCOLOR Mi_Verde_Nilo ;
   NUMERIC INPUTMASK '9999999'
   
*
*    GRID DE SELECCIONADOR
*
   @ 040 , 010 GRID GrdItems ;
   WIDTH  350 ;
   HEIGHT 270 ;
   HEADERS {'Id.'   ,'Unids.','Vence'   ,'Ubic.Act.'  ,'Ubic.Nuev.'} ;
   WIDTHS  {  70    ,  60    ,   60     ,   60        ,   70       } ;
   JUSTIFY { BrwC   , BrwC   , BrwL     , BrwR        , BrwR       } ;
   DYNAMICBACKCOLOR { bColor , bColor , bColor , bColor , bColor } ;
   EDIT ;
   COLUMNWHEN  { { || .F. } , { || .T. }            , { || .F. } , { || .F. } , { || .T. }           } ;
   COLUMNVALID { nil        , { || KardUbicSetU() } , nil        , nil        , { || KardUbicSet() } }

   @ 340 , 210 TEXTBOX TxtTtlUnid ;
   WIDTH 100 ;
   HEIGHT 20 ;
   READONLY ;
   DISABLEDBACKCOLOR Mi_Amarillo ;
   NUMERIC INPUTMASK '9999999'

END WINDOW

   CENTER WINDOW Win_KardUbic
   ACTIVATE WINDOW Win_KardUbic
   SELE &xOldSlc
   
RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicIniciar

LOCAL nTotalUnids := 0
LOCAL xOldSel     := SELECT()

   SELE MARTI
   SET ORDER TO TAG ArtixCodi
   DBSEEK( cQueArtCod )
   IF FOUND()
      Win_KardUbic.TxtStock.Value := MARTI->STOCK_U
   ENDIF

   DELETE ITEM ALL FROM GrdItems OF Win_KardUbic
   SELE XUBIC
   SET ORDER TO TAG UbicxArti
   DBSEEK( cQueArtCod )
   IF FOUND()
      DO WHILE XUBIC->(RTRIM(UB_ARTCOD)) = RTRIM(cQueArtCod)
         IF XUBIC->UB_STOCK > 0
            ADD ITEM { ;
            XUBIC->(STRZERO(RECNO(),7)) ,;
            XUBIC->UB_STOCK ,;
            XUBIC->UB_VENCE ,;
            XUBIC->UB_UBICA ,;
            XUBIC->UB_UBICA } TO GrdItems OF Win_KardUbic
            nTotalUnids := nTotalUnids + XUBIC->UB_STOCK
         ENDIF
         SKIP
      ENDDO
   ENDIF
   SELE &xOldSel

   Win_KardUbic.TxtTtlUnid.Value := nTotalUnids
   
RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicSalir

   RELEASE WINDOW Win_KardUbic

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicCerrar

   IF Win_KardUbic.TxtTtlUnid.Value <> Win_KardUbic.TxtStock.Value
      MsgInfo('Las unidades no coinciden con el stock.')
      RETURN .F.
   ENDIF

RETURN .T.


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicSetU

   IF ! EMPTY(This.CellValue)

      aDat := Win_KardUbic.GrdItems.Item (Win_KardUbic.GrdItems.Value)
      SELE XUBIC
      DBGOTO( VAL(aDat[1]) )
      IF RED_RLOCK()
         XUBIC->UB_STOCK := VAL(This.CellValue)
         RED_UNLOCK()
      ENDIF
      KardUbicIniciar()
      
   ENDIF

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicSet

   IF ! EMPTY(This.CellValue)

      aDat := Win_KardUbic.GrdItems.Item (Win_KardUbic.GrdItems.Value)
      SELE XUBIC
      DBGOTO( VAL(aDat[1]) )
      IF RED_RLOCK()
         XUBIC->UB_UBICA := This.CellValue
         RED_UNLOCK()
      ENDIF
      KardUbicIniciar()
      
   ENDIF

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicClon

   IF Win_KardUbic.GrdItems.Value > 0

      aDat := Win_KardUbic.GrdItems.Item (Win_KardUbic.GrdItems.Value)
      cCuantas := INPUTBOX('Separar unidades:')

      IF VAL(cCuantas) > 0 .AND. VAL(cCuantas) < VAL(aDat[2])
         SELE XUBIC
         DBGOTO( VAL(aDat[1]) )
         IF RED_RLOCK()
            XUBIC->UB_STOCK  := VAL(aDat[2]) - VAL(cCuantas)
            RED_UNLOCK()
         ENDIF
         IF RED_APPE()
            XUBIC->UB_ARTCOD := cQueArtCod
            XUBIC->UB_VENCE  := aDat[3]
            XUBIC->UB_UBICA  := aDat[4]
            XUBIC->UB_STOCK  := VAL(cCuantas)
            RED_UNLOCK()
         ENDIF
         KardUbicIniciar()
      ENDIF

   ELSE

      IF Win_KardUbic.GrdItems.ItemCount = 0 .AND. Win_KardUbic.TxtStock.Value > 0
         aLoteLook := DameLote( cQueArtCod )
         SELE XUBIC
         IF RED_APPE()
            XUBIC->UB_ARTCOD := cQueArtCod
            XUBIC->UB_VENCE  := aLoteLook[2]
            XUBIC->UB_UBICA  := SPACE(6)
            XUBIC->UB_STOCK  := Win_KardUbic.TxtStock.Value
            RED_UNLOCK()
         ENDIF
         KardUbicIniciar()
      ENDIF

   ENDIF

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicSum

LOCAL nItm
LOCAL aItm
LOCAL nTot := 0

   FOR nItm = 1 TO Win_KardUbic.GrdItems.ItemCount
      aItm := Win_KardUbic.GrdItems.Item (nItm)
      nTot := nTot + VAL( aItm[2] )
   NEXT

   Win_KardUbic.TxtTtlUnid.Value := nTotalUnids
   
RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicDele

   IF Win_KardUbic.GrdItems.Value > 0

      aDat := Win_KardUbic.GrdItems.Item (Win_KardUbic.GrdItems.Value)
      SELE XUBIC
      DBGOTO( VAL(aDat[1]) )
      IF RED_RLOCK()
         XUBIC->UB_STOCK  := 0
         RED_UNLOCK()
      ENDIF
      KardUbicIniciar()

   ENDIF

RETURN

Lo que necesito es que si el usuario cierra la ventana (con escape o con el botón de cerrar) se evalue esta sub:

Code: Select all

*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC KardUbicCerrar

   IF Win_KardUbic.TxtTtlUnid.Value <> Win_KardUbic.TxtStock.Value
      MsgInfo('Las unidades no coinciden con el stock.')
      RETURN .F.
   ENDIF

RETURN .T.

Pero la idea es que si la suma de las unidades de cada item son diferentes al stock no permita la salida de la ventana. Así como esta la procedure muestra el mensaje "Las unidades no coinciden con el stock" pero igual cierra la ventana.

Agradezco su ayuda de antemano amigos. Reciban todos un cordial saludo.

Atentamente,

Posted: **Sat Oct 27, 2018 5:17 pm**

Si el
ON RELEASE KardUbicCerrar()

Lo cambias por
ON INTERACTIVECLOSE KardUbicCerrar()

"If the ‘InteractiveClose’ procedure returns .T., the window will be closed normally, otherwise it will not be closed."

HMGforum.com

Window release

Window release

Re: Window release