300分请求解这个简单问题。 (300分)

300分请求解这个简单问题。
怎么把这个表里面的数据在FORM的Canvas上画出下面的树结构图来？
树中的名称放到一个矩形框中，文本文件中不方便画我就没画出来。

大侠帮忙，不胜感谢！！！！

表结构是这样的：

表名：tData

字段描述： 上级编号 上级名称 编号 名称
字段名称： c001 c002 c003 c004

数据： 01 广东
01 广东 0101 深圳
01 广东 0102 广州
01 广东 0103 珠海
01 广东 0104 中山
02 上海
03 江苏
03 江苏 0301 苏州
03 江苏 0302 无锡
0301 苏州 030101 昆山

注意：上级编号比下级编号多两位。

最终要生成这样一张图：

中国(该标题固定)
│
-----------------------------╋-------------------------------
│ │ │
广东 上海 江苏
│ │
------------------------- -----------------
│ │ │ │ │ │
深圳 广州 珠海 中山 苏州 无锡
│
昆山

附：创建上表的脚本

if exists ( select 1
from sysobjects
where id = object_id('tData')
and objectproperty(id,'isTable') =1)
drop table tData
go

create table tData
(
c001 varchar(30) null,
c002 varchar(30) null,
c003 varchar(30) not null,
c004 varchar(30) not null,
constraint PK_tData primary key clustered(c003)
)
go

insert into tData(c001,c002,c003,c004) values (null,null,'01','广东')
insert into tData(c001,c002,c003,c004) values (null,null,'02','上海')
insert into tData(c001,c002,c003,c004) values (null,null,'03','江苏')
insert into tData(c001,c002,c003,c004) values ('01','广东','0101','深圳')
insert into tData(c001,c002,c003,c004) values ('01','广东','0102','广州')
insert into tData(c001,c002,c003,c004) values ('01','广东','0103','珠海')
insert into tData(c001,c002,c003,c004) values ('01','广东','0104','中山')
insert into tData(c001,c002,c003,c004) values ('03','江苏','0301','苏州')
insert into tData(c001,c002,c003,c004) values ('03','江苏','0302','无锡')
insert into tData(c001,c002,c003,c004) values ('0301','苏州','030101','昆山')

很繁琐，但可以。
另外，个人认为，动态创建TLabel和TShape并放置在Form上可能更科学一些。

说出来嘛！

由于宽度不好把握,难办,如果是TreeView倒是很好办!

是啊，并且他们的下级有多少个具体不知道。
我的思路是打算用一个递归，
每次设置当前层的时候，把上面所有层的位置重新设置一下。

TTreeview可以显示成这种效果吗？
有的话请告诉我怎么实现？谢谢

TTreeView可以实现你的要求

你用Excel将上面的图重画一下，可能会有一点启发

TreeView可以

我的想法：一般这种操作你先把这些数据组织到自己的数据结构中，这样的话速度会比较
快。对于在界面上的各种操作也比较容易。对于你的问题核心在横向每个结点占多宽，如果
按我的方法很容易求出来。

为什么不用TTreeView

画树部分请参看本例:
unit WizardTree;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
const
DefaultHorizontalSpace = 4;
DefaultVerticalSpace = 8;
DefaultBoxHeight = 17;
DefaultBoxWidth = 16;
DefaultBoxColor = clGray;
DefaultSelectedBoxColor = clLime;
DefaultLineColor = clWhite;
DefaultFontColor = clWhite;
DefaultColor = clBlack;
DefaultTopMargin = 4;
DefaultLeftMargin = 4;
DefaultHeight = 140;
DefaultWidth = 133;
VersionString = '1.0';
type
TOnChanging = procedure(Sender: TObject; NewItemIndex: Integer; var AllowChange: Boolean) of
object;
TOnChange = procedure(Sender: TObject) of object;
TWizardTree = class(TPanel)
private
FItems: TStrings;
procedure SetItems(NewItems: TStrings);
private
FItemIndex: Integer;
procedure SetItemIndex(Value: Integer);
private
FLineColor: TColor;
FSelectedBoxColor: TColor;
FBoxColor: TColor;
FBoxHeight: Integer;
FBoxWidth: Integer;
FHorizontalSpace: Integer;
FVerticalSpace: Integer;
FTopMargin: Integer;
FLeftMargin: Integer;
FVersion: string;
procedure SetLineColor(Value: TColor);
procedure SetSelectedBoxColor(Value: TColor);
procedure SetBoxColor(Value: TColor);
procedure SetBoxHeight(Value: Integer);
procedure SetBoxWidth(Value: Integer);
procedure SetHorizontalSpace(Value: Integer);
procedure SetVerticalSpace(Value: Integer);
procedure SetLeftMargin(Value: Integer);
procedure SetTopMargin(Value: Integer);
procedure SetVersion(Value: string);
private
FOnChanging: TOnChanging;
FOnChange: TOnChange;
private
FRects: TList;
procedure AllocateRects;
procedure FillBox(Index: Integer; Live: Boolean);
protected
procedure Paint; override;
procedure Click; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Items: TStrings read FItems write SetItems;
property ItemIndex: Integer read FItemIndex write SetItemIndex;
property LineColor: TColor read FLineColor write SetLineColor;
property SelectedBoxColor: TColor read FSelectedBoxColor write SetSelectedBoxColor;
property BoxColor: TColor read FBoxColor write SetBoxColor;
property HorizontalSpace: Integer read FHorizontalSpace write SetHorizontalSpace;
property VerticalSpace: Integer read FVerticalSpace write SetVerticalSpace;
property BoxHeight: Integer read FBoxHeight write SetBoxHeight;
property BoxWidth: Integer read FBoxWidth write SetBoxWidth;
property LeftMargin: Integer read FLeftMargin write SetLeftMargin;
property TopMargin: Integer read FTopMargin write SetTopMargin;
property OnChanging: TOnChanging read FOnChanging write FOnChanging;
property OnChange: TOnChange read FOnChange write FOnChange;
property Version: string read FVersion write SetVersion stored False;
end;
procedure Register;
implementation

