程序1.prg

房租管理系统。有登记、到期提示、水电费管理等功能。

*获得拥有输入焦点的窗口的句柄属性
* GetFocus returns a HWND value*
*获得拥有输入焦点的窗口的句柄属性*-------------------------------
PUBLIC frm
DEFINE CLASS Tform AS FORM 
CAPTION = "获得拥有输入焦点的窗口的句柄属性测试表单" 
		WIDTH = 500 
		HEIGHT = 350 
		AUTOCENTER = .T. 
		width = 100 
		ROWHEIGHT = 20
frm = CREATEOBJECT ("Tform")
frm.VISIBLE = .T.

	DIMEN colnames [3]
	DIMEN rownames [7]
	FUNCTION  INIT
	THIS.colnames [1] = "VFP main"
	THIS.colnames [2] = "GetFocus"
	THIS.colnames [3] = "ThisForm"
	THIS.rownames [1] = "HWND:"
	THIS.rownames [2] = "left:"
	THIS.rownames [3] = "top:"
	THIS.rownames [4] = "right:"
	THIS.rownames [5] = "bottom:"
	THIS.rownames [6] = "width:"
	THIS.rownames [7] = "height:"
	THIS.addLabels
ENDFUNC
	PROCEDURE  ACTIVATE
	THIS._showAll
ENDPROC
	PROCEDURE  MOVED
	THIS._showAll
ENDPROC
	PROCEDURE  RESIZE
	THIS._showAll
ENDPROC
	PROCEDURE  UNLOAD
	CLEA DLLS
ENDPROC
	PROCEDURE  LOAD
	DECLARE INTEGER GetFocus IN user32
	DECLARE INTEGER GetActiveWindow IN user32
	DECLARE SHORT GetWindowRect IN user32 INTEGER HWND, STRING @ lpRect
ENDPROC
	PROCEDURE  addLabels
	LOCAL lnRow, lnCol, lcName, lbl
	FOR lnCol=1 TO 3
		lcName = "colname" + LTRIM(STR(lnCol))
		THIS.ADDOBJECT (lcName, "Theader")
		lbl = EVAL ("THIS." + lcName)
		lnLeft = 80 + THIS.colwidth*(lnCol-1)
		WITH lbl
			.TOP = 10
			.LEFT = lnLeft
			.CAPTION = THIS.colnames [lnCol]
			.VISIBLE = .T.
		ENDWITH
		FOR lnRow=1 TO 7
			lnTop = THIS.ROWHEIGHT*(lnRow+1)
			IF lnCol = 1
				lcName = "rowname" + LTRIM(STR(lnRow))
				THIS.ADDOBJECT (lcName, "Theader")
				lbl = EVAL ("THIS." + lcName)
				WITH lbl
					.TOP = lnTop
					.LEFT = 10
					.CAPTION = THIS.rownames [lnRow]
					.VISIBLE = .T.
				ENDWITH
			ENDIF
			lcName = THIS.getLabelName(lnCol, lnRow)
			THIS.ADDOBJECT (lcName, "Tinfo")
			lbl = EVAL ("THIS." + lcName)
			WITH lbl
				.TOP = lnTop
				.LEFT = lnLeft
				.CAPTION = lcName
				.VISIBLE = .T.
			ENDWITH
		ENDFOR
	ENDFOR
ENDPROC
	FUNCTION  getLabelName (lnCol, lnRow)
	RETURN  "lbl" + LTRIM(STR(lnCol)) + LTRIM(STR(lnRow))
ENDFUNC
	FUNCTION buf2int(oldpc)
	IF TYPE('oldpc')='N'
		lnBig = INT(oldpc/256)
		lnSmall = oldpc - lnBig * 256
		RETU ALLTRIM(CHR(lnSmall))+ALLTRIM(CHR(lnBig))+CHR(0)+CHR(0)
	ELSE
		lnresult = 0
		lnlast = LEN(oldpc)
		FOR lni = 1 TO lnlast
			lnresult = lnresult + ASC(SUBSTR(oldpc, lni, 1)) * (256 ^ (lni - 1))
		ENDF
		lnmsb = (lnlast * 8) - 1
		IF BITTEST(lnresult, lnmsb)
			lnmax = (2 ^ (lnmsb + 1))
			lnresult = lnresult - lnmax
		ENDIF
		RETU lnresult
	ENDI
ENDFUNC
	PROCEDURE  _showAll
	THIS._showHwnd (1, GetActiveWindow())
	THIS._showHwnd (2, GetFocus())
	THIS._showThis
ENDPROC
	PROCEDURE  _showThis
	lnCol = 3
	THIS._show (lnCol, 1, "-")
	THIS._show (lnCol, 2, THIS.LEFT)
	THIS._show (lnCol, 3, THIS.TOP)
	THIS._show (lnCol, 4, THIS.LEFT + THIS.WIDTH - 1)
	THIS._show (lnCol, 5, THIS.TOP + THIS.HEIGHT - 1)
	THIS._show (lnCol, 6, THIS.WIDTH)
	THIS._show (lnCol, 7, THIS.HEIGHT)
ENDPROC
	PROCEDURE  _showHwnd (lnCol, HWND)
	LOCAL lpRect
	lpRect = REPLI (CHR(0), 16)
	= GetWindowRect (HWND, @lpRect)
	WITH THIS
		lnWinLeft   = .buf2int(SUBSTR(lpRect,  1,4))
		lnWinTop    = .buf2int(SUBSTR(lpRect,  5,4))
		lnWinRight  = .buf2int(SUBSTR(lpRect,  9,4))
		lnWinBottom = .buf2int(SUBSTR(lpRect, 13,4))
		lnWinWidth  = lnWinRight - lnWinLeft + 1
		lnWinHeight = lnWinBottom - lnWinTop + 1
		._show (lnCol, 1, HWND)
		._show (lnCol, 2, lnWinLeft)
		._show (lnCol, 3, lnWinTop)
		._show (lnCol, 4, lnWinRight)
		._show (lnCol, 5, lnWinBottom)
		._show (lnCol, 6, lnWinWidth)
		._show (lnCol, 7, lnWinHeight)
	ENDWITH
ENDPROC
	PROCEDURE  _show (lnCol, lnRow, lvValue)
	LOCAL obj
	obj = EVAL ("THIS." + THIS.getLabelName (lnCol, lnRow))
	DO CASE
	CASE TYPE ("lvValue") = "C"
		obj.CAPTION = lvValue
	CASE TYPE ("lvValue") = "N"
		obj.CAPTION = LTRIM(STR(lvValue))
	ENDCASE
ENDPROC
ENDDEFINE

DEFINE CLASS Theader AS Tlabel
	FONTNAME = "arial"
	FONTBOLD = .T.
ENDDEFINE

DEFINE CLASS Tinfo AS Tlabel
	FONTNAME = "Courier"
ENDDEFINE

DEFINE CLASS Tlabel AS LABEL
	AUTOSIZE = .T.
	BACKSTYLE = 1
	FONTSIZE = 10
ENDDEFINE