procedure TForm1.FormCreate(Sender: TObject); var p:Pstr;Node:TTreeNode; begin with Table1,Treeview1 do begin open; first; new(p);{為指針p分配內(nèi)存} p^:=FieldByName(′LongID′).AsString; Node:=Items.AddChildObject(nil,FieldByName (′Text′).AsString,p); if HasSubInDbf(Node) then Items .AddChildObject(Node,′ ′,nil);{有子節(jié)點(diǎn)則加一個(gè)空子節(jié)點(diǎn)} end; end;
---- HasSubInDbf為自定義函數(shù)，自變量為Node，檢查節(jié)點(diǎn)Node有無子節(jié)點(diǎn)，有則返回True，反之返回False，并在TForm1的類定義里加入原型聲明(其它自定義函數(shù)的原型也在TForm1的類定義里聲明，不另作解釋)，函數(shù)代碼如下： 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); {如數(shù)據(jù)庫里當(dāng)前記錄的LongID字段內(nèi)容的前3位和 節(jié)點(diǎn)Node的Data的后3位相同，則Node應(yīng)該有子節(jié)點(diǎn)} end; end; 為TreeView1控件的OnDeletion事件添加代碼，需要指出的是， 不僅調(diào)用Delete方法可以觸發(fā)OnDeletion事件，而且當(dāng)樹控件本身被釋放前， 也觸發(fā)OnDeletion事件，所以，在此處加入dispose(node.data)會很"安全"： procedure TForm1.TreeView1Deletion (Sender: TObject; Node: TTreeNode); begin Dispose(Node.Data);{釋放節(jié)點(diǎn)數(shù)據(jù)內(nèi)存} end; 為Add1選單項(xiàng)的OnClick事件添加代碼如下： procedure TForm1.Add1Click(Sender: TObject); var p:pstr;Tmpstr:string;i:integer; begin try StrToInt(Edit2.Text); Tmpstr:=Edit2.Text;{注：在實(shí)用中，必須用更好的方法來產(chǎn)生ID} except; ShowMessage(′重新輸入Edit2的內(nèi)容′); 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{ 在數(shù)據(jù)庫里添加記錄 } 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菜單項(xiàng)的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中有兩個(gè)非常重要的動態(tài)聯(lián)結(jié)庫：commctrl.dll和comctl32.dll，它們是Windows的自定義控制庫（Windows Common Controls）。自定義控制庫中包含了許多常用的Windows控件，如Statusbar，Coolbar，HotKey等；在Delphi中，這些控件大多數(shù)都已被包裝成可視化控件了。在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控件數(shù)組行數(shù) Columns:=8; // Shape控件數(shù)組列數(shù) RowSpace:=20; // Shape控件行間距 ChartsHeight:=20; // Shape控件高度 SetLength(ShapeChart,Rows,Columns); //設(shè)置ShapeChart數(shù)組大小 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為實(shí)數(shù),故需進(jìn)行四舍五入取整 Width:=Round(Q［i,j］.Value) Height:=ChartsHeight; Brush.Color:=RandomColor; //自定義函數(shù)，說明附后 Brush.Style:=bsSolid; //設(shè)置填充方式 Enabled:=True; end; end; end;
---- 注: a.Q為一記錄型二維數(shù)組,定義如下: type TempData=Record Value:Real; StartTime:Real; end; Q:array of array of TempData 并且在另一過程已對Q的分量進(jìn)行賦值。
---- b.為了區(qū)分不同的零件，Shape以不同顏色顯示，此時(shí)，調(diào)用了函數(shù)RandomColor。該函數(shù)為： 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).動態(tài)生成Charts控件的ChartSeries組件，顯示設(shè)備利用率 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; //設(shè)置形狀為三維條形圖 NewSeries［i］:=SeriesClass.Create(Self); NewSeries［i］.ParentChart:=MachinesBurthenCharts; NewSeries［i］.Clear; Burthen:=MachineBurthen［i］; Burthen:=Round(Burthen*100)/100; //只取小數(shù)點(diǎn)后兩位數(shù)字 NewSeries［i］.add(Burthen,',NewSeries［i］.SeriesColor); end; end;
