数据和TREE问题,完成90%的人事管理程序,求助(200分)

  • 主题发起人 主题发起人 myxy
  • 开始时间 开始时间
M

myxy

Unregistered / Unconfirmed
GUEST, unregistred user!
用DELPHI自身的TREE很慢,只好改用了Dream Controls里面的DCTREE控件,结果还是慢
Dream 这个控件在http://www.inprises.com/control/index.htm中有下载,带源码

写的程序在这里放http://myxy.51.net/new_work.zip

麻烦各位大富翁们帮助一下
 
顺便将主FORM源码贴出,请看

unit view;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ImgList, StdCtrls, DBCtrls, Mask, Db, DBTables, Menus, Buttons, ComCtrls,
ToolWin, ExtCtrls, Grids, DBGrids, dcntree;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
tbl: TTable;
GroupBox11: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label29: TLabel;
Label30: TLabel;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
Label34: TLabel;
Label35: TLabel;
Label36: TLabel;
Label4: TLabel;
Label6: TLabel;
Acode: TDBEdit;
idcard: TDBEdit;
Aname: TDBEdit;
Sex: TDBEdit;
Duty: TDBEdit;
Culture: TDBEdit;
Nation: TDBEdit;
WorkType: TDBEdit;
Native: TDBEdit;
Birth: TDBEdit;
Join: TDBEdit;
Award: TDBMemo;
GroupBox12: TGroupBox;
GroupBox13: TGroupBox;
Label37: TLabel;
Label38: TLabel;
Label39: TLabel;
JnPay1: TDBEdit;
JnPay2: TDBEdit;
GroupBox14: TGroupBox;
Label40: TLabel;
Label41: TLabel;
Label42: TLabel;
GwPay1: TDBEdit;
GwPay2: TDBEdit;
GroupBox15: TGroupBox;
Label43: TLabel;
Label44: TLabel;
Label45: TLabel;
FdPay1: TDBEdit;
FdPay2: TDBEdit;
GroupBox16: TGroupBox;
Label46: TLabel;
Label5: TLabel;
LdPay: TDBEdit;
OtherPay: TDBEdit;
GroupBox17: TGroupBox;
GroupBox18: TGroupBox;
Label47: TLabel;
Label48: TLabel;
Label49: TLabel;
Safety: TDBEdit;
Safetydate: TDBEdit;
GroupBox19: TGroupBox;
Label50: TLabel;
Label51: TLabel;
Label52: TLabel;
Work: TDBEdit;
Workdate: TDBEdit;
ImageList1: TImageList;
ImageList2: TImageList;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
Add: TSpeedButton;
Save: TSpeedButton;
Moifya: TSpeedButton;
deldata: TSpeedButton;
Cancel: TSpeedButton;
quit: TSpeedButton;
MainMenu1: TMainMenu;
F1: TMenuItem;
E1: TMenuItem;
A1: TMenuItem;
B1: TMenuItem;
R1: TMenuItem;
C1: TMenuItem;
C2: TMenuItem;
A2: TMenuItem;
DBNavigator1: TDBNavigator;
tvwCode: TDCTree;
Label3: TLabel;
zc: TDBEdit;
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btnAddClick(Sender: TObject);
procedure btnEditClick(Sender: TObject);
procedure btnDelClick(Sender: TObject);
private
{ Private declarations }

function LoadCode(crTbl:TDBDataSet):Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

const
SCodeFormat = '322222'; // 科目代码结构
SFirstNodeTxt = '新纺集团人员目录树';// 首节点显示的文字

function GetLevel(sFormat,sCode:String):Integer;

implementation

{$R *.DFM}

uses Unit2;


function GetLevel(sFormat,sCode:String):Integer;
var
i,Level,iLen:Integer;
begin
Level:=-1; // 如果代码不符合标准,则返回-1
iLen:=0;
if (sFormat<>'')and(sCode<>'')then
for i:=1 to Length(sFormat) do
begin
iLen:=iLen+StrToInt(sFormat);
if Length(sCode)=iLen then
begin
Level:=i;
Break;
end;
end;
Result:=Level;
end;


function Tform1.LoadCode(crTbl:TDBDataSet):Integer;
var
NowID,ShowTxt:String;
Level:Integer;
MyNode:array[0..6]of TDCTreeNode;// 保存各级节点,最长支持6 级( 重点)
begin
tvwCode.Items.Clear;
Level:=0;
with crTbl do
begin
try
if not Active then Open;
First;
// 以下是增加第一项
MyNode[Level]:=tvwCode.Items.AddChild(tvwCode.TopItem,SFirstNodeTxt);
MyNode[Level].ImageIndex:=0;
MyNode[Level].SelectedIndex:=0;
// 以上是增加第一项
tvwCode.Items.BeginUpdate;
while Not Eof do
begin
NowID:=Trim(FieldByName('aCode').AsString);
ShowTxt:=NowID+' '+FieldByName('aName').AsString;
Level:=GetLevel(SCodeFormat,NowID);
// 返回代码的级数
// 以下是增加子项// 以下用上一级节点为父节点添加子节点
if Level>0 then// 确保代码符合标准
begin
MyNode[Level]:=tvwCode.Items.Add(MyNode[Level-1],ShowTxt);
MyNode[Level].ImageIndex:=1;
MyNode[Level].SelectedIndex:=2;
end;
Next;
end;
tvwCode.Items.EndUpdate;
finally
Close;
end;
end;
// MyNode[0].Expand(False);// 将首节点展开
// Screen.Cursor:=crDefault;
// Result:=Level;
end;
// 以上函数将work.db 表中的科目代码和科目代码名称显示出来


