dbtree.pas

delphi编程控件

const
  Full = true;
  TimerIDRebuild = 1002;
  RebuildTickCount = 500;


{ TTreeIDNode --------------------------------------------------------------- }

constructor TTreeIDNode.Create(AOwner: TTreeNodes);
begin
  inherited Create(AOwner);
  FID := '';
end;

procedure TTreeIDNode.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if (Source <> nil) and (Source is TTreeIDNode) then
    FID := TTreeIDNode(Source).ID
  else
    FID := '';
end;


{ TTreeViewLink ------------------------------------------------------------- }

constructor TTreeViewLink.Create(ATreeView: TCustomDBTreeView);
begin
  inherited Create;
  FTreeView := ATreeView;
end;

procedure TTreeViewLink.DatasetRefreshed;
begin
  if Assigned(FTreeView) then
    FTreeView.DatasetRefreshed;
end;

procedure TTreeViewLink.ActiveChanged;
begin
  inherited;
  FTreeView.ActiveChanged(Active);
end;

procedure TTreeViewLink.DataSetChanged;
begin
  if not CanCheckRefresh then { we don't know if a refresh happend: }
    Include(FTreeView.FState, dtvsNeedReBuild);
  FTreeView.DataChanged;
end;

procedure TTreeViewLink.DataSetScrolled(Distance: Integer);
begin
  FTreeView.RecordNumberChanged;
end;

procedure TTreeViewLink.RecordChanged(Field: TField);
begin
  FTreeView.RecordChanged(Field);
end;

procedure TTreeViewLink.EditingChanged;
begin
  FTreeView.EditingChanged;
end;

procedure TTreeViewLink.DoBeforePost(DataSet: TDataSet);
begin
  inherited;
  FTreeView.DataSetBeforePost;
end;

procedure TTreeViewLink.DoAfterCancel(DataSet: TDataSet);
begin
  inherited;
  FTreeView.DataSetAfterCancel;
end;

procedure TTreeViewLink.DoBeforeDelete(DataSet: TDataSet);
begin
  inherited;
  FTreeView.DataSetBeforeDelete;
end;

procedure TTreeViewLink.DoAfterDelete(DataSet: TDataSet);
begin
  inherited;
  FTreeView.DataSetAfterDelete;
end;

procedure TTreeViewLink.DoAfterPost(DataSet: TDataSet);
begin
  inherited;
  FTreeView.DataSetAfterPost;
end;

procedure TTreeViewLink.DoBeforeEdit(DataSet: TDataSet);
begin
  inherited;
  FTreeView.BuildTreeIfNeeded;
end;

procedure TTreeViewLink.DoBeforeInsert(DataSet: TDataSet);
begin
  inherited;
  FTreeView.BuildTreeIfNeeded;
end;

(*
procedure TTreeViewLink.DoBeforeCancel(DataSet: TDataSet);
begin
  inherited;
end;

procedure TTreeViewLink.DoAfterEdit(DataSet: TDataSet);
begin
  inherited;
end;

procedure TTreeViewLink.DoAfterInsert(DataSet: TDataSet);
begin
  inherited;
end;
*)

{ TCustomDBTreeView --------------------------------------------------------- }

constructor TCustomDBTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTreeViewLink := TTreeViewLink.Create(Self);
  FPrevState := dsInactive;
  FState := [];
  FRootID := '';
  FIDOfDeleted := '';
  FTVRecordList := nil;
  FReBuildTimer := 0;
  FUserOnEdited := nil;
  FOnClosedLoop := nil;
  FOnRootNotFound := nil;
  FOnGetNextID := nil;
  FSaveIDList := nil;
  Options := [dtAllowDelete, dtAllowInsert, dtAutoDragMove, dtAutoExpand,
              dtAutoShowRoot, dtRootItemReadOnly, dtConfirmDelete,
              dtCancelOnExit, dtSynchronizeDataSet];
end;

destructor TCustomDBTreeView.Destroy;
begin
  FTreeViewLink.Free;
  FTreeViewLink := nil;
  if Assigned(FTVRecordList) then
    FTVRecordList.Free;
  if Assigned(FSaveIDList) then
    FSaveIDList.Free;
  inherited Destroy;
end;

procedure TCustomDBTreeView.KillAllTimer;
begin
  inherited;
  if (FReBuildTimer <> 0) then
    KillTimer(Handle, TimerIDRebuild);
  FReBuildTimer := 0;
end;

function TCustomDBTreeView.GetDataSource: TDataSource;
begin
  Result := FTreeViewLink.DataSource;
end;

procedure TCustomDBTreeView.SetDataSource(ADataSource: TDataSource);
begin
  if (FTreeViewLink.DataSource <> ADataSource) then
  begin
    FTreeViewLink.DataSource := ADataSource;
  { BuildTree will be done at ActiveChanged }
  end;
end;

procedure TCustomDBTreeView.SetTableIDField(const Value: string);
begin
  if (FTableIDField <> Value) then
  begin
    FTableIDField := Value;
    BuildTree;
  end;
end;

procedure TCustomDBTreeView.SetTableParentField(const Value: string);
begin
  if (FTableParentField <> Value) then
  begin
    FTableParentField := Value;
    BuildTree;
  end;
end;

procedure TCustomDBTreeView.SetTableTextField(const Value: string);
begin
  if (FTableTextField <> Value) then
  begin
    FTableTextField := Value;
    BuildTree;
  end;
end;

function  TCustomDBTreeView.GetDataSet: TDataSet;
begin
  Result := FTreeViewLink.DataSet;
end;

procedure TCustomDBTreeView.Notification(
  AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FTreeViewLink <> nil) and
     (AComponent = DataSource) then
  begin
    KillAllTimer;
    DataSource := nil;
    Items.Clear;
    FRSelected := nil;
    if Assigned(FSaveIDList) then
    begin
      FSaveIDList.Free;
      FSaveIDList := nil;
    end;
  end;
end;

procedure TCustomDBTreeView.ActiveChanged(Value: Boolean);
begin
  if not Value then
  begin
    KillAllTimer;
    Items.Clear;
    FRSelected := nil;
    FPrevState := dsInactive;
    FState := [];
    if Assigned(FTVRecordList) then
    begin
      FTVRecordList.Free;
      FTVRecordList := nil;
    end;
    if Assigned(FSaveIDList) then
    begin
      FSaveIDList.Free;
      FSaveIDList := nil;
    end;
  end
  else
  begin
    FPrevState := DataSet.State;
    BuildTree;
  end;
end;

function TCustomDBTreeView.CreateTVRecordList: TTVRecordList;
var
  TVRecordList: TTVRecordList;
  aBookmark: TBookmark;
  IndexIDField: Integer;
  IndexParentField: Integer;
  IndexTextField: Integer;
begin
  TVRecordList := TTVRecordList.Create;
  aBookmark := nil;
  with DataSet do
  try
    aBookmark := GetBookmark;
    try
      if (FTableParentField = '') then
      begin
        IndexIDField := FieldByName(FTableIDField).Index;
        IndexTextField := FieldByName(FTableTextField).Index;
        First;
        while not EOF do
        begin
          TVRecordList.AddRecord(Fields[IndexIDField].AsString,
                                 '',
                                 Fields[IndexTextField].AsString);
          Next;
        end;
      end
      else
      begin
        IndexIDField := FieldByName(FTableIDField).Index;
        IndexParentField := FieldByName(FTableParentField).Index;
        IndexTextField := FieldByName(FTableTextField).Index;
        First;
        while not EOF do
        begin
          TVRecordList.AddRecord(Fields[IndexIDField].AsString,
                                 Fields[IndexParentField].AsString,
                                 Fields[IndexTextField].AsString);
          Next;
        end;
      end;
      TVRecordList.Sorted := true;
    except
      TVRecordList.Free;
      TVRecordList := nil;
      raise;
    end;
  finally
    if (aBookmark <> nil) then
    begin
      GotoBookmark(aBookmark);
      FreeBookmark(aBookmark);
    end;
  end;
  result := TVRecordList;
end;

procedure TCustomDBTreeView.BuildTree;
var
  TopItemID: string;
  SelectedItemID: string;
  Node: TTreeNode;
  PreviousSortType: TSortType;
  NewTVRecordList: TTVRecordList;

procedure StoreExpanded;
var
  i: Integer;
  IDIndex: Integer;
  DefaultExpand: Boolean;
begin
  if (FTVRecordList = nil) then
    exit;
  DefaultExpand := (dtAutoExpand in Options);
  for i := 0 to FTVRecordList.Count - 1 do
    TTvRecordInfo(FTVRecordList[i]).WasExpanded := DefaultExpand;
{ Store all Items[].Expanded to restore it after rebuild: }
  if (Items.Count > 1) then
  begin
    for i := 0 to Items.Count - 1 do
    begin
      with TTreeIDNode(Items[i]) do
        if (Count > 0) then
          if FTVRecordList.FindID(ID, IDIndex) then
            TTvRecordInfo(FTVRecordList[IDIndex]).WasExpanded := Expanded;
    end;
  end;
end; { StoreExpanded }

procedure ReStoreExpanded;
var
  i: Integer;
  IDIndex: Integer;
  DefaultExpand: Boolean;
begin
  DefaultExpand := (dtAutoExpand in Options);
  if (FTVRecordList <> nil) then
  begin
  { Expand previous expanded items: }
    for i := Items.Count - 1 downto 0 do
    begin
      if (Items[i].Count > 0) then
      begin
        if FTVRecordList.FindID(IDOfNode(Items[i]), IDIndex) then
          Items[i].Expanded := TTvRecordInfo(FTVRecordList[IDIndex]).WasExpanded
        else
          Items[i].Expanded := DefaultExpand;
      end;
    end;
  end
  else
    if DefaultExpand then
      FullExpand;
end; { ReStoreExpanded }

procedure DoCreateTree;
var
  i: Integer;
  ParentIndex: Integer;
  IDIndex: Integer;
  RootCount: Integer;
begin
  if (FTableParentField = '') then
  begin
    for i := 0 to NewTVRecordList.Count - 1 do
    begin
      with TTvRecordInfo(NewTVRecordList[i]) do
      begin
        Node := Items.Add(nil, Text);
        TTreeIDNode(Node).ID := ID;
      end;
    end;
    exit;
  end;
{ find root and call CreateTree: }
  Node := nil;
  if (FRootID <> '') then
  begin
    if NewTVRecordList.FindID(FRootID, IDIndex) then
    begin
      with TTvRecordInfo(NewTVRecordList[IDIndex]) do
      begin
      { Record with the ID = RootID found, add it first: }
        Node := Items.Add(nil, Text);
        TTreeIDNode(Node).ID := FRootID;
      end;
      CreateTree(Node, FRootID, NewTVRecordList);
      if (dtAutoShowRoot in Options) then
        ShowRoot := false;
    end;
    if (Node = nil) and (NewTVRecordList.Count > 0) then
    begin
    { No record with the ID = RootID found, but dataset is not empty: }
      RootNotFound;
      if NewTVRecordList.FindParent(FRootID, ParentIndex) then
      begin
      { At least one record with Parent = RootID found: }
        if (dtAutoShowRoot in Options) then
        { ShowRoot if more then one record with Parent = RootID exists: }
          ShowRoot :=
            (ParentIndex + 1 < NewTVRecordList.Count) and
            (NewTVRecordList.Parent[ParentIndex + 1].Parent = FRootID);
        CreateTree(nil, FRootID, NewTVRecordList);
      end;
    end;
  end
  else
  begin
  { FRootID = '': }
    RootCount := 0;
    for i := 0 to NewTVRecordList.Count - 1 do
    begin
      with TTvRecordInfo(NewTVRecordList[i]) do
        if not NewTVRecordList.FindID(Parent, IDIndex) then
        begin
        { Record without parent found: }
          Inc(RootCount);
          Node := Items.Add(nil, Text);
          TTreeIDNode(Node).ID := ID;
          CreateTree(Node, ID, NewTVRecordList);
        end;
    end;
    if (dtAutoShowRoot in Options) then
      ShowRoot := (RootCount > 1); { ShowRoot if more then one root }
  end;
end; { DoCreateTree }