就用如下思路(这是给mdi窗体加背景的!):unit MainFrm;interfaceuses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, JPeg;type
TMainForm = class(TForm)
mmMain: TMainMenu;
mmiFile: TMenuItem;
mmiNew: TMenuItem;
mmiClose: TMenuItem;
N1: TMenuItem;
mmiExit: TMenuItem;
mmiImage: TMenuItem;
mmiTile: TMenuItem;
mmiCenter: TMenuItem;
mmiStretch: TMenuItem;
imgMain: TImage;
procedure mmiNewClick(Sender: TObject);
procedure mmiCloseClick(Sender: TObject);
procedure mmiExitClick(Sender: TObject);
procedure mmiTileClick(Sender: TObject);
private
FOldClientProc,
FNewClientProc: TFarProc;
FDrawDC: hDC;
procedure CreateMDIChild(const Name: string);
procedure ClientWndProc(var Message: TMessage);
procedure DrawStretched;
procedure DrawCentered;
procedure DrawTiled;
protected
procedure CreateWnd; override;
end;var
MainForm: TMainForm;implementationuses MdiChildFrm;{$R *.DFM}procedure TMainForm.CreateWnd;
begin
inherited CreateWnd;
// Turn the ClientWndProc method into a valid window procedure
FNewClientProc := MakeObjectInstance(ClientWndProc);
// Get a pointer to the original window procedure
FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
// Set ClientWndProc as the new window procedure
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;procedure TMainForm.DrawCentered;
{ This procedure centers the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
with imgMain do
BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
((CR.Bottom - CR.Top) - Picture.Height) div 2,
Picture.Graphic.Width, Picture.Graphic.Height,
Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;procedure TMainForm.DrawStretched;
{ This procedure stretches the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
end;procedure TMainForm.DrawTiled;
{ This procedure tiles the image on the form's client area }
var
Row, Col: Integer;
CR, IR: TRect;
NumRows, NumCols: Integer;
begin
GetWindowRect(ClientHandle, CR);
IR := imgMain.ClientRect;
NumRows := CR.Bottom div IR.Bottom;
NumCols := CR.Right div IR.Right;
with imgMain do
for Row := 0 to NumRows+1 do
for Col := 0 to NumCols+1 do
BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
end;procedure TMainForm.ClientWndProc(var Message: TMessage);
begin
case Message.Msg of
// Capture the WM_ERASEBKGND messages and perform the client area drawing
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam,
Message.lParam);
FDrawDC := TWMEraseBkGnd(Message).DC;
if mmiStretch.Checked then
DrawStretched
else if mmiCenter.Checked then
DrawCentered
else DrawTiled;
Message.Result := 1;
end;
{ Capture the scrolling messages and ensure the client area
is redrawn by calling InvalidateRect }
WM_VSCROLL, WM_HSCROLL:
begin
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
InvalidateRect(ClientHandle, nil, True);
end;
else
// By Default, call the original window procedure
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
end; { case }
end;procedure TMainForm.CreateMDIChild(const Name: string);
var
MdiChild: TMDIChildForm;
begin
MdiChild := TMDIChildForm.Create(Application);
MdiChild.Caption := Name;
end;procedure TMainForm.mmiNewClick(Sender: TObject);
begin
CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;procedure TMainForm.mmiCloseClick(Sender: TObject);
begin
if ActiveMDIChild <> nil then
ActiveMDIChild.Close;
end;procedure TMainForm.mmiExitClick(Sender: TObject);
begin
Close;
end;procedure TMainForm.mmiTileClick(Sender: TObject);
begin
mmiTile.Checked := false;
mmiCenter.Checked := False;
mmiStretch.Checked := False;
{ Set the Checked property for the menu item which invoked }
{ this event handler to Checked }
if Sender is TMenuItem then
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
{ Redraw the client area of the form }
InvalidateRect(ClientHandle, nil, True);
end;end.
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, JPeg;type
TMainForm = class(TForm)
mmMain: TMainMenu;
mmiFile: TMenuItem;
mmiNew: TMenuItem;
mmiClose: TMenuItem;
N1: TMenuItem;
mmiExit: TMenuItem;
mmiImage: TMenuItem;
mmiTile: TMenuItem;
mmiCenter: TMenuItem;
mmiStretch: TMenuItem;
imgMain: TImage;
procedure mmiNewClick(Sender: TObject);
procedure mmiCloseClick(Sender: TObject);
procedure mmiExitClick(Sender: TObject);
procedure mmiTileClick(Sender: TObject);
private
FOldClientProc,
FNewClientProc: TFarProc;
FDrawDC: hDC;
procedure CreateMDIChild(const Name: string);
procedure ClientWndProc(var Message: TMessage);
procedure DrawStretched;
procedure DrawCentered;
procedure DrawTiled;
protected
procedure CreateWnd; override;
end;var
MainForm: TMainForm;implementationuses MdiChildFrm;{$R *.DFM}procedure TMainForm.CreateWnd;
begin
inherited CreateWnd;
// Turn the ClientWndProc method into a valid window procedure
FNewClientProc := MakeObjectInstance(ClientWndProc);
// Get a pointer to the original window procedure
FOldClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
// Set ClientWndProc as the new window procedure
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FNewClientProc));
end;procedure TMainForm.DrawCentered;
{ This procedure centers the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
with imgMain do
BitBlt(FDrawDC, ((CR.Right - CR.Left) - Picture.Width) div 2,
((CR.Bottom - CR.Top) - Picture.Height) div 2,
Picture.Graphic.Width, Picture.Graphic.Height,
Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;procedure TMainForm.DrawStretched;
{ This procedure stretches the image on the form's client area }
var
CR: TRect;
begin
GetWindowRect(ClientHandle, CR);
StretchBlt(FDrawDC, 0, 0, CR.Right, CR.Bottom,
imgMain.Picture.Bitmap.Canvas.Handle, 0, 0,
imgMain.Picture.Width, imgMain.Picture.Height, SRCCOPY);
end;procedure TMainForm.DrawTiled;
{ This procedure tiles the image on the form's client area }
var
Row, Col: Integer;
CR, IR: TRect;
NumRows, NumCols: Integer;
begin
GetWindowRect(ClientHandle, CR);
IR := imgMain.ClientRect;
NumRows := CR.Bottom div IR.Bottom;
NumCols := CR.Right div IR.Right;
with imgMain do
for Row := 0 to NumRows+1 do
for Col := 0 to NumCols+1 do
BitBlt(FDrawDC, Col * Picture.Width, Row * Picture.Height,
Picture.Width, Picture.Height, Picture.Bitmap.Canvas.Handle,
0, 0, SRCCOPY);
end;procedure TMainForm.ClientWndProc(var Message: TMessage);
begin
case Message.Msg of
// Capture the WM_ERASEBKGND messages and perform the client area drawing
WM_ERASEBKGND:
begin
CallWindowProc(FOldClientProc, ClientHandle, Message.Msg, Message.wParam,
Message.lParam);
FDrawDC := TWMEraseBkGnd(Message).DC;
if mmiStretch.Checked then
DrawStretched
else if mmiCenter.Checked then
DrawCentered
else DrawTiled;
Message.Result := 1;
end;
{ Capture the scrolling messages and ensure the client area
is redrawn by calling InvalidateRect }
WM_VSCROLL, WM_HSCROLL:
begin
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
InvalidateRect(ClientHandle, nil, True);
end;
else
// By Default, call the original window procedure
Message.Result := CallWindowProc(FOldClientProc, ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
end; { case }
end;procedure TMainForm.CreateMDIChild(const Name: string);
var
MdiChild: TMDIChildForm;
begin
MdiChild := TMDIChildForm.Create(Application);
MdiChild.Caption := Name;
end;procedure TMainForm.mmiNewClick(Sender: TObject);
begin
CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;procedure TMainForm.mmiCloseClick(Sender: TObject);
begin
if ActiveMDIChild <> nil then
ActiveMDIChild.Close;
end;procedure TMainForm.mmiExitClick(Sender: TObject);
begin
Close;
end;procedure TMainForm.mmiTileClick(Sender: TObject);
begin
mmiTile.Checked := false;
mmiCenter.Checked := False;
mmiStretch.Checked := False;
{ Set the Checked property for the menu item which invoked }
{ this event handler to Checked }
if Sender is TMenuItem then
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
{ Redraw the client area of the form }
InvalidateRect(ClientHandle, nil, True);
end;end.
请讲一下如何使TTreeView实现这个功能
类的含义
父类的编号
0001
计算机
0002
无线电
… …
… …
… …
2)这种分类表结构的建立不用动态生成表结构,但使用时相对麻烦。我们采用以下的表结构建立信息分类关系。这样的结构可以实现任意级的树型结构,如M层的一个结构:其中M是本单位的分类最大深度。类号要唯一识别每一个类。最上一级的分类号为全宗号+本级的分类代号,其他任意级的类其类号都为上一级的分类号+本级的分类代号。用户根据本单位档案的信息分类情况输入类信息,由系统动态创建表。信息分类号
全宗号
类1含义
类2含义
类M含义
分类深度
0001
Zzb20
电子
计算机
2
0002
Zzb20
电子
无线电
2
0003
Zzb20
通信
卫星
0004
Zzb20
通信
遥感
C4
C6
C20
C20
C20
C1
XXFLH
QZH
L1
L2
LM
FLSD
在下面的例子中由于安全要求,对数据库表的结构作了简化,同时只使用了一些模拟数据以作说明。 2 树表外形设计 由于Delphi提供的树表控件比较简单,外观不很美观,因此需要作一些“修饰”工作。为了强调重点,忽略了数据库操作如查询等,在例程中只使用了有关树表控件。1)增加色彩一般的树表控件没有底图,没有色彩,因此首先要解决色彩问题。解决的方法就是在树表控伯的ONDraw事件响应中增加底图显示代码。procedure TForm1.Tree1CustomDraw(Sender: TCustomTreeView; const ARect: TRect; var DefaultDraw: Boolean);begin with tree1.Canvas do //取树表控件的显示底板 begin brush.color:=RGB(200,200,255); //设置画笔颜色 FillRect(ARect); //填充底板
end; end;这里仅为树表控件设置的底板颜色,实际上还可以设置底图,但由于底图的色彩不易控制,在调整树表结点时,容易出现颜色混乱的情况,而且只设置其颜色使树表控件的显示更加简洁。但只在ONDraw事件中设置颜色是不够的,还需要在其子项(结点)的显示事件中增加以下代码:procedure TForm1.Tree1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);var Noderect:TRect;begin with tree1.Canvas do begin case Node.Level of //根据不同的层次,设置不同的结点字体颜色 0: font.Color:=clBlue; … 5: font.Color:=clGreen; end; if node=tree1.Selected then //为突出选中的结点,将选中结点字体颜色设置为红色 font.Color:=clRed; NodeRect:=Node.DisplayRect(false); //设置结点的显示方式 brush.Color:=RGB(200,200,255); fillrect(NodeRect); //将结点的背景色与控件底板色设置为一致 end;end; 2)设置图标 图像列表控件与树表控件可以算是“老搭档”,即为了显示不同层次的结点就需要为树表控件设置一个对应的图像列表,其设置方法比较简单,可以参见有关的Delphi程序设计手册。由于树结构层次不定,因此不能象常规的方法那样建立了树表与图像列表之间的关系即大功告成,这里还需要做的是建立树表结点与图像列表的关系,可以通过以下两个函数实现。procedure TForm1.Tree1GetImageIndex(Sender: TObject; Node: TTreeNode);begin node.ImageIndex:=node.Level; //由结点的层次决定其对应图标在图像列表中的位置end; procedure TForm1.Tree1GetSelectedIndex(Sender: TObject; Node: TTreeNode);begin node.SelectedIndex:=node.ImageIndex;end; 3) 窗体激活事件响应响应窗体激活事件时,需要作一些设置。由于在原系统中,此窗体涉及的功能和控件较多,许多功能的完成都需要激活另外的窗体。因此需要避免对数据库信息的重复设置。可以如下实现:procedure TForm1.FormActivate(Sender: TObject);var i:integer;begin if first_in=false then //区别是否首次激活,从而决定是否需要设置初始状态 begin hint.Caption := ' 提示: 正在准备,请稍候...'; application.ProcessMessages ; tree1.Items.Clear; //设置第一个树表状态和颜色 tree1.Color:=RGB(200,200,255); tree2.Items.Clear; //设置第一个树表状态和颜色 tree2.Color:=RGB(100,200,255); qznode:=nil; //为了显示动态结构的分类层次,将各层树结点初始化为空 for i:=0 to 5 do last_node[i]:=nil; stackdepth:=0; //设置栈初始深度为0 show_tree1(0); //调用show_tree1显示分类内容,参数0表示从第一层开始显示 hint.Caption:=' 提示: 数据成功调入'; Application.ProcessMessages; end; first_in:=true; end; 4) 树表内容显示由于树表结点层次的不确定,我们采用了递归显示的方法完成树表内容的显示。这里设置了4个变量,其含义为;变量
类型
含义
可选范围
cur_cds
TQuery
当前的查询集
dbmd.qz,dbmd.fl1,dbmd.fl2,dbmd.fl3,dbmd.fl4,dbmd.fl5
cur_str
string
当前的查询语句
num_str
String
当前的层次数查询语句
cur_level
Integer
当前层次
cur_node
TTreeNode
当前结点
这里利用栈确定父结点与子结点的关系,若某结点对应的分类深度比当前深度要大,就需要将此结点入栈,并惟此结点为父结点,以插入孩子结点方式递归地显示它的下一层结点,若当前层的结点都已显示完毕,就需要退栈,回到上一层次再作计算。主要的实现过程如下:procedure TForm1.show_tree1(level:integer);… //变量声明begin case level of //根据输入参数,确定当前数据集、结点和查询语句 0: begin cur_cds:=dbmd.qz; cur_node:=qznode; cur_str:='select distinct QZH from XXFLB '; end; 1: begin cur_cds:=dbmd.fl1; cur_str:='select distinct L1 from XXFLB '; cur_str:=cur_str +' where QZH= '+''''+dbmd.qz.Fields.Fields[0].value+''''; end; … end; cur_cds.close; //实现查询 cur_cds.SQL.clear; cur_cds.SQL.Add(cur_str); cur_cds.open; for i:=1 to cur_cds.RecordCount do //遍历当前层的所有结点 begin if level=0 then //若为第一层则调用add方法创建结点 cur_node := tree1.Items.Add(cur_node,cur_cds.Fields.Fields[0].value) else //否则,在上一结点基础上调用AddChild方法创建其子结点 cur_node:=tree1.Items.AddChild(last_node[stackdepth-1],cur_cds.Fields.Fields[0].value); if level<5 then //根据当前结点层次及结点内容确定当前类的分类深度 begin case level of 0: begin num_str:='select FLSD from XXFLB '; num_str:=num_str +' where QZH= '+''''+dbmd.qz.Fields.Fields[0].value+''''; end; 1: … end; dbmd.sd.close; //执行深度查询 dbmd.sd.SQL.Clear; dbmd.sd.sql.add(num_str); dbmd.sd.Open; val(dbmd.sd.Fields.Fields[0].value,cur_level,code); //取其深度 if cur_level>level then //若当前层次未达到其分类深度 begin last_node[stackdepth]:=cur_node; //当前结点入栈 stackdepth:=stackdepth+1; show_tree1(level+1); //递归显示下一层次结点 end; end; cur_cds.Next; //取当前结果集中的下一条记录 if i > cur_cds.RecordCount -1 then //若当前层中全部记录显示完毕则退栈 stackdepth:=stackdepth-1; end;
end; 另外第二个树表的内容显示的基本方法与此类似,所不同的是第二个树表的显示函数所带的参数为串型参数,该参数有两种可能,即为‘’或由点击第一个树表的事件产生串参数。若参数为空串,则要在第二个树表中显示所有项目,否则要根据参数创建过滤条件选择显示项目。具体方法可以参见源代码。 5) 树表调整
树表的调整即是对树表当前结点的条件,可以由两种事件产生,即树结点的扩展和点击树结点。由于一个全宗号下的分类种类很多,层次也可能很大,因此用户希望打开一个类时,与其无关的类就关闭,这样就可以保证仅有目前所选择的结点,而不需要用户利用滚动条在打开的结点中寻找。其实现要充分利用树结点的方法和属性。特别强调的是在对点击树表结点的响应事件中用到了结点的扩展方法,尽管对结点扩展事件的响应函数所实现的功能与之类似,但一定不能加入类似的结点扩展方法,如tree1.Selected.Expand(false)等,因为在扩展事件中调用扩展方法会导致事件循环,甚至死机。 对第二个树表的调整与第一个树表的处理方式类似,但功能不同,这里不多介绍。procedure TForm1.Tree1Click(Sender: TObject);… //变量声明begin if Tree1.Selected=nil then //若未选择结点,重置 begin tree2.Items.Clear; tree2.Refresh; exit; end else begin tree2.Items.Clear; tree2.Refresh; str:=Tree1.Selected.Text; //取当前结点内容 fatherNode:=Tree1.Selected.Parent; //取当前结点父结点 tempnode:=Tree1.Selected; //设置当前结点 while fatherNode<>nil do //由当前层开始关闭所有非当前结点,//同时返回由其第一层祖先到当前结点所组成的串,作为第二个树表显示的参数。 begin str:=fatherNode.Text+','+str; //取父结点内容与当前结点内容联接 usenode:=fatherNode.getFirstChild; //遍历父结点的所有儿子结点 while usenode<>nil do begin if usenode<>tempnode then //只要不是当前结点,则取消扩展状态 usenode.Collapse(true); usenode:=fatherNode.GetNextChild(usenode); end; tempnode:=fathernode; //当前层结点处理完毕后,调整父结点为当前结点 fathernode:=tempnode.Parent; //再取当前结点的父结点 end; sibNode:=tree1.Items[0]; // 第一层结点的处理与其它层稍有差异 while sibNode<>nil do begin if sibNode<>tempNode then sibNode.Collapse(true); sibNode:=sibNode.getNextSibling; end; tree1.Selected.Collapse(true); //强制打开当前结点 tree1.Selected.Expand(false); if tree1.Selected.HasChildren=false then //若当前结点无孩子, begin show_tree2(str); //说明已构成一个完整的类,调用show_tree2函数实现第二个树表//的内容显示,参数str为完整的类名 hint.Caption:=' 提示: 数据成功调入'; Application.ProcessMessages; end; end; 参考文献1 徐新华,IDE和Object Pascal 语言,人民邮电出版社,1998.12 2 郑城荣,曾凡奎等,Delphi 运行时间库RTL和组件库VCL技术参考,人民邮电出版社,1999.1 1 徐新华,GUI编程技术,人民邮电出版社,1998.12