售楼管理系统

售楼管理系统 【摘要】 房地产业的不断发展～利用电脑的先进管理手段～把售楼人员从一大堆中解放出来～将楼盘的销售推向‚无纸化‛已经成了解决当前房地产售楼管理的当务之急。售楼管理系统就是为了实现这一目标而设计的～管理人员通过该系统可以及时了解楼盘的动态销售情况～还能充分利用电脑的可检索性、方便、快速地了解有关销售楼盘的其他各种详细资料～以便及时做出正确决策。 本系统主要实现以下功能:房产管理～管理所有的房产信息、对房产数据进行添加、修改、删除等操作。此外～方便的查询功能可以使客户迅速地找到自己所需的房产信息,客户管理～拥有完善的客户管理功能～才能更加迅速地了解客户的需求动态。收费管理～对于各种复杂的物业收费～完善的收费管理功能将使得收费管理更加便捷准确。售楼管理～系统的核心～实现对楼盘销售的数据、合同签订情况、客户付费等情况的管理。 本系统以中文版Visual Basic 6.0为前台开发工具～用中文版Access 2000作为后台数据库。Visual Basic 6.0～它是由美国微软公司推出的小型数据库开发语言～由于其使用方便～硬件要求不高～易学等特点～它还提供强有力的应用程序开发工具～为将来的维护提供必要的基础。系统的操作对人员的素质的要求不高～只需对他们稍加培训便能胜任。 [关键字] 房地产|楼盘销售| Visual Basic 6.0|数据库 目 录 摘要……………………………………………….…………………………………2 1、引言………………………………………….……………………………….….4 1项目背景………………………………………………………………………4 2项目目标………………………………………………………………………4 2、第一章设计基础………………………………………….……………………..5 1.1管理信息系统的认识……………………………………………………….5 1.2管理信息系统的特点……………………………………………………….5 1.3管理信息系统的开发……………………………………………………….6 3、第二章系统功能分析与设计………….………………………………………..6 2.1系统需求分析…….…………………………………………………………8 2.2系统功能分析……………………………………………….………………8 4、 第三章数据库设计……………………………………………………………..12 5、 第四章创建售楼管理系统工程………………………………………………..17 4.1创建登录窗体………………………………………………………………18 4.2建立主窗体…………………………………………………………………22 4.3实现房产管理功能..………………………………………………………..24 4.4实现客户管理功能…………………………………………………………49 4.5实现收费管理功能…………………………………………………………59 4.6实现系统维护功能…………………………………………………………67 6、第五章小结………………………………………………………………….….69 致谢……………………………………………………………………………..69 7、参考文献………………………………………………………..………………70 售楼管理系统 引 言 [背景]企业的竞争逐渐整合为管理的竞争～随着房地产业的不断发展～利用电脑的先进管理手段～把售楼人员从一大堆合同中解放出来～将楼盘的销售推向‚无纸化‛已经成了解决当前房地产售楼管理的当务之急。使用计算机对楼盘进行管理～具有检索迅速、查找方便、可靠性高、存储量大、保密性好、成本低等特点～能够极大地提高楼盘资源管理的效率～也是企业科学化、正规化管理的重要条件。 [目标]大丰市教育房产售楼管理系统～要为企业提供全面的楼盘管理解决～提供一个以人为中心～管理人员与楼盘之间互动的资源管理平台。具体目标如下: , 提高企业管理的效率～节约相关的管理成本～将楼盘的销售 推向‚无纸化‛～增强楼盘管理的安全性。 , 为企业建立规范化、人性化、实时互动化管理机制。 , 满足企业战略层、管理层、业务操作层和企业全体员工的不 同层次和不同方面的需要。 , 为企业将来的整体信息化提供必要的支持。 第一章 设计基础 1.1管理信息系统的认识 管理信息系统就是我们常说的MIS(Management Information System)，在强调管理，强调信息的现代社会中它变得越来越普及。MIS是一门新的学科，它跨越了若干个领域，比如管理科学、系统科学，运筹学、统计学以及计算机科学。在这些学科的基础上，形成信息收集和加工的方法，从而形成一个纵横交织的系统。 1.2 管理信息系统的特点 1.2.1 管理信息系统的组成 管理信息系统在企业中的应用存在三个要素，这就是人、计算机和数据。 人是指企业领导者、管理人员、技术人员，以及MIS建设的领导机构和实施机构，他们在系统中起主导作用。MIS是一项系统工程，不是只靠一些计算机开发人员就可以完成的，必须有企业管理人员，尤其是企业领导的积极参与。 计算机技术是MIS得以实施的主要技术。在这些技术中，软件开发是MIS开发的重点。 第三个因素也不能忽视。企业的管理数据是MIS正常运行的基础。广义地说，各项#管理制度#是MIS建设成功的基础。试想要计算一台机床的成本，需要按时输入每个部件、每个零件以及每个螺钉螺帽的费用，涉及企业的生产车间、采购、库房、工艺设计和财务等多个部门，必须有一整套管理制度做保证。 1.2.2 管理信息系统的界面特点 在计算机软件技术中，人机界面已经发展成为一个重要的分支。 MIS人机界面设计一般遵循以下一些基本原则: 1(以通信功能作为界面设计的核心 人机界面设计的关键是使人与计算机之间能够准确地交流信息。一方面，人向计算机输入信息时应当尽量采取自然的方式;另一方面，计算机向人传递的信息必须准确，不致引起误解或混乱。另外，不要把内部的处理、加工与人机界面混在一起(人机界面程序只是通信)，以免互相干扰，影响速度。 设计MIS时，针对每一个功能，都要按照“I-P-O”的模块化思想，使输入、处理与输出“泾渭分明”，充分体现人机界面的通信功能。这样设计出来的程序不易出错，而且易于维护。 报表打印是MIS必备的功能之一，而且打印之前常常需要计算。计算与打印分开设计，虽然消耗时间，但易于整个MIS系统的维护。 2(界面必须始终一致 统一的人机界面不致于会增加用户的负担，让用户始终用同一种方式思考与操作。最忌讳的是每换一个屏幕用户就要换一套操作命令与操作方法。 例如在整个系统可以以问号图标表示帮助，以磁盘图标表示存盘，以打印机图标表示打印等。 3(界面必须使用户随时掌握任务的进展情况 人机界面应该能够告诉用户软件运行的进度。特别是在需要较长时间的等待时，必须让用户了解工作进展情况，如可以设计已经完成了百分之几的任务进度条等。目前，Windows下的应用软件无论大小，其安装程序几乎均做到了这一点。开发MIS软件时，这一点很值得借鉴。 4(界面必须能够提供帮助 一个优秀的MIS软件应该提供在线求助功能，甚至提供使用向导，这将给用户带来极大的方便。在多媒体环境下，以语音提示作为操作向导，不会干扰屏幕信息，是一个极佳的选择。 5(界面友好、使用方便 多数MIS软件的数据输入量较大。对于一些相对固定的数据，不应让用户频频输入(特别是汉字)，而应让用户用鼠标轻松选择。例如，人事管理系统中的“文化程度”是相对固定的数据，其值一般取“小学”、“初中”、“高中”、“大专”、“大本”、“硕研”、“博研”等。录入这类数据之前，MIS软件应在相应位置弹出一个列表框，待用户以鼠标点击，而不应让用户每次都输入这些汉字。 另外，开发者应编写一个错误实时记录程序，自动记录何日、何时、何程序出了何种错误。 总之，所开发的MIS在使用过程中，应使用户的数据输入量降至最低限度，同时也要减少用户的干预量。实践证明，用户干预愈少，MIS系统的满意程度愈高。 6(输入画面尽可能接近实际 如果某个电算会计软件的凭证录入画面是表格式的，一屏可录入多条记录，而且与实际凭证一模一样，甚至连颜色都无异，用户在终端上录入凭证，仿佛用笔在纸上填写凭证，以增加人机亲和力。 7(具有较强的容错功能 误操作、按键连击等均有可能导致数据误录。巧妙地进行程序设计，可以避免此类因素造成的错误。例如，录入学生成绩时，我们可以对其范围进行限定，使用户无法输入0,100以外的数据;录入学生年龄时，不妨根据实际情况将范围限制在15,20之间。 1.3 管理信息系统的开发 1.3.1 管理信息系统的开发方式 管理信息系统的开发方式主要有独立开发方式、委托开发方式、合作开发方式、购买现成软件方式等4种。这4种开发方式各有优点和不足，需要根据使用单位的技术力量、资金情况、外部环境等各种因素进行综合考虑和选择。不论哪种开放方式都需要有单位的领导和业务人员参加，并在管理信息系统的整个开发过程中培养、锻炼、壮大该系统的维护队伍。 1.3.2 系统开发的一般方法 管理信息系统的开发是一个复杂的系统工程，它涉及到计算机处理技术、系统理论、组织结构、管理功能、管理知识等各方面的问题，至今没有一种统一完备的开发方法。但是，每一种开发方法都要遵循相应的开发策略。任何一种开发 策略都要明确以下问题: , 系统要解决的问题:如采取何种方式解决组织管理和信息处理方面的问题，对企业提出的新的管理需求该如何满足等。 , 系统可行性研究:确定系统所要实现的目标。通过对企业状况的初步调研得出现状分析的结果，然后提出可行性方案并进行论证。系统可行性的研究包括目标和方案可行性、技术的可行性、经济方面的可行性和社会影响方面的考虑。 , 系统开发的原则:在系统开发过程中，要遵循领导参与、优化创新、实用高效、处理规范化的原则。 , 系统开发前的准备工作:作好开发人员的组织准备和企业基础准备工作。 , 系统开发方法的选择和开发的制定:针对己经确定的开发策略选定相应的开发方法，是结构化系统分析和设计方法，还是选择原型法或面向对象的方法。开发计划的制定是要明确系统开发的、投资计划、工程进度计划和资源利用计划。 管理信息系统开发方法主要有:结构化生命周期开发方法、原型法、面向对象的开发方 1.3.3 管理信息系统的开发过程 管理信息系统的开发过程一般包括系统开发准备、系统调查、系统分析、系统设计、系统实现、系统转换、系统运行与维护、系统等步骤。根据开发系统的大小、复杂、投入、方式、方法等因素的不同，各步骤的要求和内容也不同，用户需要根据实际情况进行取舍和计划。 第二章 系统功能分析与设计 2.1系统需求分析 售楼管理职能主要分为房产管理～客户管理～收费管理～售楼管理。其中售楼管理是系统的核心～在系统开发时应考虑对以下职能的需求: , 房产管理～能够管理所有的房产信息、对房产数据进行添加、 修改、删除等操作。此外～方便的查询功能可以使客户迅速地找到自己所需的房产信息。 , 客户管理～拥有完善的客户管理功能～才能更加迅速地了解客户的需求动态。客户管理功能要能够实现对客户各种数据的管理～包括客户和购买动向等。 , 收费管理～对于各种复杂的物业收费～完善的收费管理功能将使得收费管理更加便捷准确。 , 售楼管理～系统的核心～要能够实现对楼盘销售的数据、合同签订情况、客户付费等情况的管理。 2.2系统功能分析 通过对用户需求的具体调研和分析～确定本系统应具备的功能包括房产管理、客户管理、收费管理、售楼管理、系统维护和退出系统。 具体主要实现如下功能: , 房产管理部分 房产管理部分包括户型登记、楼盘登记、户型查询和楼盘查询～其功能是实现对楼盘各部分数据内容的添加、修改、 删除和查询等操作。 ,1, 户型登记管理:包括户型信息的添加、修改和删除3部分功能。其中～户型信息包括户型编号、建筑面积、套内面积、房型、户型简介以及图片文件。 ,2, 楼盘登记管理:包括楼盘信息的添加、修改和删除3部分功能。其中～楼盘信息包括楼盘编号、户型编号以及单价等。其中楼盘编号的信息包括了楼号、单元、楼层和房号几部分。 ,3, 户型查询:户型查询部分包括户型编号、建筑面积、户型结构等查询方式。 ,4, 楼盘查询:楼盘查询部分包括楼盘编号、楼号、楼层、单位报价和户型等查询方式。 , 客户管理部分 客户管理部分包括客户资料登记管理和客户资料查询管理～其功能是实现对各客户部分数据内容的添加、修改、删除、查询等操作。 ,1,客户资料登记管理:包括客户资料的添加、修改、删除3部分功能。其中～客户资料包括姓名、身份证号、出生日期、性别、电子邮件、通信住址、电话号码、手机、邮编、车牌号等。 ,2,客户资料查询管理:客户资料查询部分包括按照身份证号查询、按照车牌号查询、按照客户姓名查询和按照手机号查询等。 , 收费管理部分 收费管理部分包括收费登记和收费查询管理～其功能是实现对各部分数据内容的添加、删除、查询等操作。 ,1,收费登记管理:包括收费资料的添加、删除、打印3部分 功能。其中～收费信息包括收费编号、楼盘编号、交费时间、有线电视费、电话调试费、煤气初装费、公用设施费、其他费用、押金、收款人、交款人等。 ,2,收费查询管理:收费资料查询部分包括按照收费单号查询、按照楼盘号查询号、按照交款人查询和按照交费时间范围等。 , 售楼管理部分 售楼管理部分包括售楼人员登记、售楼合同管理、收款管理、售楼人员查询、售楼合同查询、收费情况查询等～其功能是实现对各部分数据内容的添加、修改、删除、查询等操作。 ,1,售楼人员登记管理:包括售楼人员资料的添加、修改、删除3部分功能。其中～售楼人员资料包括姓名、身份证号、出生日期、性别、电子邮件、通信住址、电话号码、手机、邮编、人员编号等。 ,2,售楼合同管理:包括售楼合同资料的添加、修改、删除3部分功能。其中～售楼合同资料包括合同编号、合同状态、认购日期、合同签订日期、购买楼盘编号、购买人身份证号、销售人员编号、合同单价、折扣率、现金折扣、车位编号、车位价款、地下室编号、地下室价款、付款方式、贷款银行以及计划的分期付款等。 ,3,收款管理:包括收款资料的添加、打印、删除3部分功能。其中收款资料包括楼盘编号、交款日期、收款单号、收款金额、付款方式、交款人等。 ,4,售楼人员查询:售楼人员查询部分包括按照售楼人员编号查询和按照售楼人员姓名查询。 ,5,售楼合同查询:售楼合同查询部分包括按照合同编号查询、 按照楼盘编号查询、按照客户身份证号查询和按照签订时间表范围 查询等。 ,6,收款情况查询:收款情况查询部分包括按照收费单号查询、 按照楼盘编号查询、按照交款人查询和按照交费时间范围查询等。 , 系统维护部分 系统维护部分包括数据备份和数据恢复～ 实现将现有数据库进行备份和恢复功能。 , 退出系统部分 退出系统部分就是当用户发出关闭窗口的 行为后～询问用户是否确定要退出本系统～如果确定～则关闭本系统。 2.3系统功能模块设计 通过对用户需求的具体调研和分析～确定本系统应具备的功能包 括房产管理、客户管理、收款管理、售楼管理、系统维护和退出系统。 系统具体的模块组织结构如图1所示。 售楼管理系统 房产管理 客户管理 收款管理 售楼管理 系统维护 退出系统 户楼户楼客客收收 售售收售售收数数 型盘型盘户户费费楼楼款楼楼款据据 登登查查资资登查人合管人合情库库 记 记 询 询 记 询 理 料料员同员同况备恢 份 复 登查查管查查查 记 询 询 理 询 询 询 图1 系统功能模块图 第三章 数据库设计 数据库在一个管理系统中占有非常重要的地位～数据库结构设计的好坏将直接对应用系统的效率以及实现的效果产生影响。合理的数据库结构设计可以提高数据存储的效率～保证数据的完整和一致。设计数据库系统时应该首先充分了解用户各个方面的需求～包括现有的以及将来可能增加的需求。 对于数据库应用程序来说～数据库的设计与创建是进行程序设计的基石～对于Visual Foxpro来说～其数据库的创建一般要包括数据库的设计和数据库的创建两个步骤。 3.1设计数据库 根据功能分析～系统数据库应满足户型资料、楼盘资料、客户资料、合同资料、收费资料、收款登记、售楼人员、收款登记和系统管理9个功能的需求。所以～需要利用Access建立一个House数据库～主要包括如下8个表。 , ‚户型资料‛表:用于存放户型资料, , ‚楼盘资料‛表:用于存放楼盘资料, , ‚合同资料‛表:用于存放合同资料, , ‚客户资料‛表:用于存放客户资料, , ‚收费信息‛表:用于存放收费信息, , ‚收款登记‛表:用于存放收款登记信息, , ‚售楼人员‛表:用于存放售楼人员信息, , ‚预计付款‛表:用于存放预计付款信息。 1、‚户型资料‛表 表1 户型资料表 字段名 数据类型 说明 Hst_ID 文本 户型编号字段 Hst_buildarea 数字 建筑面积 Hst_usearea 数字 套内面积 Hst_type 文本 房型 Hst_memo 文本 简介 Hst_picture 文本 保存图片 2、‚楼盘资料‛表 表2 楼盘资料表 字段名 数据类型 说明 Hos_id 文本 楼盘编号 Hos_hstid 文本 户型 Hos_price 货币 报价 3、‚合同资料‛表 表3 合同资料表 字段名 数据类型 说明 Pct_ID 数字 合同编号 Pct_houseID 文本 楼盘编号 Pct_buyerid 文本 购买人身份证号 Pct_salesID 文本 销售人员编号 Pct_housequote 货币 楼盘单价 Pct_discountrate 数字 折扣率 Pct_discountcash 货币 折扣金额 Pct_carplaceid 文本 车位号 Pct_carplace 货币 车位价格 Pct_basementid 文本 地下室编号 Pct_basement 货币 付款方式 Pct_paykind 文本 货款银行 Pct_bookdate 时间/日期 认购日期 Pct_pactdate 时间/日期 签订日期 Pct_State 数字 标记是否交款 4、‚客户资料‛表 表4 客户资料表 字段名 数据类型 说明 Hon_ID 文本 身份证号 Hon_name 文本 姓名 Hon_sex 文本 性别 Hon_tel 文本 电话 Hon_tel 文本 手机 Hon_job 文本 职业 Hon_birthday 日期/时间 出生日期 Hon_email 文本 电子邮件 Hon_carcode 文本 车牌号 Hon_zipcode 文本 邮编 Hon_addr 文本 地址 Hon_memo 文本 备注 5、‚收费信息‛表 表5 收费信息表 字段名 数据类型 说明 fee_ID 数字 收费编号 Fee_houseID 文本 楼盘编号 Fee_date 日期/时间 收费时间 Fee_tv 货币 有线电视费 Fee_tel 货币 电话调试费 Fee_gas 货币 煤气初装费 Fee_member 货币 公用设施费 Fee_other 货币 其他费用 Fee_deposit 货币 押金 Fee_skr 文本 收款人 Fee_jkr 文本 交款人 6、‚收款信息‛表 表6 收款登记表 字段名 数据类型 说明 Icm_ID 数字 收款单号 Icm_houseID 文本 楼盘编号 Icm_date 日期/时间 收款日期 Icm_money 货币 收款金额 Icm_paykind 文本 付款方式 Icm_skr 文本 收款人 Icm_jkr 文本 交款人 7、‚售楼人员‛表 表7 售楼人员表 字段名 数据类型 说明 Sal_ID 文本 人员编号 Sal_sfz 文本 身份证号 Sal_name 文本 姓名 Sal_sex 文本 性别 Sal_birthday 日期/时间 出生日期 Sal_handset 文本 电话 Sal_handset 文本 手机 Sal_email 文本 电子邮件 Sal_zipcode 文本 邮编 Sal_addr 文本 地址 8、‚预计付款‛表 表8 预计付款表 字段名 数据类型 说明 Add_pactid 数字 预计付款序号 Add_date 日期/时间 预计付款日期 Add_money 货币 付款钱数 Shifoufukuan 文本 是否已付款标记 第四章 创建售楼管理系统工程 经过上述的分析和设计～就可以开始系统的创建了。 在Visual Basic中～开发系统的第一步就是需要创建一个管理系统资源的工程～系统中所有的窗口、菜单、工具栏等资源都是在此工程中添加和设计完成的。 在Visual Basic的菜单栏中依次单击‚文件‛ ‚新建工程‛菜单项～在弹出的‚新建工程‛对话框中选择‚标准EXE图标‛～然后单击‚确定‛按钮～即可创建一个新的工程～默认名称为‚工程1‛。 在菜单栏中依次单击‚工程‛ ‚工程1属性‛菜单项～出现如图2所示的‚工程1 工程属性‛对话框。 图2 ‚工程1—工程属性‛对话框 在‚工程名称‛文本框中输入‚售楼管理系统‛～然后单击‚确定‛按钮。这样～就新创建了一个名称为‚售楼管理系统‛的工程。 4.1创建登录窗体,frmLogin, 在正式进入系统之前～需要对用户的身份进行确认～这是通过用户登录来实现的。所以系统中的第一个窗体也就应该是登录窗体。 4.1.1界面设计 在Visual Basic中创建工程的时候～系统会自动建立一个新的窗体Form1。将这个窗体的名称更改为frmLogin～就用它作为系统登录窗体。 在窗体上放臵两个Label控件、1个ComboBox控件、1个TextBox控件和2个CommandButton控件。设臵frmLogin窗体及其中控件属性～如表9所示。 表9 frmLogin窗体及其中控件属性列表 控件名称 属性 属性值 说明 frmLogin BackColor &H00C0FFFF& 设臵窗体背景颜色 BorderStyle Fixed Single 设臵窗体边框样式 Caption ‚登录‛ 设臵窗体标题 frmLogin Icon System.ico 设臵窗体图标 StartUpPosition 屏幕中心 设臵窗体初始位臵 Caption ‚用户名:‛ 设臵标题 Label1 BackColor &H00C0FFFF& 设臵背景颜色 ForeColor &H00C000C0& 设臵字体颜色 Caption ‚密码‛ 设臵标题 Label2 BackColor &H00C0FFFF& 设臵背景颜色 ForeColor &H00C000C0& 设臵字体颜色 设臵组合框文本为空 cmbName Text ‚‛ 设臵文本框文本为空 TxtPwd Text ‚‛ CmdOk Caption ‚确定‛ 设臵命令按钮标题 cmdCancel Captionn ‚取消‛ 设臵命令按钮标题 调整控件的大小和位臵～设计状态效果如图3所示。 图3 frmLogin窗体设计效果 4.1.2 添加代码 ,1, 定义模块代码 Option Explicit Public conn As New ADODB.Connection Public Const keyenter=13 Public username as string ,2, frmLogin窗体加载事件代码 Private Sub Form_Load() '定义连接字符串 connectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _ "data source= " & App.Path & "\House.mdb" conn.Open connectionstring '打开数据库 sql = "select * from 系统管理表 " '检索系统管理表 rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic '打开记录集 If rs_login.EOF = False Then '有记录时逐一添加到cmbName组合框 Do While rs_login.EOF = False cmbName.AddItem (rs_login.Fields(0)) rs_login.MoveNext Loop cmbName.ListIndex = 0 '默认显示第一个子项 End If rs_login.Close cnt = 0 '初始化输入次数 End Sub ,3, ‚确定‛按钮代码 Private Sub cmdok_Click() If Trim(cmbName.Text) = "" Then '判断输入的用户名是否为空 MsgBox "没有这个用户", vbOKOnly + vbExclamation cmbName.SetFocus Else '判断用户名和密码是否正确 sql = "select * from 系统管理表 where czyh='" & cmbName.Text & "'" rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_login.EOF = True Then MsgBox "没有这个用户", vbOKOnly + vbExclamation, "" cmbName.SetFocus Else '检验密码是否正确 If Trim(rs_login.Fields(1)) = Trim(txtPwd.Text) Then userID = cmbName.Text username = rs_login.Fields(2) '记录登录用户的类型～以便权限设臵 Unload Me frmMain.Show rs_login.Close Exit Sub Else MsgBox "密码不正确", vbOKOnly + vbExclamation, "" txtPwd.SetFocus End If End If End If cnt = cnt + 1 '输入次数加1 If cnt = 3 Then MsgBox "您输入密码错误次数太多:", vbExclamation, "" Unload Me End If rs_login.Close End Sub ,4, ‚取消‛按钮代码 Private Sub cmdcancel_Click() conn.Close '关闭数据库连接 Set conn = Nothing Unload Me End Sub 4.2建立主窗体,frmMain, 4.2.1创建主窗体 在Visual Basic6.0的工程资源管理器中单击鼠标右键～弹出的快捷菜单中依次选择‚添加‛ ‚添加窗体‛菜单项～弹出‚添加窗体‛对话框～单击‚打开‛按钮～即可在售楼管理系统工程中添加一个窗体Form1～此窗体的各个属性设臵如表10所示。 表10 系统主窗体属性 属性 属性值 说明 frmMain 名称 设臵窗体名称 Caption “售楼管理系统” 设臵窗体标题 Icon System.ico 设臵窗体图标 Pictrue Desktop.bmp 设臵窗体背景图案 StartUpPosition 2-CenterScreen 设臵窗体默认位臵 Windowstate 2-Maximized 设臵窗体默认状态 主窗体的设臵效果如图4所示。 图4 主窗体设计效果图 4.2.2添加代码 主窗体中的代码不多～基本上都是实现单击某个菜单选项即弹出相应窗体的语句～这些语句将分别在各个窗体中介绍。单击‚系统管理‛ ‚退出系统‛菜单～关闭系统的代码如下: private Sub exitsys_click( ) conn.Close „关闭数据库连接 set conn=Nothing End End sub 由于主窗体中用到了工具栏。因此需要对工具栏内的按钮响应进行设臵。 双击Toolbar控件～在该控件的ButtonClick事件中设定各个按钮响应后的操作。这里使用‚Select……Case”语句来分辨当前单击的是哪个按钮。 Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key '按关键字选择 Case "bt_loupan" '如果单击按钮关键字为bt_loupan则 显示楼盘查询窗体 frmBuildingFind.Show 1 Case "bt_kehu" frmKehuFind.Show 1 Case "bt_shoufei" frmShoufeiFind.Show 1 Case "bt_shoulou" frmHetongLogin.Show 1 Case "bt_shoukuan" frmShoukuanLogin.Show 1 Case "bt_tuichu" Unload Me End Select End Sub 另外～为了维护系统的安全～当用户以guest身份登录时～部分 功能是不可用的。在窗体的加载事件中输入如下代码: Private Sub Form_Load() If username = "guest" Then buildingsalebargain.Enabled = False '销售合同管理不可用 databaserecovery.Enabled = False '数据库恢复不可用 End If End Sub 4.3实现房产管理功能 打开‚房产管理‛菜单～下有‚户型登记‛、‚楼盘登记‛、‚户型 查询‛和‚楼盘查询‛4个子菜单。 4.3.1建立户型登记窗体,frmHuxingLogin, 主要用来对户型资料进行登记～包括添加、修改、删除等各种操 作。 1、界面设计 在工程中添加一个窗体～设臵窗体的属性～如表11所示。 表11 frmHuxingLogin窗体属性 属性 属性值 说明 FrmHuxingLogin 名称 设臵窗体名称 Caption “户型登记” 设臵窗体标题 StartUpPosition 2-CenterScreen 设臵窗体默认位臵 WindowState 2-Maximized 设臵窗体默认状态 该窗体主要分为两个部分。上半部分用一表格控件显示当前所有的户型资料～这里用到MSHFlexgrid控件。此控件不是标准控件～需要用户自行添加。按照前述方法打开工程的‚部件‛对话框～勾选‚Microsoft Hierachical Flexgrid Control6.0‛项即可将其加入到工具箱中。 该窗体下半部分用来显示当前选定的户型资料～或者用来接收输入的新户型资料。首先添加一个Frame控件～然后在该控件上添加9个Label控件、5个Text控件、4个CommandButton控件、1个ComboBox控件和1个Image控件。添加完控件的窗体效果如图5所示。 图5 ‚户型登记‛窗体效果图 2、工作流程 窗体加载时使用ADO进行数据库的连接～同时在表格中显示出数据。 单击‚增加‛按钮时～所有的文本框为可用状态～并且设臵为空～‚增加‛按钮变为‚保存‛按钮。在输入完信息后～单击‚保存‛按钮～判断户型编号是否重复～对于不重复的户型保存入库。 单击‚删除‛按钮时～询问是否确定删除该记录～得到确认后根据户型编号进行删除。 单击‚修改‛按钮时～所有的文本框进入可编辑状态～‚修改‛按钮变为‚保存‛按钮。修改后～单击‚保存‛按钮～进行数据的更新。 3、添加代码 ,1,在主窗体的菜单中添加代码～以便用户单击菜单时～弹出这个窗体。单击‚户型登记‛菜单～添加如下代码: Private sub housestylogin_click( ) frmhuxinglogin.show End sub ,2,加载窗体时～需要在打开户型资料表之后～调用dispalygrid过程显示记录信息～然后将常用户型名称添加到Combo1组合框的子项中。在窗体加载事件中输入如下代码: Option Explicit Dim rs_huxing As New ADODB.Recordset Dim gridclick As Boolean Dim getrow As Long Private Sub Form_Load() Dim sql As String On Error GoTo loaderror sql = "select * from 户型资料表" '检索户型资料表 rs_huxing.CursorLocation = adUseClient rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic displaygrid '调用displaygrid过程～显示信息 Combo1.AddItem "二室二厅" '将户型资料加入Combo1控件子项中 Combo1.AddItem "一室二厅" Combo1.AddItem "一室二厅" Combo1.AddItem "复 式" Combo1.AddItem "三室二厅" gridclick = False '标识未选择记录 cmdModify.Enabled = False '此时修改和删除不可用 cmdDel.Enabled = False Exit Sub loaderror: MsgBox Err.Description End Sub ,3,窗体加载时需要显示所有记录信息。考虑到代码的可重用性～定义displaygrid过程。单击‚工具‛菜单～选择‚添加过程‛子菜单～添加displaygrid过程。 显示表格信息前应该对表格格式进行设臵～如设臵表格的行数和 列数等～添加一个setgrid过程。 Public Sub setgrid() ' 设臵表格格式 Dim i As Integer On Error GoTo seterror With grdHuxing .ScrollBars = flexScrollBarBoth .FixedCols = 1 .Rows = rs_huxing.RecordCount + 1 .Cols = 6 .SelectionMode = flexSelectionByRow For i = 0 To .Rows - 1 '设臵行高 .RowHeight(i) = 315 Next For i = 0 To .Cols - 1 '设臵列宽 .ColWidth(i) = 1300 Next i End With Exit Sub seterror: MsgBox Err.Description End Sub 其中～使用Rows和Cols属性设臵总行数和列数。FixedCols属 性的作用是冻结某列～也就是说～如果表格的列数过多从而使表格带 有水平滚动条时～被设臵为冻结的列不会随着滚动条的滚动而变化。 表格表头的格式是单独设臵的～以便区别于其他行。添加过程 setgridhead用来设臵表头。 Public Sub setgridhead() '设臵表头格式 On Error GoTo setheaderror grdHuxing.Row = 0 '在第一行中逐列设臵显示文本～作为表头 grdHuxing.Col = 0 grdHuxing.Text = "户型编号" grdHuxing.Col = 1 grdHuxing.Text = "建筑面积" grdHuxing.Col = 2 grdHuxing.Text = "套内面积" grdHuxing.Col = 3 grdHuxing.Text = "户型" grdHuxing.Col = 4 grdHuxing.Text = " 图片文件" grdHuxing.Col = 5 grdHuxing.Text = "户型简介" Exit Sub setheaderror: MsgBox Err.Description End Sub 在dispalygrid过程中调用这两个过程即可设臵好表格的格式～然 后逐行逐列地显示数据。 Public Sub displaygrid() '显示表格信息 Dim i As Integer On Error GoTo displayerror setgrid '调用setgrid过程设臵表格格式 setgridhead '调用setgridhead过程设臵表头格式 grdHuxing.Row = 0 If Not rs_huxing.EOF Then rs_huxing.MoveFirst Do While Not rs_huxing.EOF grdHuxing.Row = grdHuxing.Row + 1 ' 从第二行开始逐列取得字段值并显示出来 grdHuxing.Col = 0 If Not IsNull(rs_huxing.Fields(0)) Then grdHuxing.Text = rs_huxing.Fields(0) _ Else grdHuxing.Text = "" grdHuxing.Col = 1 If Not IsNull(rs_huxing.Fields(1)) Then grdHuxing.Text = rs_huxing.Fields(1) _ Else grdHuxing.Text = "" grdHuxing.Col = 2 If Not IsNull(rs_huxing.Fields(2)) Then grdHuxing.Text = rs_huxing.Fields(2) _ Else grdHuxing.Text = "" grdHuxing.Col = If Not IsNull(rs_huxing.Fields(3)) Then grdHuxing.Text = rs_huxing.Fields(3) _ Else grdHuxing.Text = "" grdHuxing.Col = 4 If Not IsNull(rs_huxing.Fields(5)) Then grdHuxing.Text = rs_huxing.Fields(5) _ Else grdHuxing.Text = "" grdHuxing.Col = If Not IsNull(rs_huxing.Fields(4)) Then grdHuxing.Text = rs_huxing.Fields(4) _ Else: grdHuxing.Text = "" rs_huxing.MoveNext Loop End If displayerror: If Err.Number <> 0 Then MsgBox Err.Description End Sub ,4,当单击表格控件的某条户型记录时～即在下面的明细栏内显示该条记录的详细信息。此时还可以对此记录进行修改和删除操作。在grdHuxing_Click事件中添加代码实现这一功能。 Private Sub grdHuxing_Click() On Error GoTo griderror gridclick = True cmdModify.Enabled = True cmdDel.Enabled = True getrow = grdHuxing.Row '记录当前行 If grdHuxing.Rows = 1 Then '只有表头一行 MsgBox "无相关纪录", vbOKOnly + vbExclamation, "" Else displaymingxi '调用displaymingxi过程将记录的详细信息显示出来 End If griderror: If Err.Number <> 0 Then MsgBox Err.Description End Sub ,5,diaplaymingxi过程依次将数据内容添加到各个文本框中。需要特别说明的是～每个记录中的‚图片文件‛字段存储了对应户型的示意图文件名。这些示意图存放在系统路径下的ICON文件夹内～如果存在需要使用Image控件显示该户型的示意图。 Public Sub displaymingxi() txtHuxingnum.Text = grdHuxing.TextMatrix(getrow, 0) '取的当前行 的第一列 txtJianzhumianji.Text = grdHuxing.TextMatrix(getrow, 1) txtTaomianji.Text = grdHuxing.TextMatrix(getrow, 2) txtFangxing.Text = grdHuxing.TextMatrix(getrow, 3) txtJianjie.Text = grdHuxing.TextMatrix(getrow, 5) Dim pic As String If grdHuxing.TextMatrix(getrow, 4) <> "" Then '第五列不为空～说明 有图片文件 pic = grdHuxing.TextMatrix(getrow, 4) '取得图片名称 Image1.Picture = LoadPicture(App.Path & "\ICON\" & pic & ".bmp") '加载 图片 Else Image1.Picture = LoadPicture() '加载文件为空～即将图像清空 End If End Sub 下面编辑各个按钮的功能。 ,6,双击cmdAdd控件～在cmdAdd_Click事件中处理对该按钮 的响应。 这个按钮有两个状态～分别是‚增加‛和‚保存‛。首先应该判 断当前按钮的状态。 如果当前的按钮状态为‚增加‛～则窗体各部分接受新的数据输 入。此时清空所有的文本框的内容～同时将‚修改‛和‚删除‛按钮 设臵为不可用。 Private Sub cmdadd_Click() On Error GoTo adderror If cmdAdd.Caption = "保 存" Then '下面对输入的有效性进行验证 If Trim(txtHuxingnum.Text) = "" Then MsgBox "户型编号不能为空:", vbOKOnly + vbExclamation, "" txtHuxingnum.SetFocus Exit Sub End If If Trim(txtFangxing.Text) = "" Then MsgBox "请选择房型:", vbOKOnly + vbExclamation, " " Combo1.SetFocus Exit Sub End If If Trim(txtJianzhumianji.Text) = "" Then MsgBox "建筑面积不能为空:", vbOKOnly + vbExclamation, " " txtJianzhumianji.SetFocus Exit Sub End If If Trim(txtTaomianji.Text) = "" Then MsgBox "套内面积不能为空:", vbOKOnly + vbExclamation, " " txtTaomianji.SetFocus Exit Sub End If If Not IsNumeric(txtJianzhumianji.Text) Then '面积必须是数值 MsgBox "建筑面积请输入数字:", vbOKOnly + vbExclamation, "" txtJianzhumianji.SetFocus Exit Sub End If If Not IsNumeric(txtTaomianji.Text) Then MsgBox "套内面积请输入数字:", vbOKOnly + vbExclamation, "" txtTaomianji.SetFocus Exit Sub End If 如果当前按钮的状态为‚保存‛状态～则需要将新添加的数据写 进数据库。 首先应当判断各项内容是否已经正确输入～如果没有正确输入则 给出提示～并退出过程。 On Error GoTo adderror If cmdAdd.Caption = "保 存" Then '下面对输入的有效性进行验证 If Trim(txtHuxingnum.Text) = "" Then MsgBox "户型编号不能为空:", vbOKOnly + vbExclamation, "" txtHuxingnum.SetFocus Exit Sub End If If Trim(txtFangxing.Text) = "" Then MsgBox "请选择房型:", vbOKOnly + vbExclamation, " " Combo1.SetFocus Exit Sub End If If Trim(txtJianzhumianji.Text) = "" Then MsgBox "建筑面积不能为空:", vbOKOnly + vbExclamation, " " txtJianzhumianji.SetFocus Exit Sub End If If Trim(txtTaomianji.Text) = "" Then MsgBox "套内面积不能为空:", vbOKOnly + vbExclamation, " " txtTaomianji.SetFocus Exit Sub End If If Not IsNumeric(txtJianzhumianji.Text) Then '面积必须是数值 MsgBox "建筑面积请输入数字:", vbOKOnly + vbExclamation, "" txtJianzhumianji.SetFocus Exit Sub End If If Not IsNumeric(txtTaomianji.Text) Then MsgBox "套内面积请输入数字:", vbOKOnly + vbExclamation, "" txtTaomianji.SetFocus Exit Sub End If 如果所有的数据都输入无误～则检查是否有重复的户型编号～如果有重复则 给出提示～并退出过程。 rs_huxing.MoveFirst '输入合法～开始插入 Dim i As Integer For i = 0 To rs_huxing.RecordCount - 1 '逐条检查户型编号是否已经存在 IfTrim(rs_huxing.Fields(0)) = Trim(txtHuxingnum.Text) Then MsgBox "户型编号重复:", vbOKOnly + vbExclamation, " " txtHuxingnum.SetFocus Exit Sub End If rs_huxing.MoveNext Next i 如果没有重复～则将新的数据添加到数据库中。注意～数据库中 的字段格式应该和即将添加的数据格式一致。添加完毕后使用Update方法更新数据库。 rs_huxing.MoveLast '户型编号不存在～在最后插入新纪录 rs_huxing.AddNew rs_huxing.Fields(0) = Trim(txtHuxingnum.Text) '逐字段插入 rs_huxing.Fields(1) = CSng(txtJianzhumianji.Text) '数值转换为字符串 rs_huxing.Fields(2) = CSng(txtTaomianji.Text) rs_huxing.Fields(3) = Trim(txtFangxing.Text) rs_huxing.Fields(4) = Trim(txtJianjie.Text) rs_huxing.Fields(5) = Trim(txtHuxingnum.Text) rs_huxing.Update '将插入的记 录保存 MsgBox "添加成功:", vbOKOnly + vbExclamation, "" 同时需要更新表格控件的内容～将新的数据添加到表格中。 With grdHuxing '将表格最后一行数据更新 .Rows = rs_huxing.RecordCount + 1 .Row = grdHuxing.Rows - 1 .Col = 0 .Text = Trim(txtHuxingnum.Text) .Col = 1 .Text = Trim(txtJianzhumianji.Text) .Col = 2 .Text = Trim(txtTaomianji.Text) .Col = 3 .Text = Trim(txtFangxing.Text) .Col = 4 .Text = Trim(txtFangxing.Text) .Col = 5 .Text = Trim(txtJianjie.Text) End With cmdAdd.Caption = "增 加" '成功保存后标题变为‚增 加‛ Else '按钮标题为"增 加"时 txtHuxingnum.Text = "" '各个字段为空 txtJianzhumianji.Text = "" txtTaomianji.Text = "" txtJianjie.Text = "" cmdModify.Enabled = False '新增记录时～不能修改和删除记录 cmdDel.Enabled = False cmdAdd.Caption = "保 存" '按钮标题变为‚保 存‛ End If Exit Sub adderror: MsgBox Err.Description End Sub 4.3.2建立楼盘登记窗体,frmBuildingLogin, 这个窗体主要用来对楼盘资料进行登记～包括添加、修改、删除 等各种操作。 1、界面设计 与设计户型登记窗体相似～在工程中添加一个窗体～命名为frmBuildingLogin。设臵好控件及属性的frmBuildingLogin窗体如图6所示。 图6 ‚楼盘登记‛窗体效果图 2、工程流程 窗体加载使用ADO进行数据库的连接～同时在表格中显示出数据。 单击‚增加‛按钮时～所有的文本框为可用状态～并且设臵为空～‚增加‛按钮变为‚保存‛按钮。在输入完新信息后～单击‚保存‛按钮～判断楼盘编号是否重复～对于不重复的楼盘进行入库保存。 单击‚删除‛按钮时～首先询问是否确定要删除该信息～在得到确认后取得用户选定的楼盘信息～根据户型编号进行删除。 单击‚修改‛按钮时～所有的文本框进入可编辑状态～修改按钮 变为保存按钮。修改后～单击‚保存‛按钮～进行数据的更新。 3、添加代码 ,1,‚增加‛按钮的‚Click‛事件代码 Private Sub cmdadd_Click() On Error GoTo adderror If cmdadd.Caption = "保存" Then cmdadd.Caption = "增加" If Trim(txtnum.Text) = "" Then MsgBox "楼盘编号不能为空:", vbOKOnly + vbExclamation, " " txtnum.SetFocus Exit Sub End If If Trim(txthuxingnum.Text) = "" Then MsgBox "请选择户型编号:", vbOKOnly + vbExclamation, " " Exit Sub End If If Trim(txtprice.Text) = "" Then MsgBox "价格不能为空:", vbOKOnly + vbExclamation, " " txtprice.SetFocus Exit Sub End If If Not IsNumeric(txtprice.Text) Then MsgBox "价格请输入数字:", vbOKOnly + vbExclamation, "" txtprice.SetFocus Exit Sub End If rs_loupan.MoveFirst Dim i As Integer For i = 0 To rs_loupan.RecordCount - 1 If Trim(rs_loupan.Fields(0)) = Trim(txtnum.Text) Then MsgBox "楼盘编号重复:", vbOKOnly + vbExclamation, " " txtnum.SetFocus Exit Sub End If rs_loupan.MoveNext Next i rs_loupan.MoveLast rs_loupan.AddNew rs_loupan.Fields(0) = Trim(txtnum.Text) rs_loupan.Fields(1) = Trim(txthuxingnum.Text) rs_loupan.Fields(2) = CCur(Trim(txtprice.Text)) rs_loupan.Update MsgBox "添加成功:", vbOKOnly + vbExclamation, "" cmdadd.Caption = "增加" With grdLoupan .Rows = rs_loupan.RecordCount + 1 .Row = grdLoupan.Rows - 1 .Col = 0 .Text = Trim(txtnum.Text) .Col = 1 .Text = Trim(txthuxingnum.Text) .Col = 2 .Text = Trim(txtlouhao.Text) .Col = 3 .Text = Trim(txtdanyuan.Text) .Col = 4 .Text = Trim(txtlouceng.Text) .Col = 5 .Text = Trim(txtfanghao.Text) .Col = 6 .Text = Trim(txtprice.Text) End With Else cmdadd.Caption = "保存" txtnum.Text = "" txtprice.Text = "" cmdmodify.Enabled = False cmddel.Enabled = False End If Exit Sub adderror: MsgBox Err.Description ,2,‚修改‛按钮的‚Click‛事件代码 Private Sub cmdmodify_Click() On Error GoTo modifyerror txtnum.Enabled = False If Trim(txtprice.Text) = "" Then MsgBox "价格不能为空:", vbOKOnly + vbExclamation, " " txtprice.SetFocus Exit Sub End If If Not IsNumeric(txtprice.Text) Then MsgBox "价格请输入数字:", vbOKOnly + vbExclamation, "" txtprice.SetFocus Exit Sub End If rs_loupan.MoveFirst Dim i As Integer For i = 0 To rs_loupan.RecordCount - 1 If Trim(rs_loupan.Fields(0)) = Trim(txtnum.Text) Then rs_loupan.Fields(0) = Trim(txtnum.Text) rs_loupan.Fields(1) = Trim(txthuxingnum.Text) rs_loupan.Fields(2) = CCur(Trim(txtprice.Text)) rs_loupan.Update MsgBox "修改成功:", vbOKOnly + vbExclamation, "" With grdLoupan .Row = getrow .Col = 1 .Text = Trim(txthuxingnum.Text) .Col = 6 .Text = Trim(txtprice.Text) End With Exit Sub End If rs_loupan.MoveNext Next i modifyerror: MsgBox Err.Description End Sub ,3,‚删除‛按钮的‚Click‛事件代码 Private Sub cmddel_Click() Dim answer As String Dim delete_row As String On Error GoTo delerror answer = MsgBox("确定要删除吗,", vbYesNo, "") If answer = vbYes Then rs_loupan.MoveFirst Dim i As Integer For i = 0 To rs_loupan.RecordCount - 1 If Trim(rs_loupan.Fields(0)) = Trim(txtnum.Text) Then rs_loupan.Delete rs_loupan.Update MsgBox "删除成功:", vbOKOnly + vbExclamation, "" With grdLoupan .RemoveItem getrow End With Exit Sub End If rs_loupan.MoveNext Next i Else Exit Sub End If Exit Sub delerror: MsgBox Err.Description End Sub ,4,‚退出‛按钮的‚Click‛事件代码 Private Sub cmdexit_Click() Unload Me End Sub 4.3.3建立户型查询窗体,frmBuildingstyleFind, 主要用来对户型资料进行查询。在查询条件中选择某一种查询方式～然后输入查询的关键字～即可按照要求找出符合条件的数据～并在下面的列表中显示结果。 1、界面设计 添加一个窗体～在窗体上放臵1个Frame控件、2个Label控件、3个CommandButton控件、1个ComboBox控件和3个OptionButton 控件。设臵完成以后的窗体如图7所示。 图7 ‚户型查询‛窗体效果图 2、 工作流程 窗体加载时在表格中显示所有的数据。在查询条件部分选择某一种查询方式～然后输入查询的关键字～再单击‘查询’按钮～开始执行查询～将查询的结果在表格中显示出来。 3、添加代码 绑定菜单、加载窗体、显示表格、卸载窗体等部分的代码和户型登记部分的都相似～下面主要介绍查询功能的实现。 ,1,双击‚查询‛按钮～添加代码以实现查询的功能。 首先通过单选按钮控件Value值判断所选择的查询条件～然后对不同的查询条件使用不同的SQL语句。根据户型编号查询的代码如下: Private Sub cmdfind_Click() On Error GoTo finderror Dim sql As String grdHuxing.Clear '显示查询结果前将表格中原有记录清除 If Option1.Value = True Then '选择户型编号作为查询条件 sql = "select * from 户型资料表 where Hst_ID = '" & Trim(txthuxingnum.Text) & "'" rs_huxing.CursorLocation = adUseClient rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_huxing.Close Exit Sub End If If Option2.Value = True Then '选择建筑面积作为查询条件 sql = "select * from 户型资料表 where Hst_buildarea between " & CInt(Trim(txtmianji1.Text)) & " and " & CInt(Trim(txtmianji2.Text)) rs_huxing.CursorLocation = adUseClient rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_huxing.Close Exit Sub End If If Option3.Value = True Then '选择户型结构作为查询条件 sql = "select * from 户型资料表 where Hst_type = '" & Trim(Combo1.Text) & "'" rs_huxing.CursorLocation = adUseClient rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_huxing.Close Exit Sub End If Exit Sub finderror: MsgBox Err.Description End Sub ,2,当用户单击‚全部‛按钮时～表格显示所有的户型信息～这和 窗体加载时的情况是一样的～所以直接调用Form_Load事件就可以了。 Private Sub cmdall_Click() Dim sql As String sql = "select * from 户型资料表" rs_huxing.CursorLocation = adUseClient rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic Combo1.AddItem "二室二厅" Combo1.AddItem "一室二厅" Combo1.AddItem "一室二厅" 式" Combo1.AddItem "复 Combo1.AddItem "三室二厅" setgrid setgridhead displaygrid rs_huxing.Close End Sub 4.3.4建立楼盘查询窗体,frmBuildingFind, 本窗体主要用来对楼盘资料进行查询。在查询条件中选择某一种查询方式～然后输入查询的关键字～即可按照要求找出符合条件的数据～并在下面的列表中显示结果。 1、界面设计 在工程中添加一个窗体～将其命名为frmBuildingFind。在这个窗体中添加1个Frame控件、1个Label控件、5个Text控件、3个CommandButton控件、1个ComboBox控件个5个Option控件。 设臵完成的frmBuildingFind窗口如图8所示。 图8 ‚楼盘查询‛窗体效果图 2、工作流程 窗体加载时在表格控件中显示所有的数据。在查询条件部分选择某一种查询方式～然后输入查询的关键字～再单击‚查询‛按钮～开始执行查询～查询的结果将在表格中显示出来。 3、添加代码 Option Explicit Dim rs_huxing As New ADODB.Recordset '户型 Dim rs_loupan As New ADODB.Recordset '楼盘 (1)‚查询‛按钮的‚Click‛事件代码: Private Sub cmdfind_Click() Dim sql As String On Error GoTo loaderror grdLoupan.Clear If Optionnum.Value = True Then sql = "select 楼盘资料表.hos_id,楼盘资料表.hos_hstid,楼盘资料表.hos_price, " & _ "户型资料表.Hst_ID,户型资料表.Hst_buildarea,户型资料表.Hst_usearea,户 型资料表.Hst_type, " & _ "户型资料表.Hst_memo,户型资料表.Hst_picture from 楼盘资料表,户型资料表 where 楼盘资料表.hos_hstid = 户型资料表.Hst_ID " & _ " and 楼盘资料表.hos_id = '" & txtnum.Text & "'" rs_loupan.CursorLocation = adUseClient rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库 setgrid setgridhead displaygrid rs_loupan.Close Exit Sub End If '按照楼号查询 If Optionlouhao.Value = True Then sql = "select 楼盘资料表.hos_id,楼盘资料表.hos_hstid,楼盘资料表.hos_price, " & _ "户型资料表.Hst_ID,户型资料表.Hst_buildarea,户型资料表.Hst_usearea, 户型资料表.Hst_type, " & _ "户型资料表.Hst_memo,户型资料表.Hst_picture from 楼盘资料表,户型资料表 where 楼盘资料表.hos_hstid = 户型资料表.Hst_ID " & _ " and 楼盘资料表.hos_id like '" & Trim(txtlouhao.Text) & "%'" rs_loupan.CursorLocation = adUseClient rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库 setgrid setgridhead displaygrid rs_loupan.Close Exit Sub End If '按照楼层查询 If Optionlouceng.Value = True Then sql = "select 楼盘资料表.hos_id,楼盘资料表.hos_hstid,楼盘资料表.hos_price, " & _ "户型资料表.Hst_ID,户型资料表.Hst_buildarea,户型资料表.Hst_usearea,户型资料表.Hst_type, " & _ "户型资料表.Hst_memo,户型资料表.Hst_picture from 楼盘资料表,户型资料表 where 楼盘资料表.hos_hstid = 户型资料表.Hst_ID " & _ " and 楼盘资料表.hos_id like '____" & Trim(txtlouceng.Text) & "__'" rs_loupan.CursorLocation = adUseClient rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库 Dim a As Integer a = rs_loupan.RecordCount setgrid setgridhead displaygrid rs_loupan.Close Exit Sub End If '按照单位报价查询 If Optionpri.Value = True Then sql = "select 楼盘资料表.hos_id,楼盘资料表.hos_hstid,楼盘资料表.hos_price, " & _ "户型资料表.Hst_ID,户型资料表.Hst_buildarea,户型资料表.Hst_usearea,户型资料表.Hst_type, " & _ "户型资料表.Hst_memo,户型资料表.Hst_picture from 楼盘资料表,户型资料表 where 楼盘资料表.hos_hstid = 户型资料表.Hst_ID " & _ " and 楼盘资料表.hos_price between " & CCur(Trim(txtpri1.Text)) & " and " & CCur(Trim(txtpri2.Text)) rs_loupan.CursorLocation = adUseClient rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库 setgrid setgridhead displaygrid rs_loupan.Close Exit Sub End If '按照户型查询 If Optionhuxing.Value = True Then sql = "select 楼盘资料表.hos_id,楼盘资料表.hos_hstid,楼盘资料表.hos_price, " & _ "户型资料表.Hst_ID,户型资料表.Hst_buildarea,户型资料表.Hst_usearea,户型资料表.Hst_type, " & _ "户型资料表.Hst_memo,户型资料表.Hst_picture from 楼盘资料表,户型资料表 where 楼盘资料表.hos_hstid = 户型资料表.Hst_ID " & _ " and 户型资料表.Hst_type = '" & Combo1.Text & "'" rs_loupan.CursorLocation = adUseClient rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库 setgrid setgridhead displaygrid rs_loupan.Close Exit Sub End If Exit Sub loaderror: MsgBox Err.Description End Sub ,2,‚退出‛按钮的‚Click‛事件代码‚ Private Sub cmdexit_Click() Unload Me End Sub ,3,‚打印‛按钮的‚Click‛事件代码: Private Sub cmdprint_Click() Printgrid1.Unit = Centimeter '设臵页边距单位为厘米 Printgrid1.PrintObject = grdLoupan '设臵打印对象为 Printgrid1.DoPreView '打印预览 End Sub Private Sub Form_Load() Dim sql As String On Error GoTo loaderror .hos_hstid,楼盘资料表.hos_price,sql = "select 楼盘资料表.hos_id,楼盘资料表 户型资料表.Hst_ID,户型资料表.Hst_buildarea," & _ "户型资料表.Hst_usearea,户型资料表.Hst_type,户型资料 表.Hst_memo,户型资料表.Hst_picture from 楼盘资料表,户型资料表 " & _ "where 楼盘资料表.hos_hstid = 户型资料表.Hst_ID" rs_loupan.CursorLocation = adUseClient rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据 库 Combo1.AddItem "二室二厅" Combo1.AddItem "一室二厅" Combo1.AddItem "一室二厅" Combo1.AddItem "复 式" Combo1.AddItem "三室二厅" setgrid setgridhead displaygrid rs_loupan.Close Exit Sub loaderror: MsgBox Err.Description End Sub Public Sub displaygrid() Dim i As Integer On Error GoTo displayerror grdLoupan.Row = 0 If Not rs_loupan.EOF Then rs_loupan.MoveFirst Do While Not rs_loupan.EOF grdLoupan.Row = grdLoupan.Row + 1 grdLoupan.Col = 0 If Not IsNull(rs_loupan.Fields(0)) Then grdLoupan.Text = rs_loupan.Fields(0) _ Else grdLoupan.Text = "" grdLoupan.Col = 1 If Not IsNull(rs_loupan.Fields(4)) Then grdLoupan.Text = rs_loupan.Fields(4) _ Else grdLoupan.Text = "" grdLoupan.Col = 2 If Not IsNull(rs_loupan.Fields(5)) Then grdLoupan.Text = rs_loupan.Fields(5) _ Else grdLoupan.Text = "" grdLoupan.Col = 3 grdLoupan.Text = CStr(rs_loupan.Fields(4) - rs_loupan.Fields(5)) grdLoupan.Col = 4 If Not IsNull(rs_loupan.Fields(6)) Then grdLoupan.Text = rs_loupan.Fields(6) _ Else grdLoupan.Text = "" grdLoupan.Col = 5 If Not IsNull(rs_loupan.Fields(2)) Then grdLoupan.Text = rs_loupan.Fields(2) _ Else grdLoupan.Text = "" grdLoupan.Col = 6 grdLoupan.Text = CStr(rs_loupan.Fields(2) * rs_loupan.Fields(4)) rs_loupan.MoveNext Loop End If displayerror: If Err.Number <> 0 Then MsgBox Err.Description End If End Sub Public Sub setgrid() Dim i As Integer On Error GoTo seterror With grdLoupan .ScrollBars = flexScrollBarBoth .FixedCols = 1 .Rows = rs_loupan.RecordCount + 1 .Cols = 7 .SelectionMode = flexSelectionByRow For i = 0 To .Rows - 1 .RowHeight(i) = 315 Next For i = 0 To .Cols - 1 .ColWidth(i) = 1300 Next i End With Exit Sub seterror: MsgBox Err.Description End Sub Public Sub setgridhead() On Error GoTo setheaderror grdLoupan.Row = 0 grdLoupan.Col = 0 grdLoupan.Text = "楼盘编号" grdLoupan.Col = 1 grdLoupan.Text = "建筑面积" grdLoupan.Col = 2 grdLoupan.Text = "套内面积" grdLoupan.Col = 3 grdLoupan.Text = "分摊面积" grdLoupan.Col = 4 grdLoupan.Text = "户型" grdLoupan.Col = 5 grdLoupan.Text = "单位报价" grdLoupan.Col = 6 grdLoupan.Text = "楼盘报价" Exit Sub setheaderror: MsgBox Err.Description End Sub 4.4实现客户管理功能 4.4.1建立客户资料登记窗体,frmKehuLogin, 本窗体主要用来对客户资料进行登记～包括添加、修改、删除等操作。 1、界面设计 在工程中添加一个窗体～将其命名为frmKehuLogin。在此窗体上放臵1个Frame控件、12个Label控件、10个Text控件、4个CommandButton控件和2个ComboBox控件。 设臵好控件及属性的frmKehuLogin窗体如图9所示。 图9 ‚客户资料登记‛窗体设计图 2、工作流程 窗体加载时使用ADO进行数据库的连接～同时在表格中显示出数据。 单击‚增加‛按钮时～所有的文本框为可用状态～并且设臵为空～ ‚增加‛按钮变为‚保存‛按钮。在输入完新信息后～单击‚保存‛ 按钮～判断客户编号是否重复～对于不重复的客户保存入库。 单击‚删除‛按钮时～首先询问工作人员是否确定要删除该信息～ 在得到确认后取得用户选定的客户信息～根据户型编号进行删除。 单击‚修改‛按钮时～所有的文本框为可编辑状态～‚修改‛按 钮变为‚保存‛按钮。修改后～单击‚保存‛按钮～进行数据库的更 新。 3、添加代码 ,1,‚增加‛按钮的‚Click‛事件代码 Private Sub cmdadd_Click() On Error GoTo adderror If cmdadd.Caption = "保存" Then cmdadd.Caption = "增加" If Trim(txtID.Text) = "" Then MsgBox "身份证号不能为空:", vbOKOnly + vbExclamation txtID.SetFocus Exit Sub End If If Trim(txtname.Text) = "" Then MsgBox "姓名不能为空:", vbOKOnly + vbExclamation txtname.SetFocus Exit Sub End If If Trim(Combo1.Text) = "" Then MsgBox "请选择性别:", vbOKOnly + vbExclamation Combo1.SetFocus Exit Sub End If rs_kehu.MoveFirst Dim i As Integer For i = 0 To rs_kehu.RecordCount - 1 If rs_kehu.Fields(0) = txtID.Text Then MsgBox "身份证号重复:", vbOKOnly + vbExclamation txtID.SetFocus Exit Sub End If rs_kehu.MoveNext Next i rs_kehu.MoveLast rs_kehu.AddNew rs_kehu.Fields(0) = txtID.Text rs_kehu.Fields(1) = txtname.Text rs_kehu.Fields(2) = Combo1.Text If Trim(txttel.Text) = "" Then '电话信息 rs_kehu.Fields(3) = Null Else rs_kehu.Fields(3) = txttel.Text End If If Trim(txtcell.Text) = "" Then '手机信息 rs_kehu.Fields(4) = Null Else rs_kehu.Fields(4) = txtcell.Text End If If Trim(txtduty.Text) = "" Then '职业信息 rs_kehu.Fields(5) = Null Else rs_kehu.Fields(5) = txtduty.Text End If rs_kehu.Fields(6) = DTPicker1.Value '出生日期信息 If Trim(txtemail.Text) = "" Then rs_kehu.Fields(7) = Null Else rs_kehu.Fields(7) = txtemail.Text End If If Trim(txtcard.Text) = "" Then '车牌号信息 rs_kehu.Fields(8) = Null Else rs_kehu.Fields(8) = txtcard.Text End If If Trim(txtyoubian.Text) = "" Then '邮编信息 rs_kehu.Fields(9) = Null Else rs_kehu.Fields(9) = txtyoubian.Text End If If Trim(txtadd.Text) = "" Then '通讯地址信息 rs_kehu.Fields(10) = Null Else rs_kehu.Fields(10) = txtadd.Text End If If Trim(txtbeizhu.Text) = "" Then '备注信息 rs_kehu.Fields(11) = Null Else rs_kehu.Fields(11) = txtbeizhu.Text End If rs_kehu.Update MsgBox "添加成功:", vbOKOnly + vbExclamation With grdKehu .Rows = rs_kehu.RecordCount + 1 .Row = grdKehu.Rows - 1 .Col = 0 .Text = txtID.Text .Col = 1 .Text = txtname.Text .Col = 2 .Text = Combo1.Text .Col = 3 .Text = txttel.Text .Col = 4 .Text = txtcell.Text .Col = 5 .Text = txtduty.Text .Col = 6 .Text = DTPicker1.Value .Col = 7 .Text = txtemail.Text .Col = 8 .Text = txtcard.Text .Col = 9 .Text = txtyoubian.Text .Col = 10 .Text = txtadd.Text .Col = 11 .Text = txtbeizhu.Text End With Else cmdadd.Caption = "保存" txtID.Text = "" txtname.Text = "" txttel.Text = "" txtcell.Text = "" txtyoubian.Text = "" txtemail.Text = "" txtcard.Text = "" txtadd.Text = "" txtduty.Text = "" txtbeizhu.Text = "" cmdmodify.Enabled = False cmddel.Enabled = False End If Exit Sub adderror: MsgBox Err.Description End Sub ,2,‚修改‛按钮的‚Click‛事件代码 Private Sub cmdmodify_Click() On Error GoTo modifyerror txtID.Enabled = False If Trim(txtname.Text) = "" Then MsgBox "姓名不能为空:", vbOKOnly + vbExclamation txtname.SetFocus Exit Sub End If rs_kehu.MoveFirst Dim i As Integer For i = 0 To rs_kehu.RecordCount - 1 If rs_kehu.Fields(0) = txtID.Text Then rs_kehu.Fields(1) = txtname.Text rs_kehu.Fields(2) = Combo1.Text If Trim(txttel.Text) = "" Then rs_kehu.Fields(3) = Null Else rs_kehu.Fields(3) = txttel.Text End If If Trim(txtcell.Text) = "" Then rs_kehu.Fields(4) = Null Else rs_kehu.Fields(4) = txtcell.Text End If If Trim(txtduty.Text) = "" Then rs_kehu.Fields(5) = Null Else rs_kehu.Fields(5) = txtduty.Text End If rs_kehu.Fields(6) = DTPicker1.Value If Trim(txtemail.Text) = "" Then rs_kehu.Fields(7) = Null Else rs_kehu.Fields(7) = txtemail.Text End If If Trim(txtcard.Text) = "" Then rs_kehu.Fields(8) = Null Else rs_kehu.Fields(8) = txtcard.Text End If If Trim(txtyoubian.Text) = "" Then rs_kehu.Fields(9) = Null Else rs_kehu.Fields(9) = txtyoubian.Text End If If Trim(txtadd.Text) = "" Then rs_kehu.Fields(10) = Null Else rs_kehu.Fields(10) = txtadd.Text End If If Trim(txtbeizhu.Text) = "" Then rs_kehu.Fields(11) = Null Else rs_kehu.Fields(11) = txtbeizhu.Text End If rs_kehu.Update MsgBox "修改成功:", vbOKOnly + vbExclamation With grdKehu .Row = getrow .Col = 1 .Text = txtname.Text .Col = 2 .Text = Combo1.Text .Col = 3 .Text = txttel.Text .Col = 4 .Text = txtcell.Text .Col = 5 .Text = txtduty.Text .Col = 6 .Text = DTPicker1.Value .Col = 7 .Text = txtemail.Text .Col = 8 .Text = txtcard.Text .Col = 9 .Text = txtyoubian.Text .Col = 10 .Text = txtadd.Text .Col = 11 .Text = txtbeizhu.Text End With Exit Sub End If rs_kehu.MoveNext Next i modifyerror: MsgBox Err.Description End Sub ,3,‚删除‛按钮的‚Click‛事件代码 Private Sub cmddel_Click() Dim answer As String Dim delete_row As String On Error GoTo delerror answer = MsgBox("确定要删除吗,", vbYesNo + vbQuestion) If answer = vbYes Then rs_kehu.MoveFirst Dim i As Integer For i = 0 To rs_kehu.RecordCount - 1 If rs_kehu.Fields(0) = txtID.Text Then rs_kehu.Delete rs_kehu.Update MsgBox "删除成功:", vbOKOnly + vbExclamation With grdKehu .RemoveItem getrow End With Exit Sub End If rs_kehu.MoveNext Next i Else Exit Sub End If Exit Sub delerror: MsgBox Err.Description End Sub 4.4.2建立客户资料查询窗体,frmKehuFind, 本窗体主要用来对客户资料进行查询。在查询条件中选择某一种查询方式～然后输入查询的关键字～即可按照要求找出符合条件的数据～并在下面的列表中显示结果。 1、界面设计 在工程中添加一个窗体～将其命名为frmKehuFind 。在这个窗体中添加1个Frame控件、4个Text控件、3个CommandButton控件、4个Option控件、1个MSHFlexGrid控件和1个PrintGrid控件。设臵完成的frmKehuFind窗体如图10所示。 图10 ‚客户资料查询‛窗体设计图 2、工程流程 窗体加载时在列表框中显示所有的数据。在查询条件部分选择某 一种查询方式～然后输入查询的关键字～再单击‚查询‛按钮～开始 执行查询～将查询的结果在表格中显示出来。 3、添加代码 本窗体中的窗体加载、菜单绑定、显示表格、查询和打印等操作 都与前面介绍的楼盘查询窗体相似。 ,1,‚查询‛按钮的‚Click‛事件代码 Private Sub Command1_Click() Dim sql As String On Error GoTo loaderror grdKehu.Clear If OptionID.Value = True Then sql = "select * from 客户资料表 where Hon_ID = '" & txtID.Text & "'" rs_kehu.CursorLocation = adUseClient rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_kehu.RecordCount < 1 Then Command2.Enabled = False Else Command2.Enabled = True setgrid setgridhead displaygrid rs_kehu.Close Exit Sub End If '按照姓名查询 If Optionname.Value = True Then sql = "select * from 客户资料表 where Hon_name = '" & txtname.Text & "'" rs_kehu.CursorLocation = adUseClient rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_kehu.RecordCount < 1 Then Command2.Enabled = False Else Command2.Enabled = True setgrid setgridhead displaygrid rs_kehu.Close Exit Sub End If '按照手机号查询 If Optioncell.Value = True Then sql = "select * from 客户资料表 where Hon_handset = '" & txtcell.Text & "'" rs_kehu.CursorLocation = adUseClient rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_kehu.RecordCount < 1 Then Command2.Enabled = False Else Command2.Enabled = True End If setgrid setgridhead displaygrid rs_kehu.Close Exit Sub End If '按照车牌号查询 If Optioncar.Value = True Then sql = "select * from 客户资料表 where Hon_carcode = '" & txtcard.Text & "'" rs_kehu.CursorLocation = adUseClient rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_kehu.RecordCount < 1 Then Command2.Enabled = False Else Command2.Enabled = True setgrid setgridhead displaygrid rs_kehu.Close Exit Sub End If Exit Sub loaderror: MsgBox Err.Description End Sub ,2,‚打印‛按钮的‚Click‛事件代码 Private Sub Command2_Click() Printgrid1.Unit = Centimeter Printgrid1.PrintObject = grdKehu Printgrid1.DoPreView End Sub 4.5实现收费管理功能 4.5.1建立收费登记窗体,frmShoufeiLogin, 本窗体主要用来对收费资料进行登记～包括添加、打印等操作。此窗体主要部分是一个票据样式的界面。在正确的位臵输入正确的信息后～单击‚保存‛按钮～即可完成新的收费资料的增加。单击‚打印‛按钮～即可将此票据进行打印。 1、界面设计 在工程中添加一个窗体～将其命名为frmShoufeiLogin。在此窗体中添加1个PictureBox控件～然后在该控件上方添加5个Label控件、10个Text控件和3个CommandButton控件。设臵完毕后的窗体如图11所示。 图11 ‚收费登记‛窗体设计图 2、工作流程 窗体加载时～楼盘编号等部分设臵为空～用来接收用户输入的数据。日期自动加载～默认为系统当前日期。编号是由系统递增产生的6位数字序号。收费金额部分设臵为‚0.00‛等～所有的收费项目添加完毕后～系统自动计算收费总金额～并将金额转换为人民币大写的形式。然后可以将此票据进行打印。 3、添加代码 Option Explicit Dim rs_shoufei As New ADODB.Recordset ,1,‚保存‛按钮的‚Click‛事件代码 Private Sub cmdsave_Click() Dim i As Integer If Trim(txtmoney(0).Text) = "" Then MsgBox "楼盘编号不能为空:", vbOKOnly + vbExclamation txtmoney(0).SetFocus Exit Sub End If Dim fee As Currency fee = 0 For i = 1 To 6 fee = fee + CCur(txtmoney(i).Text) Next i txtmoney(7).Text = CStr(fee) Label5.Caption = ChineseFormat(fee) rs_shoufei.AddNew rs_shoufei.Fields(0) = Label4 rs_shoufei.Fields(1) = txtmoney(0).Text rs_shoufei.Fields(2) = Date For i = 1 To 6 rs_shoufei.Fields(i + 2) = txtmoney(i).Text Next i rs_shoufei.Fields(9) = txtskr.Text rs_shoufei.Fields(10) = txtjkr.Text rs_shoufei.Update MsgBox "保存成功:", vbOKOnly + vbExclamation Exit Sub End Sub ,2,‚打印‛按钮的‚Click‛事件代码 Private Sub cmdprint_Click() Dim X% X% = BitBlt(Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, _ Picture1.hDC, 0, 0, SRCCOPY) Picture1.Picture = Picture1.Image Printer.PaintPicture Picture1.Picture, 0, 0 End Sub ,3,‚退出‛按钮的‚Click‛事件代码 Private Sub cmdexit_Click() rs_shoufei.Close Unload Me End Sub ,4,窗体加载时的代码 Private Sub Form_Load() Dim sql As String Dim i As Integer On Error GoTo loaderror sql = "select * from 收费信息表" rs_shoufei.CursorLocation = adUseClient rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic For i = 1 To 7 txtmoney(i).Text = "0.00" Next i i = rs_shoufei.RecordCount Label1.Caption = Year(Date) 'Date取得当前系统 日期 Label2.Caption = Month(Date) 'Month函数取得日 期的月数部分 Label3.Caption = Day(Date) Label4.Caption = Format(i + 1, "000000") '系统中现有记录条数 加1 Exit Sub loaderror: MsgBox Err.Description End Sub Function ChineseFormat(n As Variant) Dim s As String, sFormat As String Dim i As Integer, c As String Const sString = "分角元拾佰仟万拾佰仟亿拾佰仟万" Const sNumber = "零壹贰叁肆伍陆柒捌玖" s = Format(Int(n * 100)) sFormat = "" For i = Len(s) To 1 Step -1 c = Mid(s, i, 1) sFormat = Mid(sNumber, Val(c) _ + 1, 1) + Mid(sString, Len(s) - i + 1, 1) _ + sFormat Next ChineseFormat = sFormat End Function 4.5.2建立收费查询窗体,frmShoufeiFind, 这个窗体主要用来对收费资料进行查询。在查询条件中选择某一种查询方式～然后输入查询的关键字～即可按照要求找出符合条件的数据～并在下面的列表中显示结果。 1、界面设计 在工程中添加一个窗体～将其命名为frmShoufeiFind。在这个窗体中添加1个Frame控件～然后在Frame控件上添加3个Text控件、1个Label控件、3个CommandButton控件、4个Option控件、1个MSHFlexGrid控件和2个DTPicker控件。 添加好控件的窗体如图12所示。 图12 ‚收费查询‛窗体设计效果图 2、工作流程 窗体加载时在列表框中显示所有的数据。在查询条件部分选择某一种查询方式～然后输入查询的关键字～再单击‚查询‛按钮～开始执行查询～将查询的结果在表格中显示出来。当表格中有数据时～可以单击‚打印‛按钮打印表格。 3、添加代码 ,1,‚查找‛按钮的‚Click‛事件代码 Private Sub cmdfind_Click() Dim sql As String On Error GoTo loaderror grdShoufeiFind.Clear If optionid.Value = True Then sql = "select * from 收费信息表 where fee_ID = " & CInt(txtshoufeinum.Text) rs_shoufei.CursorLocation = adUseClient rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_shoufei.Close Exit Sub End If If optionloupan.Value = True Then sql = "select * from 收费信息表 where fee_houseID = '" & txtloupannum.Text & "'" rs_shoufei.CursorLocation = adUseClient rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_shoufei.Close Exit Sub End If If Optionjkr.Value = True Then sql = "select * from 收费信息表 where fee_jkr = '" & txtjkr.Text & "'" rs_shoufei.CursorLocation = adUseClient rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_shoufei.Close Exit Sub End If If optionjkt.Value = True Then sql = "select * from 收费信息表 where Fee_date between #" & _ DTPicker1.Value & "# and #" & DTPicker2.Value & "#" rs_shoufei.CursorLocation = adUseClient rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_shoufei.Close Exit Sub End If Exit Sub loaderror: MsgBox Err.Description End Sub ,2,‚打印‛按钮的‚Click‛事件代码 Private Sub cmdprint_Click() Printgrid1.Unit = Centimeter Printgrid1.PrintObject = grdShoufeiFind Printgrid1.DoPreView End Sub ,3,‚退出‛按钮的‚Click‛事件代码 Private Sub cmdexit_Click() Unload Me End Sub Private Sub Form_Load() Dim sql As String On Error GoTo loaderror sql = "select * from 收费信息表" rs_shoufei.CursorLocation = adUseClient rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic setgrid setgridhead displaygrid rs_shoufei.Close Exit Sub loaderror: MsgBox Err.Description End Sub Public Sub displaygrid() Dim i As Integer Dim j As Integer On Error GoTo displayerror grdShoufeiFind.Row = 0 If Not rs_shoufei.EOF Then rs_shoufei.MoveFirst Do While Not rs_shoufei.EOF grdShoufeiFind.Row = grdShoufeiFind.Row + 1 For j = 0 To 10 grdShoufeiFind.Col = j If Not IsNull(rs_shoufei.Fields(j)) Then grdShoufeiFind.Text = _ rs_shoufei.Fields(j) Else grdShoufeiFind.Text = "" Next j rs_shoufei.MoveNext Loop End If displayerror: If Err.Number <> 0 Then MsgBox Err.Description End If End Sub Public Sub setgrid() Dim i As Integer On Error GoTo seterror With grdShoufeiFind .ScrollBars = flexScrollBarBoth .FixedCols = 1 .Rows = rs_shoufei.RecordCount + 1 .Cols = 12 .SelectionMode = flexSelectionByRow For i = 0 To .Rows - 1 .RowHeight(i) = 315 Next For i = 0 To .Cols - 1 .ColWidth(i) = 1500 Next i End With Exit Sub seterror: MsgBox Err.Description End Sub Public Sub setgridhead() On Error GoTo setheaderror grdShoufeiFind.Row = 0 grdShoufeiFind.Col = 0 grdShoufeiFind.Text = "收费编号" grdShoufeiFind.Col = 1 grdShoufeiFind.Text = "楼盘编号" grdShoufeiFind.Col = 2 grdShoufeiFind.Text = "交费时间" grdShoufeiFind.Col = 3 grdShoufeiFind.Text = "有线电视" grdShoufeiFind.Col = 4 grdShoufeiFind.Text = "电话调试" grdShoufeiFind.Col = 5 grdShoufeiFind.Text = "煤气初装" grdShoufeiFind.Col = 6 grdShoufeiFind.Text = "公用设施" grdShoufeiFind.Col = 7 grdShoufeiFind.Text = "其他费用" grdShoufeiFind.Col = 8 grdShoufeiFind.Text = "押金" grdShoufeiFind.Col = 9 grdShoufeiFind.Text = "合计" grdShoufeiFind.Col = 10 grdShoufeiFind.Text = "收款人" grdShoufeiFind.Col = 11 grdShoufeiFind.Text = "交款人" Exit Sub setheaderror: MsgBox Err.Description End Sub 4.6实现系统维护功能 4.6.1数据备份 数据备份部分没有单独的窗体～在选择数据备份命令后～弹出如 图13所示的‚另存为‛对话框～从中选择备份文件存放的路径即可。 图13 ‚另存为‛对话框 ,1,在主窗体中添加一个CommandDialog控件～用来打开‚另 存为‛窗体。 Private Sub databasebak_click() Dim fsofile If conn.state<>0 then conn.close Set conn=Nothing Set fsofile=createobject(“scripting.filesystemobject”) CommandDialog1.Filter=”mdb 文件(*.mdb)|*.mdb” CommandDialog1.CancelError=True On Error Goto myerr CommandDialog1.showsave. 4.6.2实现退出系统功能 当用户试图关闭主窗体的时候～需要询问用户是否确定要退出系统～以防止用户的误操作。如果用户确实要退出系统～应先关闭系统中的数据库连接～然后再卸载主窗体。在菜单栏中的‚退出系统‛菜单和工具栏中的退出系统图标按钮的响应事件中都直接卸载窗体～而在主窗体的卸载询问事件中完成上述功能。具体代码如下所示: Private sub Form_QueryUnload(cancel ad integer,Unloadmode ad integer) If MsgBox(“确实要退出本系统吗,”～vbYesNo+vbQuestion,”提示”)=vbNo then Cancel=True Else If Conn.state<>0 then Conn.close Set conn=Nothing End if End Sub 至此～本系统的所有功能都实现了。 第五章 小 结 经过两个多月的设计和开发～系统基本开发完毕。其功能基本符合用户需求～能够完成对内是一个具有管理、汇总、查询能力的管理信息系统。但是由于毕业设计时间较短～所以该系统还有许多不尽如人意的地方～比如用户界面不够美观～出错处理不够等多方面问题。这些都有待一步改善。 通过对售楼管理信息系统的开发与实现～本人掌握了开发一个数据库管理信息系统所需的六个阶段,需求分析阶段、概念结构设计阶段、逻辑结构设计阶段、数据库物理设计阶段、数据库实现阶段、数据库行动和维护阶段,的要领～学会了用ACCESS数据库开发数据库管理信息系统的方法～提高了专业知识综合应用能力和分析问题、解决问题的能力～特别是增强了自己动手能力和计算机应用能力～进一步加深了开发计算机管理信息系统的兴趣和信心。 致 谢 在系统开发的两个月里～我受到了指导老师 老师的细心指导,老师严谨的指导态度与深厚的理论知识都让我受益非浅～从他身上我学到了很多的东西～无论是理论还是实践都使我的知识有很大的提高.借此我特提出感谢。 同时我还感谢母校的老师,谢谢他们为本系统提供的帮助。让我能够顺利地完成本系统的开发。也感谢那些对我提供帮助的同学,没有他们就不会现在的系统。 参考文献 [1]软件工程 作者:陈明 中央广播电视大学出版社 2001年 [2]Visual Basic程序设计 作者:陈明 中央广播电视大学出版社 2000年 [3]Visual Basic6.0数据库系统开发实例导航 作者: 刘韬、骆娟、何旭洪 人民邮电出版社 2002年 [4]数据库基础与应用 作者:王利 中央广播电视大学出版社 1997年 [5]SQL Server2000系统管理 飞思科技产品研发中心 电子工业出版社 2001年 [6] Visual Basic 6.0 使用指南 作者:Bob Reselman , Richard Peasley , Wayne Pruchniak. 电子工业出版社 [7] Visual Basic 6.0 中文版控件大全 作者:Microsoft电子工业出版社 "Father, Mother, this is my friend, Professor Bhaer," she said, with a face and tone of such irrepressible pride and pleasure that she might as well have blown a trumpet and opened the door with a flourish. If the stranger had any doubts about his reception, they were set at rest in a minute by the cordial welcome he received. Everyone greeted him kindly, for Jo's sake at first, but very soon they liked him for his own. They could not help it, for he carried the talisman that opens all hearts, and these simple people warmed to him at once, feeling even the more friendly because he was poor. For poverty enriches those who live above it, and is a sure passport to truly hospitable spirits. Mr. Bhaer sat looking about him with the air of a traveler who knocks at a strange door, and when it opens, finds himself at home. The children went to him like bees to a honeypot, and establishing themselves on each knee, proceeded to captivate him by rifling his pockets, pulling his beard, and investigating his watch, with juvenile audacity. The women telegraphed their approval to one another, and Mr. March, feeling that he had got a kindred spirit, opened his choicest stores for his guest's benefit, while silent John listened and enjoyed the talk, but said not a word, and Mr. Laurence found it impossible to go to sleep. If Jo had not been otherwise engaged, Laurie's behavior would have amused her, for a faint twinge, not of jealousy, but something like suspicion, caused that gentleman to stand aloof at first, and observe the newcomer with brotherly circumspection. But it did not last long. He got interested in spite of himself, and before he knew it, was drawn into the circle. For Mr. Bhaer talked well in this genial atmosphere, and did himself justice. He seldom spoke to Laurie, but he looked at him often, and a shadow would pass across his face, as if regretting his own lost youth, as he watched the young man in his prime. Then his eyes would turn to Jo so wistfully that she would have surely answered the mute inquiry if she had seen it. But Jo had her own eyes to take care of, and feeling that they could not be trusted, she prudently kept them on the little sock she was knitting, like a model maiden aunt. A stealthy glance now and then refreshed her like sips of fresh water after a dusty walk, for the sidelong peeps showed her several propitious omens. Mr. Bhaer's face had lost the absent-minded expression, and looked all alive with interest in the present moment, actually young and handsome, she thought, forgetting to compare him with Laurie, as she usually did strange men, to their great detriment. Then he seemed quite inspired, though the burial customs of the ancients, to which the conversation had strayed, might not be considered an exhilarating topic. Jo quite glowed with triumph when Teddy got quenched in an argument, and thought to herself, as she watched her father's absorbed face, "How he would enjoy having such a man as my Professor to talk with every day!" Lastly, Mr. Bhaer was dressed in a new suit of black, which made him look more like a gentleman than ever. His bushy hair had been cut and smoothly brushed, but didn't stay in order long, for in exciting moments, he rumpled it up in the droll way he used to do, and Jo liked it rampantly erect better than flat, because she thought it gave his fine forehead a Jove-like aspect. Poor Jo, how she did glorify that plain man, as she sat knitting away so quietly, yet letting nothing escape her, not even the fact that Mr. Bhaer actually had gold sleeve-buttons in his immaculate wristbands. "Dear old fellow! He couldn't have got himself up with more care if he'd been going a-wooing," said Jo to herself, and then a sudden thought born of the words made her blush so dreadfully that she had to drop her ball, and go down after it to hide her face. The maneuver did not succeed as well as she expected, however, for though just in the act of sng creature' was let severely alone, but Amy's talent and taste were duly complimented by the offer of the art table, and she exerted herself to prepare and secure appropriate and valuable contributions to it. Everything went on smoothly till the day before the fair opened, then there occurred one of the little skirmishes which it is almost impossible to avoid, when some five-and-twenty women, old and young, with all their private piques and prejudices, try to work together. May Chester was rather jealous of Amy because the latter was a greater favorite than herself, and just at this time several trifling circumstances occurred to increase the feeling. Amy's dainty pen-and-ink work entirely eclipsed May's painted vases--that was one thorn. Then the all conquering Tudor had danced four times with Amy at a late party and only once with May--that was thorn number two. But the chief grievance that rankled in her soul, and gave an excuse for her unfriendly conduct, was a rumor which some obliging gossip had whispered to her, that the March girls had made fun of her at the Lambs'. All the blame of this should have fallen upon Jo, for her naughty imitation had been too lifelike to escape detection, and the frolicsome Lambs had permitted the joke to escape. No hint of this had reached the culprits, however, and Amy's dismay can be imagined, when, the very evening before the fair, as she was putting the last touches to her pretty table, Mrs. Chester, who, of course, resented the supposed ridicule of her daughter, said, in a bland tone, but with a cold look... "I fie filled. Her best tile got a splash of water, which left a sephia tear on the Cupid's cheek. She bruised her hands with hammering, and got cold working in a draft, which last affliction filled her with apprehensions for the morrow. Any girl reader who has suffered like afflictions will sympathize with poor Amy and wish her well through her task. There was great indignation at home when she told her story that evening. Her mother said it was a shame, but told her she had done right. Beth declared she wouldn't go to the fair at all, and Jo demanded why she didn't take all her pretty things and leave those mean people to get on without her. "Because they are mean is no reason why i should be. I hate such things, and though I think I've a right to be hurt, I don't intend to show it. They will feel that more than angry speeches or huffy actions, won't they, Marmee?" "That's the right spirit, my dear. A kiss for a blow is always best, though it's not very easy to give it sometimes," said her mother, with the air of one who had learned the difference between preaching and practicing. In spite of various very natural temptations to resent and retaliate, Amy adhered to her resolution all the next day, bent on conquering her enemy by kindness. She began well, thanks to a silent reminder that came to her unexpectedly, but most opportunely. As she arranged her table that morning, while the little girls were in the anteroom filling the baskets, she took up her pet production, a little book, the antique cover of which her father had found among his treasures, and in which on leaves of vellum she had beautifully illuminated different texts. As she turned the pages rich in dainty devices with very pardonable pride, her eye fell upon one verse that made her stop and think. Framed in a brilliant scrollwork of scarlet, blue and gold, with little spirits of good will helping one another up and down among the thorns and flowers, were the words, "Thou shalt love thy neighbor as thyself." "I ought, but I don't," thought Amy, as her eye went from the bright page to May's discontented face behind the big vases, that could not hide the vacancies her pretty work had once filled. Amy stood a minute, turning the leaves in her hand, reading on each some sweet rebuke for all heartburnings and uncharitableness of spirit. Many wise and true sermons are preached us every day by unconscious ministers in street, school, office, or home. Even a fair table may become a pulpit, if it can offer the good and helpful words which are never out of season. Amy's conscience preached her a little sermon from that text, then and there, and she did what many of us do not always do, took the sermon to heart, and straightway put it in practice. A group of girls were standing about May's table, admiring the pretty things, and talking over the change of saleswomen. They dropped their voices, but Amy knew they were speaking of her, hearing one side of the story and judging accordingly. It was not pleasant, but a better spirit had come over her, and presently a chance offered for proving it. She heard May say sorrowfully... "It's too bad, for there is no time to make other things, and I don't want to fill up with odds and ends. The table was just complete then. Now it's spoiled." "I dare say she'd put them back if you asked her," suggested someone. "How could I after all the fuss?" began May, but she did not finish, for Amy's voice came across the hall, saying pleasantly... "You may have them, and welcome, without asking, if you want them. I was just thinking I'd offer to put them back, for they belong to your table rather than mine. Here they are, please take them, and forgive me if I was hasty in carrying them away last night." As she spoke, Amy returned her contribution, with a nod and a smile, and hurried away again, feeling that it was easier to do a friendly thing than it was to stay and be thanked for it. "Now, I call that lovely of her, don't you?" cried one girl. May's answer was inaudible, but another young lady, whose temper was evidently a little soured by making lemonade, added, with a disagreeable laugh, "Very lovely, for she knew she wouldn't sell them at her own table." Now, that was hard. When we make little sacrifices we like to have them appreciated, at least, and for a minute Amy was sorry she had done it, feeling that virtue was not always its won reward. But it is, as she presently discovered, for her spirits began to rise, and her table to blossom under her skillful hands, the girls were very kind, and that one little act seemed to have cleared the atmosphere amazingly. It was a very long day and a hard one for Amy, as she sat behind her table, often quite alone, for the little girls deserted very soon. Few cared to buy flowers in summer, and her bouquets began to droop long before night. The art table was the most attractive in the room. There was a crowd about it all day long, and the tenders were constantly flying to and fro with important faces and rattling money boxes. Amy often looked wistfully across, longing to be there, where she felt at home and happy, instead of in a corner with nothing to do. It might seem no hardship to some of us, but to a pretty, blithe young girl, it was not only tedious, but very trying, and the thought of Laurie and his friends made it a real martyrdom. She did not go home till night, and then she looked so pale and quiet that they knew the day had been a hard one, though she made no complaint, and did not even tell what she had done. Her mother gave her an extra cordial cup of tea. Beth helped her dress,and made a charming little wreath for her hair, while Jo astonished her family by getting herself up with unusual care, and hinting darkly that the tables were about to be turned. "Don't do anything rude, pray Jo. I won't have any fuss made, so let it all pass and behave yourself," begged Amy, as she departed early, hoping to find a reinforcement of flowers to refresh her poor little table. "I merely intend to make myself entrancingly agreeable to ever one I know, and to keep them in your corner as long as possible. Teddy and his boys will lend a hand, and we'll have a good time yet." returned Jo, leaning over the gate to watch for Laurie. Presently the familiar tramp was heard in the dusk, and she ran out to meet him. "Is that my boy?" "As sure as this is my girl!" And Laurie tucked her hand under his arm with the air of a man whose every wish was gratified. "Oh, teddy, such doings!" And Jo told Amy's wrongs with sisterly zeal. "A flock of our fellows are going to drive over by-and-by, and I'll be hanged if I don't make them buy every flower she's got, and camp down before her table afterward," said Laurie, espousing her cause with warmth. "The flowers are not at all nice, Amy says, and the fresh ones may not arrive in time. I don't wish to be unjust or suspicious, but I shouldn't wonder if they never came at all. When people do one mean thing they are very likely to do another," observed Jo in a disgusted tone. "Didn't Hayes give you the best out of our gardens? I told him to." "I didn't know that, he forgot, I suppose, and, as your grandpa was poorly, I didn't like to worry him by asking, though I did want some." "Now, Jo, how could you think there was any need of asking? They are just as much yours as mine. Don't we always go halves in everything?" began Laurie, in the tone that always made Jo turn thorny. "Gracious, I hope not! Half of some of your things wouldn't suit me at all. But we mustn't stand philandering here. I've got to help Amy, so you go and make yourself splendid, and if you'll be so very kind as to let Hayes take a few nice flowers up to the Hall, I'll bless you forever." "Couldn't you do it now?" asked Laurie, so suggestively that Jo shut the gate in his face with inhospitable haste, and called through the bars, "Go away, Teddy, I'm busy." Thanks to the conspirators, the tables were turned that night, for Hayes sent up a wilderness of flowers, with a loverly basket arranged in his best manner for a centerpiece. Then the March family turned out en masse, and Jo exerted herself to some purpose, for people not only came, but stayed, laughing at her nonsense, admiring Amy's taste, and apparently enjoying themselves very much. Laurie and his friends gallantly threw themselves into the breach, bought up the bouquets, encamped before the table, and made that corner the liveliest spot in the room. Amy was in her element now, and out of gratitude, if nothing more, was as spritely and gracious as possible, coming to the conclusion, about that time, that virtue was it's own reward, after all. Jo behaved herself with exemplary propriety, and when Amy was happily surrounded by her guard of honor, Jo circulated about the hall, picking up various bits of gossip, which enlightened her upon the subject of the Chester change of base. She reproached herself for her share of the ill feeling and resolved to exonerate Amy as soon as possible. She also discovered what Amy had done about the things in the morning, and considered her a model of magnanimity. As she passed the art table, she glanced over it for her sister's things, but saw no sign of them. "Tucked away out of sight, I dare say," thought Jo, who could forgiver her own wrongs, but hotly resented any insult offered her family. "Good evening, Miss Jo. How does Amy get on?" asked May with a conciliatory air, for she wanted to show that she also could begenerous. "She has sold everything she had that was worth selling, and now she is enjoying herself. The flower table is always attractive, you know, `especially to gentlemen'." Jo couldn't resist giving that little slap, but May took it so meekly she regretted it a minute after, and fell to praising the great vases, which still remained unsold. "Is Amy's illumination anywhere about" I took a fancy to buy that for Father," said Jo, very anxious to learn the fate of her sister's work. "Everything of Amy's sold long ago. I took care that the right people saw them, and they made a nice little sum of money for us," returned May, who had overcome sundry small temptations, as well as Amy had, that day. Much gratified, Jo rushed back to tell the good news, and Amy looked both touched and surprised by the report of May's word and manner. "Now, gentlemen, I want you to go and do your duty by the other tables as generously as you have by mine, especially the art table," she said, ordering out `Teddy's own', as the girls called the college friends. "`Charge, Chester, charge!' is the motto for that table, but do your duty like men, and you'll get your money's worth of art in every sense of the word," said the irrepressible Jo, as the devoted phalanx prepared to take the field. "To hear is to obey, but March is fairer far than May," said little Parker, making a frantic effort to be both witty and tender, and getting promptly quenched by Laurie, who said... "Very well, my son, for a small boy!" and walked him off, with a paternal pat on the head. "Buy the vases," whispered Amy to Laurie, as a final heaping of coals of fire on her enemy's head. To May's great delight, Mr. Laurence not only bought the vases, but pervaded the hall with one under each arm. The other gentlemen speculated with equal rashness in all sorts of frail trifles, and wandered helplessly about afterward, burdened with wax flowers, painted fans, filigree portfolios, and other useful and appropriate purchases. Aunt Carrol was there, heard the story, looked pleased, and said something to Mrs. March in a corner, which made the latter lady beam with satisfaction, and watch Amy with a face full of mingled pride and anxiety, though she did not betray the cause of her pleasure till several days later. The fair was pronounced a success, and when May bade Amy goodnight, she did not gush as usual, but gave her an affectionate kiss, and a look which said `forgive and forget'. That satisfied Amy, and when she got home she found the vases paraded on the parlor chimney piece with a great bouquet in each. "The reward of merit for a magnanimous March," as Laurie announced with a flourish. "You've a deal more principle and generosity and nobleness of character than I ever gave you credit for, Amy. You've behaved sweetly, and I respect you with all my heart," said Jo warmly, as they brushed their hair together late that night. "Yes, we all do, and love her for being so ready to forgive. It must have been dreadfully hard, after working so long and setting your heart on selling your own pretty things. I don't believe I could have done it as kindly as you did," added Beth from her pillow. "Why, girls, you needn't praise me so. I only did as I'd be done by. You laugh at me when I say I want to be a lad ty and their prayers. My father reckoned there was a lot less trouble with mutants on account of it, and when there were any, they were burnt, like other deviations.' 'Burnt!' I exclaimed. He looked at me. ' Isn't that the way to cleanse deviations?' he demanded fiercely. 'Yes,' I admitted, 'with crops and stock, but —' 'The other kind is the worst,' he snapped, 'it is the Devil mocking the true image. Of course they should be burnt like they used to be. But what happened? The sentimentalists in Rigo who never have to deal with them themselves said: "Even though they aren't human, they look nearly human, therefore extermination looks like murder, or execution, and that troubles some people's minds." So, because a few wishy-washy minds did not have enough resolution and faith, there were new laws about near-human deviations. They mustn't be cleansed, they must be allowed to live, or die naturally. They must be outlawed and driven into the Fringes, or, if they are infants, simply exposed there to take their chance — and that is supposed to be more merciful. At least the Government has the sense to understand that they mustn't be allowed to breed, and sees to it that they shan't — though I'd be willing to bet there's a party against that, too. And what happens? You get more Fringes dwellers, and that means you get more and bigger raids and lose time and money holding them back — all lost because of a namby-pamby dodging of the main issue. What sort of thinking is it to say "Accursed is the Mutant," and then treat him like a half-brother?' ' But a mutant isn't responsible for —' I began. '"Isn't responsible,"' sneered the old man. 'Is a tiger-cat responsible for being a tiger-cat? But you kill it. You can't afford to have it around loose. Repentances says to keep pure the stock of the Lord by fire, but that's not good enough for the bloody Government now. 'Give me the old days when a man was allowed to do his duty and keep the place clean. Heading right for another dose of Tribulation we are now.' He went on muttering, looking like an ancient and wrathful prophet of doom. 'All these concealments — and they'll try again for want of a proper lesson; women who've given birth to a Blasphemy just going to church and saying how sorry they are and they'll try not to do it again; Angus Morton's great-horses still around, an "officially approved" mockery of the Purity Laws; a damned inspector who just wants to hold his job and not offend them in Rigo — and then people wonder why we get tribulated seasons ...' He went on grumbling and spitting with disgust, a venomously puritanical old man. .. . I asked Uncle Axel whether there were a lot of people who really felt the way old Jacob talked. He scratched his cheek, thoughtfully. ' Quite a few of the old ones. They still feel it's a personal responsibility — like it used to be before there were inspectors. Some of the middle-aged are that way, too, but most of them are willing enough to leave it as it is. They're not so set on the forms as their fathers were. They don't reckon it matters much what way it's done so long as the mutants don't breed and things go along all right — but give them a run of years with instability as high as it is this year, and I'd not say for certain they'd take it quietly.' 'Why should the deviation-rate suddenly get high some years?' I asked him. He shook his head. 'I don't know. Something to do with the weather, they say. Get a bad winter with gales from the south-west, and up goes the deviation-rate — not the next season, but the one after that. Something comes over from the Badlands, they say. Nobody knows what, but it looks as though they're right. The old men see it as a warning, just a reminder of Tribulation sent to keep us on the right path, and they make the most of it. Next year's going to be a bad one, too. People will listen to them more then. They'll have a sharp eye for scapegoats.' He concluded by giving me a long, thoughtful look. I had taken the hint and passed it on to the others. Sure enough the season had been almost as tribulated as the one before, and there was a tendency to look for scapegoats. Public feeling towards concealments was noticeably less tolerant than it had been the previous summer, and it increased the anxiety we should in any case have felt over our discovery of Petra. For a week after the river incident we listened with extra care for any hint of suspicion about it. We found none, however. Evidently it had been accepted that both Rosalind and I, in different directions, had happened to hear cries for help which must, in any case, have been faint at the distance. We were able to relax again — but not for long. Only about a month went by before we had a new source of misgiving. Anne announced that she was going to marry. ... 10 There was a shade of defiance in Anne, even when she told us. At first we did not take it very seriously. We found it difficult to believe, and we did not want to believe, that she was serious. For one thing, the man was Alan Ervin, the same Alan I had fought on the bank of the stream, and who had informed on Sophie. Anne's parents ran a good farm, not a great deal smaller than Waknuk y, but I mean a true gentlewoman in mind and manners, and I try to do it as far as I know how. I can't explain exactly, but I want to be above the little meannesses and follies and faults that spoil so many women. I'm far from it now, but I do my best, and hope in time to be what Mother is." Amy spoke earnestly, and Jo said, with a cordial hug, "I understand now what you mean, and I'll never laugh at you again. You are getting on faster than you think, and I'll take lessons of you in true politeness, for you've learned the secret, I believe. Try away, deary, you'll get your reward some day, and no one will be more delighted than I shall." A week later Amy did get her reward, and poor Jo found it hard to be delighted. A letter came from Aunt Carrol, and Mrs. March's face was illuminated to such a degree when she read it that Jo and Beth, who were with her, demanded what the glad tiding were. "Aunt Carrol is going abroad next month, and wants..." "Me to go with her!" burst in Jo, flying out of her chair in an uncontrollable rapture. "No, dear, not you. It's Amy." "Oh, Mother! She's too young, it's my turn first. I've wanted it so long. It would do me so much good, and be so altogether splendid. I must go!" "I'm afraid it's impossible, Jo. Aunt says Amy, decidedly, and it is not for us to dictate when she offers such a favor."