前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >把表单放大看看,好玩的不只一点点

把表单放大看看,好玩的不只一点点

作者头像
加菲猫的VFP
发布2023-08-21 17:18:06
1240
发布2023-08-21 17:18:06
举报
文章被收录于专栏:加菲猫的VFP加菲猫的VFP
代码语言:javascript
复制
LOCAL oForm
oForm = CREATEOBJECT("Tform")
oForm.Show(1)
* end of main

DEFINE CLASS Tform As Form
  Width=350
  Height=160
  BorderStyle=2
  MaxButton=.F.
  MinButton=.F.
  Autocenter=.T.
  Caption="Magnifier"
  hForm=0
  hDC=0
  
  ADD OBJECT chMagnify As CheckBox WITH Value=.F.,;
  Left=20, Top=20, Autosize=.T., Caption="Activate Magnifier"

  ADD OBJECT chInvert As CheckBox WITH Value=.F.,;
  Left=20, Top=56, Autosize=.T., Caption="Invert colors"
  
  ADD OBJECT lbl1 As Label WITH;
  Left=190, Top=20, Autosize=.T., Caption="Scale:"
  
  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="Close"

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 140

  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)  
本文参与 腾讯云自媒体分享计划,分享自微信公众号。
原始发表:2023-06-09,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 加菲猫的VFP 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体分享计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档