procedure TForm1.FormCreate(Sender: TObject); var p:Pstr;Node:TTreeNode; begin with Table1,Treeview1 do begin open; first; new(p);{为指针p分配内存} p^:=FieldByName(′LongID′).AsString; Node:=Items.AddChildObject(nil,FieldByName (′Text′).AsString,p); if HasSubInDbf(Node) then Items .AddChildObject(Node,′ ′,nil);{有子节点则加一个空子节点} end; end;
---- HasSubInDbf为自定义函数,自变量为Node,检查节点Node有无子节点,有则返回True,反之返回False,并在TForm1的类定义里加入原型声明(其它自定义函数的原型也在TForm1的类定义里声明,不另作解释),函数代码如下: function TForm1.HasSubInDbf(Node:TTreeNode):Boolean; begin with Table1 do begin Table1.FindNearest([copy(Pstr(Node.Data)^,4,3)+′000′]); result:=copy(FieldByName(′LongID′). AsString,1,3)=copy(Pstr(Node.Data)^,4,3); {如数据库里当前记录的LongID字段内容的前3位和 节点Node的Data的后3位相同,则Node应该有子节点} end; end; 为TreeView1控件的OnDeletion事件添加代码,需要指出的是, 不仅调用Delete方法可以触发OnDeletion事件,而且当树控件本身被释放前, 也触发OnDeletion事件,所以,在此处加入dispose(node.data)会很"安全": procedure TForm1.TreeView1Deletion (Sender: TObject; Node: TTreeNode); begin Dispose(Node.Data);{释放节点数据内存} end; 为Add1选单项的OnClick事件添加代码如下: procedure TForm1.Add1Click(Sender: TObject); var p:pstr;Tmpstr:string;i:integer; begin try StrToInt(Edit2.Text); Tmpstr:=Edit2.Text;{注:在实用中,必须用更好的方法来产生ID} except; ShowMessage(′重新输入Edit2的内容′); abort; end; with TreeView1 do begin new(p); p^:=copy(Pstr(Selected.Data)^,4,3)+TmpStr; Items.AddChildObject(Selected,Edit1.Text,p); end; with Table1 do{ 在数据库里添加记录 } begin Append; FieldByName(′Text′).AsString:=Edit1.text; FieldByName(′LongID′).AsString:=p^; Post; end; TmpStr:=inttostr(strtoint(TmpStr)+1); for i:=length(TmpStr) to 2 do TmpStr:=′0′+TmpStr; Edit2.Text:=TmpStr; end; 为Del1菜单项的OnClick事件添加代码如下: procedure TForm1.Del1Click(Sender: TObject); var DelList:TStringList;LongID,NSubLongID:string; begin DelList:=TStringList.create; DelList.Sorted:=True; DelList.Add(Pstr(TreeView1.Selected.Data)^); while DelList.Count>0 do begin LongID:=DelList.Strings[0]; DelList.Delete(0); Table1.SetKey; Table1.FieldByName(′LongID′).AsString:=LongID; if Table1.GotoKey then Table1.Delete; if HasSubInDbf(TreeView1.Selected) then begin NSubLongID:=Table1.FieldByName(′LongID′).AsString; while (copy(NSubLongID,1,3)=copy (LongID,4,3))and(not Table1.Eof) do begin dellist.Add(NSubLongId); Table1.Next; NSubLongId:=Table1.FieldByName(′LongID′).AsString; end; end; end; DelList.Free; TreeView1.Items.Delete(TreeView1.Selected); end; 为TreeView1的OnExpanding事件添加代码: procedure TForm1.TreeView1Expanding (Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); var TmpNode:TTreeNode;NSubLongID: String;p:Pstr;bm:TBookMark; begin with Table1,TreeView1 do begin Items.BeginUpdate; SetKey; FieldByName(′LongID′).AsString:=Pstr(Node.Data)^; if not GotoKey then Items.Delete(Node) else begin TmpNode:=Node.GetFirstChild; if (TmpNode.Text=′ ′)and(TmpNode.Data=nil) then begin TmpNode.Delete; if HasSubInDbf(Node) then begin NSubLongID:=FieldByName(′LongID′).AsString; while (copy(NSubLongID,1,3)=copy(Pstr (Node.Data)^,4,3))and(not Eof) do begin new(p); p^:=FieldByName(′LongID′).AsString; bm:=GetBookMark; TmpNode:=Items.AddChildObject(Node, FieldByName(′Text′).AsString,p); if HasSubInDbf(TmpNode) then Items. AddChildObject(TmpNode,′ ′,nil); GotoBookMark(bm); FreeBookMark(bm); Next; NSubLongId:=FieldByName(′LongID′).AsString; end; end; end; end; Items.EndUpdate; end; end;
---- Windows中有两个非常重要的动态联结库:commctrl.dll和comctl32.dll,它们是Windows的自定义控制库(Windows Common Controls)。自定义控制库中包含了许多常用的Windows控件,如Statusbar,Coolbar,HotKey等;在Delphi中,这些控件大多数都已被包装成可视化控件了。在Microsoft推出Internet Explorer 3之后,自定义控制库中新增了一些控件,其中就包括Windows的IP控件(IP Address edit control)。
procedure Tform1.WndProc(var Msg: TMessage); var p:PNMHDR; begin inherited; if Msg.Msg=WM_NOTIFY then begin p:=Pointer(Msg.lParam); if p^.code=IPN_FIELDCHANGED then begin {… 处理IP控件的IPN_FIELDCHANGED通知消息 …} end; end; end;
procedure TCreateMultiCharts.ProcCreateCharts; var i,j,Rows,Columns,RowSpace,ChartsHeight:Integer; ShapeChart:array of array of TShape; begin Rows:=16; //Shape控件数组行数 Columns:=8; // Shape控件数组列数 RowSpace:=20; // Shape控件行间距 ChartsHeight:=20; // Shape控件高度 SetLength(ShapeChart,Rows,Columns); //设置ShapeChart数组大小 for i:=0 to Rows do for j:=0 to Columns do begin ShapeChart[i][j]:=TShape.Create(self); with ShapeChart[i,j] do begin Parent:=Self; //此行必不可少, 否则Shape控件在屏幕显示不出 Shape:=stRectangle; // Shape控件形状为矩形 Top:=45+i*(RowSpace+ChartsHeight); Left:=Round(180+Q[i,j].StartTime); //因Q[i,j].StartTime为实数,故需进行四舍五入取整 Width:=Round(Q[i,j].Value) Height:=ChartsHeight; Brush.Color:=RandomColor; //自定义函数,说明附后 Brush.Style:=bsSolid; //设置填充方式 Enabled:=True; end; end; end;
---- 注: a.Q为一记录型二维数组,定义如下: type TempData=Record Value:Real; StartTime:Real; end; Q:array of array of TempData 并且在另一过程已对Q的分量进行赋值。
---- b.为了区分不同的零件,Shape以不同颜色显示,此时,调用了函数RandomColor。该函数为: function TCreateMultiCharts.RandomColor; var red,green,blue:byte; begin red:=random(255); green:=random(255); blue:=random(255); result:=red or (green shl 8) or (blue shl 16); end; ---- (2).动态生成Charts控件的ChartSeries组件,显示设备利用率 procedure TFormMultiMachinesBurthen. ShowMachineBurthenCharts; var i:Integer; Burthen:Real; SeriesClass:TChartSeriesClass; NewSeries:array of TChartSeries; begin SetLength(NewSeries,CreateMultiCharts.Rows); MachinesBurthenCharts.height:=200; MachinesBurthenCharts.Width:=550; for i:=0 to CreateMultiCharts.Rows do begin SeriesClass:=TBarSeries; //设置形状为三维条形图 NewSeries[i]:=SeriesClass.Create(Self); NewSeries[i].ParentChart:=MachinesBurthenCharts; NewSeries[i].Clear; Burthen:=MachineBurthen[i]; Burthen:=Round(Burthen*100)/100; //只取小数点后两位数字 NewSeries[i].add(Burthen,',NewSeries[i].SeriesColor); end; end;