constructor TWizardTree.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TStringList.Create;
FRects := TList.Create;
Caption := '';
BevelOuter := bvNone;
FItemIndex := 0;
HorizontalSpace := DefaultHorizontalSpace;
VerticalSpace := DefaultVerticalSpace;
BoxHeight := DefaultBoxHeight;
BoxWidth := DefaultBoxWidth;
BoxColor := DefaultBoxColor;
SelectedBoxColor := DefaultSelectedBoxColor;
LineColor := DefaultLineColor;
Font.Color := DefaultFontColor;
Color := DefaultColor;
Width := DefaultWidth;
Height := DefaultHeight;
FTopMargin := DefaultTopMargin;
FLeftMargin := DefaultLeftMargin;
FVersion := VersionString;
FItems.Add('Start');
FItems.Add('First Page');
FItems.Add('Second Page');
FItems.Add('Finish');
end;

destructor TWizardTree.Destroy;
begin
FItems.Clear;
AllocateRects;
FItems.Free;
FRects.Free;
inherited Destroy;
end;

procedure TWizardTree.SetItems(NewItems: TStrings);
begin
FItems.Assign(NewItems);
Refresh;
end;

procedure TWizardTree.SetItemIndex(Value: Integer);
begin
if (Value >= -1) and (Value < FItems.Count) then
if (Value <> FItemIndex) then
begin
FItemIndex := Value;
Refresh;
end;
end;

procedure TWizardTree.AllocateRects;
var
Index: Integer;
P: Pointer;
begin
if FRects.Count < FItems.Count then
for Index := FRects.Count to Pred(FItems.Count) do
begin
GetMem(P, SizeOf(TRect));
FRects.Add(P);
end
else if FRects.Count > FItems.Count then
for Index := Pred(FRects.Count) downto FItems.Count do
begin
FreeMem(FRects[Index]);
FRects.Delete(Index);
end;
end;

procedure TWizardTree.Paint;
var
Index: Integer;
X, Y: Integer;
begin
AllocateRects;
Canvas.Brush.Color := Color;
Canvas.FillRect(Rect(0, 0, Width, Height));
Y := TopMargin + VerticalSpace;
for Index := 0 to Pred(FItems.Count) do
begin
if (Index > 0) and (Index < Pred(FItems.Count)) then
X := LeftMargin + HorizontalSpace + BoxWidth + HorizontalSpace
else
X := LeftMargin + HorizontalSpace;
TRect(FRects[Index]^) := Rect(X, Y,
X + BoxWidth + HorizontalSpace + Canvas.TextWidth(FItems[Index]), Y + BoxHeight);
FillBox(Index, ItemIndex = Index);
Inc(Y, BoxHeight + VerticalSpace * 2);
Canvas.Pen.Color := LineColor;
if (Index = 0) then
begin
Canvas.MoveTo(X + BoxWidth, Y - VerticalSpace - BoxHeight);
Canvas.LineTo(X + HorizontalSpace + BoxWidth + BoxWidth div 2, Y - VerticalSpace -
BoxHeight);
Canvas.LineTo(X + HorizontalSpace + BoxWidth + BoxWidth div 2, Y + VerticalSpace);
end
else if (Index = Pred(FItems.Count) - 1) then
begin
Canvas.MoveTo(X + BoxWidth div 2, Y - VerticalSpace * 2);
Canvas.LineTo(X + BoxWidth div 2, Y + VerticalSpace);
Canvas.LineTo(X - BoxWidth - 1, Y + VerticalSpace);
end
else if (Index < Pred(FItems.Count)) then
begin
Canvas.MoveTo(X + BoxWidth div 2, Y - VerticalSpace * 2);
Canvas.LineTo(X + BoxWidth div 2, Y);
end;
end;
X := LeftMargin + HorizontalSpace + (BoxWidth div 2);
Y := TopMargin + VerticalSpace + BoxHeight;
Canvas.MoveTo(X, Y);
Inc(Y, VerticalSpace * 4 + (BoxHeight * (FItems.Count - 2)) + ((VerticalSpace * 2) * (FItems.Count
- 3)));
Canvas.Pen.Color := LineColor;
Canvas.LineTo(X, Y);
end;

