Ampliar la vista de un formulario

Después de activar la casilla correspondiente, la parte del formulario bajo el cursor del mouse, se re dibuja en la ventana principal de foxpro como visto con una lupa.


*-- Aquí el código:

LOCAL oForm
oForm = CREATEOBJECT("Tform")
oForm.SHOW(1)

DEFINE CLASS Tform AS FORM
  WIDTH = 350
  HEIGHT = 160
  BORDERSTYLE = 2
  MAXBUTTON = .F.
  MINBUTTON = .F.
  AUTOCENTER = .T.
  CAPTION = "Ampliar vista"
  hForm = 0
  hDC = 0

  ADD OBJECT chMagnify AS CHECKBOX WITH VALUE=.F.,;
    LEFT=20, TOP=20, AUTOSIZE=.T., CAPTION="Activar"

  ADD OBJECT chInvert AS CHECKBOX WITH VALUE=.F.,;
    LEFT=20, TOP=56, AUTOSIZE=.T., CAPTION="Invertir colores"

  ADD OBJECT lbl1 AS LABEL WITH;
    LEFT=190, TOP=20, AUTOSIZE=.T., CAPTION="Escala:"

  ADD OBJECT cmbScale AS COMBOBOX WITH STYLE=2,;
    LEFT=240, TOP=20, WIDTH=70, HEIGHT=21

  ADD OBJECT cmdClose AS COMMANDBUTTON WITH CANCEL=.T.,;
    LEFT=140, TOP=112, WIDTH=70, HEIGHT=27, CAPTION="Cerrar"

  PROCEDURE INIT
    THIS.DECLARE

  PROCEDURE ACTIVATE
    IF THIS.hForm = 0
      THIS.hForm = GetFocus()
      THIS.hDC = GetDC(THIS.hForm)
    ENDIF

  PROCEDURE DESTROY
    IF THIS.hDC <> 0
      = ReleaseDC(THIS.hForm, THIS.hDC)
    ENDIF

  PROCEDURE cmdClose.CLICK
    THISFORM.RELEASE

  PROCEDURE cmbScale.INIT
    WITH THIS
      .ADDITEM("Normal")
      .ADDITEM("x 2")
      .ADDITEM("x 3")
      .ADDITEM("x 4")
      .LISTINDEX=3
    ENDWITH

  PROCEDURE MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THIS.Magnify

  PROCEDURE chMagnify.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE chInvert.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE lbl1.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE cmbScale.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE cmdClose.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE Magnify
    #DEFINE SRCCOPY 0xCC0020
    #DEFINE NOTSRCCOPY 0x00330008
    #DEFINE cnDstWidth 600
    #DEFINE cnDstHeight 300

    IF THIS.chMagnify.VALUE
      LOCAL cBuffer, nX, nY, hDstWin, hDstDC,;
        nMode, nSrcWidth, nSrcHeight, nScale

      hDstWin = GetActiveWindow()
      hDstDC = GetWindowDC(hDstWin)

      cBuffer = REPLICATE(CHR(0), 8)
      = GetCursorPos(@cBuffer)
      = ScreenToClient(THIS.hForm, @cBuffer)

      nX = buf2dword(SUBSTR(cBuffer, 1,4))
      nY = buf2dword(SUBSTR(cBuffer, 5,4))

      nScale = THIS.cmbScale.LISTINDEX
      nSrcWidth = INT(cnDstWidth/nScale)
      nSrcHeight = INT(cnDstHeight/nScale)

      nMode = IIF(THIS.chInvert.VALUE,;
        NOTSRCCOPY, SRCCOPY)

      = StretchBlt(hDstDC, 10, 100,;
        cnDstWidth, cnDstHeight, THIS.hDC,;
        nX-nSrcWidth/2, nY-nSrcHeight/2,;
        nSrcWidth, nSrcHeight, nMode)

      = ReleaseDC(hDstWin, hDstDC)
    ENDIF

  PROCEDURE DECLARE
    DECLARE INTEGER GetActiveWindow IN user32
    DECLARE INTEGER GetCursorPos IN user32 STRING @lpPoint
    DECLARE INTEGER GetWindowDC IN user32 INTEGER HWND
    DECLARE INTEGER GetDC IN user32 INTEGER HWND
    DECLARE INTEGER GetFocus IN user32

    DECLARE INTEGER ReleaseDC IN user32;
      INTEGER hWindow, INTEGER hdc

    DECLARE INTEGER ScreenToClient IN user32;
      INTEGER hWindow, STRING @lpPoint

    DECLARE INTEGER StretchBlt IN gdi32;
      INTEGER hdcDest, INTEGER nXOriginDest,;
      INTEGER nYOriginDest, INTEGER nWidthDest,;
      INTEGER nHeightDest, INTEGER hdcSrc,;
      INTEGER nXOriginSrc, INTEGER nYOriginSrc,;
      INTEGER nWidthSrc, INTEGER nHeightSrc,;
      INTEGER dwRop

ENDDEFINE

FUNCTION buf2dword(lcBuffer)
  RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ;
    BITLSHIFT(ASC(SUBSTR(lcBuffer, 2,1)), 8) +;
    BITLSHIFT(ASC(SUBSTR(lcBuffer, 3,1)), 16) +;
    BITLSHIFT(ASC(SUBSTR(lcBuffer, 4,1)), 24)

Saludos.

Jesus Caro V