procedure TForm1.FormCreate(Sender: TObject);
begin
ShortDateFormat := 'YYYY-MM-DD';
with tbl do
begin
DatabaseName:=ParamStr(1);
// 使tblCode 的DatabaseName 指向应用程序所在的路径
TableName:='work.DB';
Open;
IndexFieldNames:='aCode';
// 按字段aCode 排序( 不要漏掉)
end;
LoadCode(tbl);

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageBox(Handle, '确定要退出本系统吗?', '确认', MB_ICONQUESTION or MB_OKCANCEL) = IDCANCEL then
CanClose := False;
end;

procedure Tform1.btnAddClick(Sender: TObject);
var
iPos:Integer;
SelNode:TDCTreeNode;
SelText,SelCode:String;
begin
SelNode:=tvwcode.Selected;
if SelNode <> nil then
begin
SelText:=SelNode.Text;
iPos:=Pos(' ',SelText);
SelCode:=Copy(SelText,1,iPos-1);
with TForm2.Create(Application) do
begin
ParentCode:=SelCode;
IsAdd:=true;
TreeView:=tvwCode;
Table:=tbl;
ShowModal;
Free;
end;
end;
end;

procedure TForm1.btnEditClick(Sender: TObject);
var
iPos:Integer;
SelNode:TDCTreeNode;
SelText,SelCode,SelName,ParentText:String;
begin
SelNode:=tvwCode.Selected;
if tvwCode.TopItem=SelNode then
begin
Application.MessageBox('Please select a parent code!','Warning',16);
Exit;
end;
if SelNode <> nil then
begin
SelText:=SelNode.Text;
iPos:=Pos(' ',SelText);
SelCode:=Copy(SelText,1,iPos-1);
SelName:=Copy(SelText,iPos+1,Length(SelText));
with TForm2.Create(Application) do
begin
edtCode.Text:=SelCode;
edtName.Text:=SelName;
ParentText:=SelNode.Parent.Text;
ParentCode:=Copy(ParentText,1,Pos(' ',ParentText)-1);
IsAdd:=false;
TreeView:=tvwCode;
Table:=tbl;
ShowModal;
Free;
end;
end;
end;

procedure TForm1.btnDelClick(Sender: TObject);
var
iPos:Integer;
SelNode:TDCTreeNode;
SelText,SelCode:String;
begin
SelNode:=tvwCode.Selected;
if SelNode <> nil then
begin
if SelNode.HasChildren then
begin
Application.MessageBox('You can not delete the code of existing a children!','Warning',16);
Exit;
end;
if Application.MessageBox('Do you want to delete this code?','Warning',
MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=IDNO then
Exit;
SelText:=SelNode.Text;
iPos:=Pos(' ',SelText);
SelCode:=Copy(SelText,1,iPos-1);
with tbl do
begin
if not Active then Open;
if FindKey([SelCode]) then Delete;
Close;
end;
SelNode.Delete;
end;
end;


end.
 
你的数据表work.db的问题,
用程序遍历记录时到8000多条时会跳回前面的记录去,
我用dxtree显示8000多条记录不到10秒
 
对DELPHI的TREE有一定的了解。不过,我认为向这种TREE或者LISTVIEW的问题可以考虑
使用回调和使用指针进行处理,比较方便一点。
可以举一下例子作为参考:
TObjAction = (Add, Del, Chg);
TObjAct = procedure (Tree: TTree; Act: TObjAction;
Obj: Pointer) of Object;//申明回调
var
FObjAct: TObjAct;
在另外使用这个回调的时候,如:
OnObjAct := XX.FObjAct;
可以在下面进行处理:
procedure OnobjAct(Tree: TTree; Act: TObjAction;
Obj: Pointer);
var
//假设TT已经做好了申明,其PT = ^TT;
//TT = class
A: Integer;
B: String;
end;
Node: TTreeNode;
begin
case Act of
Add:
begin
Node := Tree.AddObject(nil, TT(Obj^).B, Obj); //如果增加在Level = 0此;
//也可以增加在Node的下面。level >0;
Tree.AddObject(Node, TT(Obj^)B, Obj);
end;
Del:;
Chg:;
end;
end;
上面的Tree在进行初始化的时候,可能比较慢,但是,
在进行初始化以后对数据进行处理的速度可能会快一些。





 
哈哈被大侠说中了,是数据库有问题,奶奶的,有问题还能用???
通过一个修复数据库的软件,搞定了!!!!

zm30 COOL!!!
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部