procedure TWizardTree.Click;
var
Index: Integer;
P: TPoint;
AllowChange: Boolean;
begin
inherited;
GetCursorPos(P);
P := ScreenToClient(P);
for Index := 0 to Pred(FRects.Count) do
begin
if PtInRect(TRect(FRects[Index]^), P) then
begin
if ItemIndex <> Index then
begin
AllowChange := True;
if Assigned(FOnChanging) then
FOnChanging(Self, Index, AllowChange);
if AllowChange then
begin
FillBox(ItemIndex, False);
FillBox(Index, True);
ItemIndex := Index;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
Break;
end;
end;
end;

procedure TWizardTree.FillBox(Index: Integer; Live: Boolean);
var
BoxRect: TRect;
TextRect: TRect;
begin
if (Index < 0) or (Index >= FItems.Count) then
Exit;
Canvas.Brush.Style := bsSolid;
if Live then
Canvas.Brush.Color := SelectedBoxColor
else
Canvas.Brush.Color := BoxColor;
BoxRect := TRect(FRects[Index]^);
TextRect := BoxRect;
BoxRect.Right := BoxRect.Left + BoxWidth;
TextRect.Left := BoxRect.Right + HorizontalSpace;
if (Index = 0) or (Index = Pred(FItems.Count)) then
Inc(TextRect.Left, HorizontalSpace + BoxWidth div 2);
Canvas.FillRect(BoxRect);
Canvas.Font := Font;
if Live then
Canvas.Font.Style := Canvas.Font.Style + [fsBold];
Canvas.Brush.Color := Color;
Canvas.FillRect(TextRect);
Canvas.Brush.Style := bsClear;
Canvas.TextOut(TextRect.Left,
TextRect.Top + ((BoxHeight - Canvas.TextHeight(FItems[Index])) div 2), FItems[Index]);
TRect(FRects[Index]^) := Rect(BoxRect.Left, BoxRect.Top,
BoxRect.Left + BoxWidth + HorizontalSpace + Canvas.TextWidth(FItems[Index]), BoxRect.Top +
BoxHeight);
end;

procedure TWizardTree.SetLineColor(Value: TColor);
begin
if FLineColor <> Value then
begin
FLineColor := Value;
Refresh;
end;
end;

procedure TWizardTree.SetSelectedBoxColor(Value: TColor);
begin
if FSelectedBoxColor <> Value then
begin
FSelectedBoxColor := Value;
Refresh;
end;
end;

procedure TWizardTree.SetBoxColor(Value: TColor);
begin
if FBoxColor <> Value then
begin
FBoxColor := Value;
Refresh;
end;
end;

procedure TWizardTree.SetBoxHeight(Value: Integer);
begin
if FBoxHeight <> Value then
begin
FBoxHeight := Value;
Refresh;
end;
end;

procedure TWizardTree.SetBoxWidth(Value: Integer);
begin
if FBoxWidth <> Value then
begin
FBoxWidth := Value;
Refresh;
end;
end;

procedure TWizardTree.SetHorizontalSpace(Value: Integer);
begin
if FHorizontalSpace <> Value then
begin
FHorizontalSpace := Value;
Refresh;
end;
end;

procedure TWizardTree.SetVerticalSpace(Value: Integer);
begin
if FVerticalSpace <> Value then
begin
FVerticalSpace := Value;
Refresh;
end;
end;

procedure TWizardTree.SetTopmargin(Value: Integer);
begin
if Value <> FTopMargin then
begin
FTopMargin := Value;
Refresh;
end;
end;

procedure TWizardTree.SetLeftMargin(Value: Integer);
begin
if Value <> FLeftMargin then
begin
FLeftMargin := Value;
Refresh;
end;
end;

procedure TWizardTree.SetVersion(Value: string);
begin
end;

procedure Register;
begin
RegisterComponents('My VCL', [TWizardTree]);
end;
end.

关注

TO ： 小雨哥
能不能实现问题中那种方向的树？

TO ： LiGen, 张无忌, zhumoo
用Treeview怎么实现，请指点一下。

用TeeTree

用memo定位输出文字，就可以实现上面的效果。

TO：mlzhou
大虾，能不能写出代码来，多谢！

系统正在检查数据
请稍后。。。。。。。。

别乱贴呀