以下摘自《计算机世界》
var
Form1: TForm1;
const
SCodeFormat = '322222'; //科目代码结构
SFirstNodeTxt = '科目代码'; //首节点显示的文字
implementation
{$R *.DFM}
//以下函数是本文的重点部分，其主要功能是用一循环将Code.db表中的
//科目代码和科目代码名称显示出来
function TForm1.LoadCode(crTbl:TDBDataSet):Integer;
var NowID, // 编码值
// sName,
ShowTxt:String; // 编码值+中文名=节点名
// i,
Level:Integer; // 级次
MyNode:array[0..6] of TTreeNode; // 保存各级节点，最长支持6级(重点)
begin
Screen.Cursor:=crHourGlass; // 改变鼠标指针
Level:=0; // 级次付初值0
With crTbl do // table
begin
try
if not Active then Open; // table.open;
First;
tvwCode.Items.Clear; // treeview.items.clear;
//以下是增加第一项,节点TOPITEM值 SFirstNodeTxt [LEVEL=0]
MyNode[Level]:=tvwCode.Items.Add(tvwCode.TopItem,SFirstNodeTxt);
MyNode[Level].ImageIndex:=0;
MyNode[Level].SelectedIndex:=0;
//以上是增加第一项
While Not Eof do // TABLE 循环
begin
NowID:=Trim(FieldByName('aCode').AsString); // 编码值
ShowTxt:=NowID+' '+FieldByName('aName').AsString; // 编码值+中文名=节点名
Level:=GetLevel(SCodeFormat,NowID); // 根据分级得到编码级次
//以下是增加子项
//以下用上一级节点为父节点添加子节点
if Level>0 then // 确保代码符合标准
begin
MyNode[Level]:=tvwCode.Items.AddChild(MyNode[Level-1],ShowTxt);
MyNode[Level].ImageIndex:=1;
MyNode[Level].SelectedIndex:=2;
end;
//以上是增加子项
Next; // 下一条
end;
finally
Close;
end;
end;
MyNode[0].Expand(False); // 将首节点展开
Screen.Cursor:=crDefault;
end;
//以上函数将Code.db表中的科目代码和科目代码名称显示出来
//下面函数的功能是返回一代码的级数，参数sFormat传递科目代码结构；
//参数sCode传递某一科目代码
function TForm1.GetLevel(sFormat,sCode:String):Integer;
var i,
Level, // 返回值（级数）
iLen:Integer; // 级次
begin
Level:=-1; // 如果代码不符合标准，则返回-1
iLen:=0; // 级次
if (sFormat< >'')and(sCode< >'')then // sformat 'fjrule' ;scode 'hzflbh'
for i:=1 to Length(sFormat) do // 从1 TO 分级规则的长
begin
iLen:=iLen+StrToInt(sFormat); // 得出级次长度
if Length(sCode)=iLen then // 如级次长度=编码长度
begin
Level:=i; // 返回 i
Break; // 退出 FOR
end;
end;
Result:=Level; // 返回 Level 级数
end;
//上面函数的功能是返回一代码的级数
procedure TForm1.FormCreate(Sender: TObject);
begin
with tblCode do
begin
DatabaseName:=ParamStr(1); //使tblCode的DatabaseName指向应用程序所在的路径
TableName:='Code.DB'; //指向数据表Code.DB
Open;
IndexFieldNames:='aCode'; //按字段aCode排序(不要漏掉)
end;
LoadCode(tblCode);
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
Close;
end;
end.
