[email protected]
*****************************************************
unit FamilySet;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, ImgList, Db, DBTables;
type
TVillage=record file://村記錄
vid:string; file://村ID
vname:string; file://村名
end;
PVillage=^TVillage; file://村指針
TTeam=record file://組記錄
vid:string; file://村ID
tid:string; file://組ID
tname:string file://組名
end;
PTeam=^TTeam; file://組指針
TFamily=record file://用戶記錄
id:string; file://有線編號
vid:string; file://村鎮編號
tid:string; file://組街編號
fname:string; file://戶名
address:string; file://地址
tel:string; file://電話
terms:integer; file://終端數
sid:string; file://用戶類別
bankid:string; file://銀行帳號
regdate:TDate; file://開戶日期
isvalid:boolean; file://有效否
end;
PFamily=^TFamily;
TfmFamily = class(TForm)
tv: TTreeView;
MainMenu: TMainMenu;
mmProcess: TMenuItem;
mmAppend: TMenuItem;
mmEdit: TMenuItem;
mmDelete: TMenuItem;
ImageList: TImageList;
N1: TMenuItem;
sqlVillage: TQuery;
sqlTeam: TQuery;
sqlFamily: TQuery;
mmRefresh: TMenuItem;
PopupMenu: TPopupMenu;
pmAppend: TMenuItem;
pmEdit: TMenuItem;
pmDelete: TMenuItem;
N6: TMenuItem;
pmRefresh: TMenuItem;
N2: TMenuItem;
mmExpandAll: TMenuItem;
mmCollapseAll: TMenuItem;
N3: TMenuItem;
pmExpandAll: TMenuItem;
pmCollapseAll: TMenuItem;
N4: TMenuItem;
mmUnValid: TMenuItem;
mmValid: TMenuItem;
N5: TMenuItem;
pmValid: TMenuItem;
pmUnvalid: TMenuItem;
mmUserPrint: TMenuItem;
mmPrintUsers: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mmAppendClick(Sender: TObject);
procedure tvGetImageIndex(Sender: TObject; Node: TTreeNode);
procedure tvGetSelectedIndex(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
procedure tvDeletion(Sender: TObject; Node: TTreeNode);
procedure mmEditClick(Sender: TObject);
procedure mmDeleteClick(Sender: TObject);
procedure mmRefreshClick(Sender: TObject);
procedure pmAppendClick(Sender: TObject);
procedure pmEditClick(Sender: TObject);
procedure pmDeleteClick(Sender: TObject);
procedure pmRefreshClick(Sender: TObject);
procedure mmExpandAllClick(Sender: TObject);
procedure mmCollapseAllClick(Sender: TObject);
procedure pmExpandAllClick(Sender: TObject);
procedure pmCollapseAllClick(Sender: TObject);
procedure mmUnValidClick(Sender: TObject);
procedure mmValidClick(Sender: TObject);
procedure pmUnvalidClick(Sender: TObject);
procedure pmValidClick(Sender: TObject);
procedure tvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure mmPrintUsersClick(Sender: TObject);
private
{ Private declarations }
procedure ExpandTreeAll; file://鎮、村、組、戶 ,可能受機器限制,該函數不能成功。
public
{ Public declarations }
end;
var
fmFamily: TfmFamily;
implementation
uses NewVillage, NewTeam, NewFamily, catv_vars, ReportUser, UserPrint;
var tn0,tn1,tn2,tn3:TTreeNode; file://鎮、村、組、戶節點
aVillage:PVillage; file://一個村指針 (市鎮)
aTeam:PTeam; file://一個組指針 (街道)
aFamily:PFamily; file://一個戶指針
{$R *.DFM}
procedure TfmFamily.ExpandTreeAll;
begin
tv.Items.Clear;
tn0:=tv.Items.Add(nil,_AreaName);
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('select vid,vname from village order by vid ') ;
Open;
while not eof do
begin
New(aVillage);
aVillage.vid:=FieldByName('vid').asstring;
aVillage.vname:=FieldByName('vname').asstring;
tn1:=tv.Items.AddChildObject(tn0,aVillage.vname,aVillage);
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('select vid,tid,tname from team where vid=:vid order by tid ');
ParamByName('vid').asstring:=aVillage.vid;
Open;
while not eof do
begin
New(aTeam);
aTeam.vid:=aVillage.vid;
aTeam.tid:=FieldByName('tid').asstring;
aTeam.tname:=FieldByName('tname').asstring;
tn2:=tv.Items.AddChildObject(tn1,aTeam.tname,aTeam);
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('select * from family where vid=:vid and tid=:tid order by id ');
ParamByName('vid').asstring:=aVillage.vid;
ParamByName('tid').asstring:=aTeam.tid;
Open;
while not eof do
begin
New(aFamily);
aFamily.id:=FieldByName('id').asstring;
aFamily.vid:=aVillage.vid;
aFamily.tid:=aTeam.tid;
aFamily.fname:=FieldByName('fname').asstring;
aFamily.address:=FieldByName('address').asstring;
aFamily.tel:=FieldByName('tel').asstring;
aFamily.bankid:=FieldByName('bankid').asstring;
aFamily.sid:=FieldByName('sid').asstring;
aFamily.terms:=FieldByName('terms').asinteger;
aFamily.regdate:=FieldByName('regdate').asdatetime;
aFamily.isvalid:=FieldByName('isvalid').asboolean;
tn3:=tv.Items.AddChildObject(tn2,aFamily.fname,aFamily);
Next;
end;
Close;
end;
Next;
end;
Close;
end;
Next;
end;
Close;
end;
end;
procedure TfmFamily.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfmFamily.mmAppendClick(Sender: TObject);
var tn:TTreeNode;
id:string;
i:integer;
begin
tn:=tv.Selected;
if (tn=nil) then tn:=tn0; file://根節點:鄉鎮名稱
if (tn.Level=3) then tn:=tn.Parent; file://選定戶時取得所在組節點
case tn.Level of
0: file://選定鄉鎮,增加村
with TfmNewVillage.Create(nil) do
try
Caption:='增加新村/鎮';
if not tn.HasChildren then
edtVid.Text:='01'
else
begin
id:=PVillage(tn.GetLastChild.Data)^.vid;
edtVid.Text:=Copy(IntToStr(StrToInt(id)+1+100),2,2);
end;
edtVname.Text:='';
ShowModal;
if (ModalResult=mrOK) then
begin
if (length(edtVid.Text)=1) then edtVid.Text:=Copy(IntToStr(StrToInt(edtVid.text)+100),2,2); file://補前導0
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('insert into village (vid,vname) values (:vid,:vname) ');
ParambyName('vid').asstring:=edtVid.Text;
ParamByName('vname').asstring:=edtVname.Text;
try
ExecSQL; file://先插入表中
New(aVillage); file://再增加樹節點
aVillage.vid:=edtVid.Text;
aVillage.vname:=edtVname.Text;
tv.Items.AddChildObject(tn,edtVname.text,aVillage);
except
MessageDlg('增加新村/鎮失敗!',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;
1: file://選定村,增加組
with TfmNewTeam.Create(nil) do
try
Caption:='增加新組/街('+PVillage(tn.data)^.vname+')';
if not tn.HasChildren then
edtTid.Text:='01'
else
begin
id:=PTeam(tn.GetLastChild.Data)^.tid;
edtTid.Text:=Copy(IntToStr(StrToInt(id)+1+100),2,2);
end;
edtTname.Text:='';
ShowModal;
if (ModalResult=mrOK) then
begin
if (length(edtTid.Text)=1) then edtTid.Text:=Copy(IntToStr(StrToInt(edtTid.text)+100),2,2); file://補前導0
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('insert into team (vid,tid,tname) values (:vid,:tid,:tname) ');
ParambyName('vid').asstring:=PVillage(tn.data)^.vid;
ParamByName('tid').asstring:=edtTid.Text;
ParamByName('tname').asstring:=edtTname.Text;
try
ExecSQL; file://先插入表中
New(aTeam); file://再增加樹節點
aTeam.vid:=PVillage(tn.data)^.vid;
aTeam.tid:=edtTid.Text;
aTeam.tname:=edtTname.Text;
tv.Items.AddChildObject(tn,edtTname.text,aTeam);
except
MessageDlg('增加新組/街失敗!',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;
2: file://選定組,增加戶
with TfmNewFamily.Create(nil) do
try
Caption:='增加新用戶('+PTeam(tn.data)^.tname+')';
edtId.Text:='';
edtFname.Text:='';
edtAddress.Text:='';
edtTel.Text:='';
edtBankId.Text:='';
for i:=0 to Length(_sname)-1 do
cbSid.Items.Add(_sname[i]); file://選擇類別名稱
cbSid.ItemIndex:=0;
edtTerms.Text:='1';
dtpRegDate.DateTime:=Date;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('insert into family (id,vid,tid,fname,address,tel,bankid,sid,terms,regdate,isvalid) values (:id,:vid,:tid,:fname,:address,:tel,:bankid,:sid,:terms,:regdate,:isvalid) ');
ParamByName('id').asstring:=edtId.Text;
ParambyName('vid').asstring:=PTeam(tn.data)^.vid;
ParambyName('tid').asstring:=PTeam(tn.data)^.tid;
ParamByName('fname').asstring:=edtFname.Text;
ParamByName('address').asstring:=edtAddress.Text;
ParamByName('tel').asstring:=edtTel.Text;
ParamByName('bankid').asstring:=edtBankId.Text;
ParamByName('sid').asstring:=_sid[cbSid.itemindex]; file://保存類別編號
ParamByName('terms').asinteger:=StrTOIntDef(edtTerms.text,1);
ParamByName('regdate').asstring:=DateToStr(dtpRegDate.Date); file://不直接用日期型,防止錯誤
ParamByName('isvalid').asboolean:=True;
try
ExecSQL; file://先插入表中
New(aFamily); file://再增加樹節點
aFamily.id:=edtId.Text;
aFamily.vid:=PVillage(tn.Parent.data)^.vid;
aFamily.tid:=PTeam(tn.data)^.tid;
aFamily.fname:=edtFname.Text;
aFamily.address:=edtAddress.Text;
aFamily.tel:=edtTel.Text;
aFamily.bankid:=edtBankId.Text;
aFamily.sid:=_sid[cbSid.itemindex];
aFamily.terms:=StrTOIntDef(edtTerms.text,1);
aFamily.regdate:=dtpRegDate.Date;
aFamily.isvalid:=True;
tv.Items.AddChildObject(tn,edtFname.text,aFamily);
except
MessageDlg('增加新用戶失敗!',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;
end;
end;
procedure TfmFamily.tvGetImageIndex(Sender: TObject; Node: TTreeNode);
begin
If (Node.Level=3) then file://戶 0:地區 1:村 2:組 3:戶
if PFamily(Node.Data)^.isvalid then
Node.ImageIndex:=2 file://有效用戶
else
Node.ImageIndex:=3 file://已註銷用戶
else if Node.Expanded then
Node.ImageIndex:=1
else Node.ImageIndex:=0;
end;
procedure TfmFamily.tvGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
Node.SelectedIndex:=Node.ImageIndex;
end;
procedure TfmFamily.FormCreate(Sender: TObject);
begin
// InitTree;
ExpandTreeAll;
end;
procedure TfmFamily.tvDeletion(Sender: TObject; Node: TTreeNode);
begin
if Assigned(Node.Data) then
case Node.Level of
1:
Dispose(PVillage(Node.Data));
2:
Dispose(PTeam(Node.Data));
3:
Dispose(PFamily(Node.Data));
end;
end;
procedure TfmFamily.mmEditClick(Sender: TObject);
var tn:TTreeNode; //
i:integer;
begin
tn:=tv.Selected;
if ((tn=nil) or (tn.level=0)) then
begin
MessageDlg('請選定村組(鎮街)或用戶!',mtInformation,[mbOk],0);
Exit;
end;
case tn.Level of
1: file://選定村,修改村
with TfmNewVillage.Create(nil) do
try
Caption:='修改村/鎮名';
edtVid.Text:=PVillage(tn.data)^.vid;
edtVname.Text:=PVillage(tn.data)^.vname;
edtVid.ReadOnly:=True;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('update village set vname=:vname where vid=:vid ');
ParambyName('vid').asstring:=edtVid.Text;
ParamByName('vname').asstring:=edtVname.Text;
try
ExecSQL; file://先更新表
tn.Text:=edtVName.Text; file://再修改樹節點
PVillage(tn.data)^.vname:=edtVname.Text;
except
MessageDlg('修改村/鎮名失敗!',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;
2: file://選定組,修改組
with TfmNewTeam.Create(nil) do
try
Caption:='修改組/街名('+tn.Parent.Text+')';
edtTid.Text:=PTeam(tn.data)^.tid;
edtTname.Text:=PTeam(tn.data)^.tname;
edtTid.ReadOnly:=True;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('update team set tname=:tname where vid=:vid and tid=:tid ');
ParambyName('vid').asstring:=PVillage(tn.Parent.data)^.vid;
ParamByName('tid').asstring:=edtTid.Text;
ParamByName('tname').asstring:=edtTname.Text;
try
ExecSQL; file://先修改表
tn.text:=edtTName.Text; file://再修改樹節點
PTeam(tn.data)^.tname:=edtTname.Text;
except
MessageDlg('修改組/街名失敗!',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;
3: file://選定戶,修改戶
with TfmNewFamily.Create(nil) do
try
Caption:='修改用戶('+tn.Parent.Text+')';
edtId.ReadOnly:=True;
for i:=0 to Length(_sname)-1 do
cbSid.Items.Add(_sname[i]); file://選擇類別名稱
edtId.Text:=PFamily(tn.data)^.id;
edtFname.Text:=PFamily(tn.data)^.fname;
edtAddress.Text:=PFamily(tn.data)^.address;
edtTel.Text:=PFamily(tn.data)^.tel;
edtBankId.Text:=PFamily(tn.data)^.bankid;
edtTerms.Text:=IntToStr(PFamily(tn.data)^.terms);
dtpRegDate.DateTime:=PFamily(tn.data)^.regdate;
for i:=0 to Length(_sid)-1 do
if Pfamily(tn.data)^.sid=_sid[i] then break;
cbSid.ItemIndex:=i;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('update family set fname=:fname,address=:address,tel=:tel,');
SQL.Add('bankid=:bankid,sid=:sid,terms=:terms,regdate=:regdate where id=:id');
ParamByName('id').asstring:=edtId.Text;
ParamByName('fname').asstring:=edtFname.Text;
ParamByName('address').asstring:=edtAddress.Text;
ParamByName('tel').asstring:=edtTel.Text;
ParamByName('bankid').asstring:=edtBankId.Text;
ParamByName('sid').asstring:=_sid[cbSid.itemindex]; file://保存類別編號
ParamByName('terms').asinteger:=StrTOIntDef(edtTerms.text,1);
ParamByName('regdate').asstring:=DateToStr(dtpRegDate.Date); file://不直接用日期型,防止錯誤
try
ExecSQL; file://修改表
tn.Text:=edtFname.Text; file://再修改樹節點
PFamily(tn.data)^.fname:=edtFname.Text;
PFamily(tn.data)^.address:=edtAddress.Text;
PFamily(tn.data)^.tel:=edtTel.Text;
PFamily(tn.data)^.bankid:=edtBankid.Text;
PFamily(tn.data)^.sid:=_sid[cbSid.itemindex];
PFamily(tn.data)^.terms:=StrTOIntDef(edtTerms.text,1);
PFamily(tn.data)^.regdate:=dtpRegDate.Date;
except
MessageDlg('修改用戶信息失敗!',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;
end;
end;
procedure TfmFamily.mmDeleteClick(Sender: TObject);
var tn:TTreeNode;
begin
tn:=tv.Selected;
if ((tn=nil) or (tn.level=0)) then
begin
MessageDlg('請選定村組(鎮街)或用戶!',mtInformation,[mbOk],0);
Exit;
end;
if tn.HasChildren then
begin
MessageDlg('請先刪除下級!',mtInformation,[mbOk],0);
Exit;
end;
if MessageDlg('是否刪除"'+tn.text+'"?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Exit;
case tn.Level of
1: file://刪除村
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('delete from village where vid=:vid ');
ParambyName('vid').asstring:=PVillage(tn.data)^.vid;
try
ExecSQL; file://先從表中刪除
tn.Delete; file://再刪除樹節點
except
MessageDlg('刪除失敗!',mtInformation,[mbOk],0);
end;
end;
2: file://刪除組
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('delete from team where vid=:vid and tid=:tid ');
ParambyName('vid').asstring:=PTeam(tn.data)^.vid;
ParamByName('tid').asstring:=PTeam(tn.data)^.tid;
try
ExecSQL; file://從表刪除
tn.delete; file://再刪除樹節點
except
MessageDlg('刪除失敗!',mtInformation,[mbOk],0);
end;
end;
3: file://刪除戶
if MessageDlg('刪除用戶將丟失該用戶的收費信息,是否刪除?',mtWarning,[mbYes,mbNo],0)=mrYes then
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('delete from family where id=:id');
ParambyName('id').asstring:=PFamily(tn.data)^.id;
try
ExecSQL; file://從表刪除
tn.delete; file://再刪除樹節點
except
MessageDlg('刪除失敗!',mtInformation,[mbOk],0);
end;
end;
end;
end;
procedure TfmFamily.mmRefreshClick(Sender: TObject);
begin
ExpandTreeAll;
end;
procedure TfmFamily.pmAppendClick(Sender: TObject);
begin
mmAppend.Click;
end;
procedure TfmFamily.pmEditClick(Sender: TObject);
begin
mmEdit.Click;
end;
procedure TfmFamily.pmDeleteClick(Sender: TObject);
begin
mmDelete.Click;
end;
procedure TfmFamily.pmRefreshClick(Sender: TObject);
begin
mmRefresh.Click;
end;
procedure TfmFamily.mmExpandAllClick(Sender: TObject);
begin
tv.FullExpand;
end;
procedure TfmFamily.mmCollapseAllClick(Sender: TObject);
begin
tv.FullCollapse;
end;
procedure TfmFamily.pmExpandAllClick(Sender: TObject);
begin
mmExpandALl.Click;
end;
procedure TfmFamily.pmCollapseAllClick(Sender: TObject);
begin
mmCollapseAll.Click;
end;
procedure TfmFamily.mmUnValidClick(Sender: TObject);
var tn:TTreeNode;
begin
tn:=tv.Selected;
if (tn=nil) or (tn.Level<3) or Pfamily(tn.data)^.isvalid=false then file://只處理未註銷用戶
Exit;
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add(' update family set isvalid=false where id=:id') ;
ParamByName('id').asstring:=Pfamily(tn.data)^.id;
try
ExecSQL; file://先更新表
Pfamily(tn.data)^.isvalid:=false;
tv.Selected:=nil;tv.Selected:=tn; file://以改變圖標
except
MessageDlg('註銷用戶失敗!',mtInformation,[mbOk],0);
end;
end;
end;
procedure TfmFamily.mmValidClick(Sender: TObject);
var tn:TTreeNode;
begin
tn:=tv.Selected;
if (tn=nil) or (tn.Level<3) or Pfamily(tn.data)^.isvalid=True then file://只處理已註銷用戶
Exit;
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add(' update family set isvalid=true where id=:id') ;
ParamByName('id').asstring:=Pfamily(tn.data)^.id;
try
ExecSQL; file://先更新表
Pfamily(tn.data)^.isvalid:=true;
tv.Selected:=nil;tv.Selected:=tn; file://以改變圖標
except
MessageDlg('收回用戶失敗!',mtInformation,[mbOk],0);
end;
end;
end;
procedure TfmFamily.pmUnvalidClick(Sender: TObject);
begin
mmUnvalid.Click;
end;
procedure TfmFamily.pmValidClick(Sender: TObject);
begin
mmValid.Click;
end;
procedure TfmFamily.tvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var tn:TTreeNode;
begin
tn:=tv.GetNodeAt(x,y);
if (tn=nil) or (tn.Level<3) then
tv.Hint:=''
else
tv.Hint:= '編號:'+Pfamily(tn.data)^.id
+' 戶名:'+Pfamily(tn.data)^.fname
+' 端數:'+IntToStr(Pfamily(tn.data)^.terms)
+' 開戶:'+DateToStr(Pfamily(tn.data)^.regdate)
+' 類別:'+GetSname(Pfamily(tn.data)^.sid)
+' 帳號:'+Pfamily(tn.data)^.bankid
+' 地址:'+Pfamily(tn.data)^.address
+' 電話:'+Pfamily(tn.data)^.tel;
end;
procedure TfmFamily.mmPrintUsersClick(Sender: TObject);
begin
with TfmUserPrint.Create(nil) do
try
ShowModal;
finally
Free;
end;
end;
end.