修正了一点小bug，你用下面的代码覆盖原先的：
程序代码：
#include "FoxPro.h"
#include "Const.h"
CLEAR ALL
PUBLIC gcDefaultPath, gcDataPath
gcDefaultPath = "E:\我的文檔\項目\測試\VFP\test - caolp"
gcDataPath = ADDBS(gcDefaultPath) + "数据"
SET DEFAULT TO "&gcDefaultPath"
SET PATH TO "&gcDataPath"
SET SAFETY OFF
Main()
CLEAR ALL
RETURN
*---------------------------
* 程序主入口
*---------------------------
PROCEDURE Main()
LOCAL loForm
loForm = CREATEOBJECT("C_MainForm")
WITH loForm
.Caption = "XXX小区住户平面图"
.WindowState = WINDOWSTATE_MAXIMIZED
.MinWidth = 800
.MinHeight = 600
.Show
ENDWITH
READ EVENTS
ENDPROC
*---------------------------
* 主窗体
*---------------------------
DEFINE CLASS C_MainForm AS myForm
DIMENSION aList1[1] && 小区名
DIMENSION aList2[1] && 楼栋清单
DIMENSION aList3[1] && 单元号
DIMENSION aList4[1] && 楼层号
DIMENSION aList5[1] && 户室号
cList = "" && 筛选字符串
PROCEDURE cList_Assign(tcValue)
ThisForm.cList = RTRIM(tcValue)
ENDPROC
ADD OBJECT Selector AS C_Selector WITH Top = 5, Left = 5
ADD OBJECT cnt_Map AS Container WITH BorderWidth = 0, BackStyle = 0
PROCEDURE Load
CLOSE DATABASES ALL
USE "居民信息" EXCLUSIVE IN 0 && 当确实需要重新创建索引文件时，须以独占方式打开数据表
*------------------------------
* 以下代码在需重新创建索引文件时用，否则可省
*!* LOCAL lcStr
*!* lcStr = ADDBS(gcDataPath) + "居民信息"
*!* WAIT "正在建立索引，请稍候……" WINDOW NOWAIT
*!* INDEX ON 小区名 + 楼栋号 + 单元号 + 楼层号 + 户室号 TAG Master OF "&lcStr"
*!* WAIT CLEAR
*-------------------------------
ENDPROC
PROCEDURE Unload
CLOSE DATABASES ALL
ENDPROC
PROCEDURE Resize
DODEFAULT()
ThisForm.Go
ENDPROC
PROCEDURE Arrange
WITH Top = ThisForm.Selector.Top + ThisForm.Selector.Height + 5
.Left = 5
.Height = ThisForm.Height - .Top - 5
.Width = ThisForm.Width - .Left - 5
ENDWITH
ENDPROC
PROCEDURE Init
LOCAL lnIndex
WITH ThisForm
.Get_List1
BINDEVENT(., "Click", This, "Change_List1")
BINDEVENT(., "Click", This, "Change_List2")
BINDEVENT(., "Click", This, "Change_List3")
BINDEVENT(., "Click", This, "Change_List4")
BINDEVENT(., "Click", This, "Change_List5")
BINDEVENT(.Selector.btn_Go, "Click", This, "Go")
ENDWITH
ENDPROC
* 获取小区清单
FUNCTION Get_List1()
LOCAL lcStr, lnIndex
SELECT "居民信息"
SET ORDER TO "Master"
GOTO TOP
lcStr = SPACE(LEN(小区名))
lnIndex = 1
DIMENSION ThisForm.aList1[lnIndex]
ThisForm.aList1[lnIndex] = lcStr
DO WHILE !EOF()
IF 小区名 != lcStr
lnIndex = lnIndex + 1
lcStr = 小区名
DIMENSION ThisForm.aList1[lnIndex]
ThisForm.aList1[lnIndex] = lcStr
ENDIF
SKIP
ENDDO
WITH .FOR lnIndex = 1 TO ALEN(ThisForm.aList1, 1)
.AddItem(ThisForm.aList1[lnIndex])
NEXT
.ListIndex = 1
ENDWITH
ENDFUNC
* 获取楼栋清单
FUNCTION Get_List2(tcNo1)
LOCAL lcStr, lnIndex
SELECT "居民信息"
SET ORDER TO "Master"
lcStr = SPACE(LEN(楼栋号))
lnIndex = 1
DIMENSION ThisForm.aList2[lnIndex]
ThisForm.aList2[lnIndex] = lcStr
IF !EMPTY(tcNo1) .AND. SEEK(tcNo1)
DO WHILE 小区名 == tcNo1
IF 楼栋号 != lcStr
lnIndex = lnIndex + 1
lcStr = 楼栋号
DIMENSION ThisForm.aList2[lnIndex]
ThisForm.aList2[lnIndex] = lcStr
ENDIF
SKIP
ENDDO
ENDIF
WITH .FOR lnIndex = 1 TO ALEN(ThisForm.aList2, 1)
.AddItem(ThisForm.aList2[lnIndex])
NEXT
.ListIndex = 1
ENDWITH
ENDFUNC
* 获取单元清单
FUNCTION Get_List3(tcNo1, tcNo2)
LOCAL lcStr, lnIndex
SELECT "居民信息"
SET ORDER TO "Master"
lcStr = SPACE(LEN(单元号))
lnIndex = 1
DIMENSION ThisForm.aList2[lnIndex]
ThisForm.aList3[lnIndex] = lcStr
IF !EMPTY(tcNo1) .AND. !EMPTY(tcNo2) .AND. SEEK(ThisForm.cList)
DO WHILE (小区名 == tcNo1) .AND. (楼栋号 == tcNo2)
IF 单元号 != lcStr
lnIndex = lnIndex + 1
lcStr = 单元号
DIMENSION ThisForm.aList3[lnIndex]
ThisForm.aList3[lnIndex] = lcStr
ENDIF
SKIP
ENDDO
ENDIF
WITH .FOR lnIndex = 1 TO ALEN(ThisForm.aList3, 1)
.AddItem(ThisForm.aList3[lnIndex])
NEXT
.ListIndex = 1
ENDWITH
ENDFUNC
* 获取楼层清单
FUNCTION Get_List4(tcNo1, tcNo2, tcNo3)
LOCAL lcStr, lnIndex
SELECT "居民信息"
SET ORDER TO "Master"
lcStr = SPACE(LEN(楼层号))
lnIndex = 1
DIMENSION ThisForm.aList4[lnIndex]
ThisForm.aList4[lnIndex] = lcStr
IF !EMPTY(tcNo1) .AND. !EMPTY(tcNo2) .AND. !EMPTY(tcNo3) .AND. SEEK(ThisForm.cList)
DO WHILE (小区名 == tcNo1) .AND. (楼栋号 == tcNo2) .AND. (单元号 == tcNo3)
IF 楼层号 != lcStr
lnIndex = lnIndex + 1
lcStr = 楼层号
DIMENSION ThisForm.aList4[lnIndex]
ThisForm.aList4[lnIndex] = lcStr
ENDIF
SKIP
ENDDO
ENDIF
WITH .FOR lnIndex = 1 TO ALEN(ThisForm.aList4, 1)
.AddItem(ThisForm.aList4[lnIndex])
NEXT
.ListIndex = 1
ENDWITH
ENDFUNC
* 获取户室清单
FUNCTION Get_List5(tcNo1, tcNo2, tcNo3, tcNo4)
LOCAL lcStr, lnIndex
SELECT "居民信息"
SET ORDER TO "Master"
lcStr = SPACE(LEN(户室号))
lnIndex = 1
DIMENSION ThisForm.aList5[lnIndex]
ThisForm.aList5[lnIndex] = lcStr
IF !EMPTY(tcNo1) .AND. !EMPTY(tcNo2) .AND. !EMPTY(tcNo3) .AND. !EMPTY(tcNo4) .AND. SEEK(ThisForm.cList)
DO WHILE (小区名 == tcNo1) .AND. (楼栋号 == tcNo2) .AND. (单元号 == tcNo3) .AND. (楼层号 == tcNo4)
IF 户室号 != lcStr
lnIndex = lnIndex + 1
lcStr = 户室号
DIMENSION ThisForm.aList5[lnIndex]
ThisForm.aList5[lnIndex] = lcStr
ENDIF
SKIP
ENDDO
ENDIF
WITH .FOR lnIndex = 1 TO ALEN(ThisForm.aList5, 1)
.AddItem(ThisForm.aList5[lnIndex])
NEXT
.ListIndex = 1
ENDWITH
ENDFUNC
* 改变小区
PROCEDURE Change_List1
WITH ThisForm
.cList = .(.)
.Get_List3(., .)
.Get_List4(., ., .)
.Get_List5(., ., ., .)
ENDWITH
ENDPROC
* 改变楼栋
PROCEDURE Change_List2
WITH ThisForm
.cList = . + .(., .)
.Get_List4(., ., .)
.Get_List5(., ., ., .)
ENDWITH
ENDPROC
* 改变单元
PROCEDURE Change_List3
WITH ThisForm
.cList = . + . + .(., ., .)
.Get_List5(., ., ., .)
ENDWITH
ENDPROC
* 改变楼层
PROCEDURE Change_List4
WITH ThisForm
.cList = . + . + . + .(., ., ., .)
ENDWITH
ENDPROC
* 改变户室
PROCEDURE Change_List5
WITH ThisForm
.cList = . + . + . + . + . ENDPROC
PROCEDURE cnt_Map.Clear
WITH This
DO WHILE .ControlCount > 0
.RemoveObject(.Controls(.ControlCount).Name)
ENDDO
ENDWITH
ENDPROC
* 确定
PROCEDURE Go
LOCAL lcStr, lcNumber, lcName, lnRow, lnCol
IF EMPTY(ThisForm.cList)
RETURN
ENDIF
SELECT "居民信息"
SET ORDER TO "Master"
IF SEEK(ThisForm.cList)
lcStr = 小区名 + 楼栋号 + 单元号 + 楼层号 + 户室号
DO WHILE (ThisForm.cList $ lcStr) .AND. !EOF()
IF (小区名 + 楼栋号 + 单元号 + 楼层号 + 户室号 == lcStr) .AND. (INLIST(ALLTRIM(户主关系), "户主", "租户"))
WITH = STRTRAN(楼栋号 + 单元号 + 楼层号 + 户室号, ' ', '0')
lcName = "House_" + lcNumber
IF VARTYPE(.&lcName) != "O"
lnRow = INT(VAL(楼层号))
lnCol = INT(VAL(户室号))
.AddObject(lcName, "C_Household")
WITH .&lcName
.Arrange
.Top = .Parent.Height - lnRow * (.Height + 5)
.Left = (lnCol - 1) * (.Width + 5)
._Number = lcNumber
._Name = ALLTRIM(姓名)
DO CASE
CASE ALLTRIM(户口类型) == "常住"
.BackColor = GREEN
CASE ALLTRIM(户口类型) == "暂住"
.BackColor = YELLOW
ENDCASE
.Visible = .T.
ENDWITH
ENDIF
ENDWITH
ENDIF
SKIP
IF (小区名 + 楼栋号 + 单元号 + 楼层号 + 户室号) != lcStr
lcStr = 小区名 + 楼栋号 + 单元号 + 楼层号 + 户室号
ENDIF
ENDDO
ENDIF
ENDPROC
ENDDEFINE
*---------------------------
* 选择器控件
*---------------------------
DEFINE CLASS C_Selector AS Container
BorderWidth = 0
BackStyle = 0
PROCEDURE Init
LOCAL laItems[5], lnIndex
laItems[1] = "小区: "
laItems[2] = "楼栋: "
laItems[3] = "单元: "
laItems[4] = "楼层: "
laItems[5] = "户室: "
WITH This
FOR lnIndex = 1 TO ALEN(laItems, 1)
.AddObject("cnt_Get" + TRANSFORM(lnIndex), "myGet")
WITH .Controls(lnIndex)
.AddObject("Label1", "Label")
WITH .Label1
.Caption = laItems[lnIndex]
.Width = 40
.Height = 25
.Alignment = 1
ENDWITH
.AddObject("Combo1", "ComboBox")
WITH .Combo1
.Style = 2
.Width = IIF(lnIndex > 1, 60, 150)
.Height = 25
ENDWITH
.Arrange
.Top = 0
.Left = IIF(lnIndex > 1, This.Controls(lnIndex - 1).Left + This.Controls(lnIndex - 1).Width + 5, 0)
ENDWITH
.Width = .Controls(lnIndex).Left + .Controls(lnIndex).Width
NEXT
.AddObject("btn_Go", "CommandButton")
WITH .btn_Go
.Caption = "确定"
.Width = 40
.Height = 25
.Top = 0
.Left = This.Controls(ALEN(laItems, 1)).Left + This.Controls(ALEN(laItems, 1)).Width + 20
ENDWITH
.Height = 25
.Width = .btn_Go.Left + .btn_Go.Width
.SetAll("Visible", .T.)
ENDWITH
ENDPROC
ENDDEFINE
*---------------------------
* 住户信息显示控件
*---------------------------
DEFINE CLASS C_Household AS Container
BorderWidth = 2
SpecialEffect = 0
_FontName = "微软雅黑"
PROCEDURE _FontName_Assign(tcValue)
IF VARTYPE(tcValue) != "C"
tcValue = "微软雅黑"
ENDIF
WITH This
._FontName = tcValue
.SetAll("FontName", ._FontName)
ENDWITH
ENDPROC
_FontSize = 9
PROCEDURE _FontSize_Assign(tnValue)
IF (VARTYPE(tnValue) != "N") .OR. (tnValue < 9)
tnValue = 9
ENDIF
WITH This
._FontSize = tnValue
.Arrange
ENDWITH
ENDPROC
_Width = 100
PROCEDURE _Width_Assign(tnValue)
IF (VARTYPE(tnValue) != "N") .OR. (tnValue < 100)
tnValue = 100
ENDIF
WITH This
._Width = tnValue
.Arrange
ENDWITH
ENDPROC
_Height = 16
PROCEDURE _Height_Assign(tnValue)
IF (VARTYPE(tnValue) != "N") .OR. (tnValue < 16)
tnValue = 16
ENDIF
WITH This
._Height = tnValue
.Arrange
ENDWITH
ENDPROC
* 房号
_Number = ""
PROCEDURE _Number_Assign(tcValue)
IF VARTYPE(tcValue) != "C"
tcValue = ""
ENDIF
WITH This
._Number = tcValue
.lbl_HouseNumber.Caption = ._Number
ENDWITH
ENDPROC
* 户主名
_Name = ""
PROCEDURE _Name_Assign(tcValue)
IF VARTYPE(tcValue) != "C"
tcValue = ""
ENDIF
WITH This
._Name = tcValue
.lbl_HouseName.Caption = ._Name
ENDWITH
ENDPROC
HIDDEN _Margin
_Margin = 4
ADD OBJECT PROTECTED lbl_Title1 AS Label WITH Caption = "房号: ", Alignment = 1, Width = 50, Height = This._Height
ADD OBJECT PROTECTED lbl_HouseNumber AS Label WITH Caption = This._Number, Alignment = 2, Width = This._Width, Height = This._Height
ADD OBJECT PROTECTED lbl_Title2 AS Label WITH Caption = "户主名: ", Alignment = 1, Width = 50, Height = This._Height
ADD OBJECT PROTECTED lbl_HouseName AS Label WITH Caption = This._Name, Alignment = 2, Width = This._Width, Height = This._Height
PROCEDURE Arrange
WITH This
.SetAll("FontSize", ._FontSize)
.SetAll("BackStyle", 0)
WITH .lbl_Title1
.Height = This._Height
.Top = This._Margin
.Left = This._Margin
ENDWITH
WITH This.lbl_HouseNumber
.Width = This._Width
.Height = This._Height
.Top = This.lbl_Title1.Top
.Left = This.lbl_Title1.Left + This.lbl_Title1.Width
ENDWITH
WITH This.lbl_Title2
.Height = This._Height
.Top = This.lbl_Title1.Top + This.lbl_Title1.Height + This._Margin
.Left = This._Margin
ENDWITH
WITH This.lbl_HouseName
.Width = This._Width
.Height = This._Height
.Top = This.lbl_Title2.Top
.Left = This.lbl_Title2.Left + This.lbl_Title1.Width
ENDWITH
.Width = .lbl_HouseNumber.Left + .lbl_HouseNumber.Width + ._Margin
.Height = .lbl_HouseName.Top + .lbl_HouseName.Height + ._Margin
ENDWITH
ENDPROC
PROCEDURE Resize
This.Arrange
ENDPROC
ENDDEFINE
*---------------------------
* 自定义窗体
*---------------------------
DEFINE CLASS myForm AS Form
PROCEDURE Arrange
* 虛方法
ENDPROC
PROCEDURE Activate
ThisForm.Arrange
ENDPROC
PROCEDURE Resize
ThisForm.Arrange
ENDPROC
PROCEDURE Destroy
CLEAR EVENTS
ENDPROC
ENDDEFINE
*----------------------
* 仿Get容器
*----------------------
DEFINE CLASS myGet AS Container
BorderWidth = 0
BackStyle = 0
PROCEDURE Arrange
LOCAL lnIndex
WITH This
.Height = 0
.Width = 0
FOR lnIndex = 1 TO .ControlCount
WITH .Controls(lnIndex)
.Top = 0
IF .Height > This.Height
This.Height = .Height
ENDIF
IF lnIndex > 1
.Left = This.Controls(lnIndex - 1).Left + This.Controls(lnIndex - 1).Width + 5
ELSE
.Left = 0
ENDIF
This.Width = .Left + .Width
ENDWITH
NEXT
ENDWITH
ENDPROC
PROCEDURE Resize
This.Arrange
ENDPROC
ENDDEFINE
[
本帖最后由 TonyDeng 于 2014-9-3 12:20 编辑 ]
2014-09-02 17:08
test - caolp.zip
(34.07 KB)
