dbtree.pas

delphi编程控件

  ValCode: Integer;
  WasFiltered: Boolean;
begin
  if Assigned(FOnGetNextID) then
  begin
    Result := FOnGetNextID(self, DataSet);
    exit;
  end;
  Result := '0';
  with DataSet do
  begin
    Inc(FDisableCount);
    try
      DisableControls;
      WasFiltered := Filtered;
      try { search for the highest ID-Value first: }
        Filtered := false;
        if (DataSet is TTable) then
          with TTable(DataSet) do
          begin
            FIndexFields := IndexFieldNames;
            FIndexName := IndexName;
            IndexFieldNames := FTableIDField;
          end;
        if (FieldByName(FTableIDField).DataType = ftString) or
           not (DataSet is TTable) or
           (CompareText(Copy(TTable(DataSet).IndexFieldNames, 1,
                             Length(FTableIDField)),
                        FTableIDField) <> 0) then
        begin
        { Check EVERY record for the highest ID-Value: }
          IntValue := 0;
          First;
          while not EOF do
          begin
            try
              sID := FieldByName(FTableIDField).AsString;
              Val(sID, IntValue, ValCode);
              if (ValCode = 0) then
                Inc(IntValue);
            except
            end;
            if (IntValue > StrToInt(Result)) then
              Result := IntToStr(IntValue);
            Next;
          end;
        end
        else
        begin
          Last;
          if not BOF then
          try
            Result := IntToStr(FieldByName(FTableIDField).AsInteger + 1);
          except
          end;
        end;
      finally
        if DataSet is TTable then
          with TTable(DataSet) do
          begin
            if FIndexName <> '' then
              IndexName := FIndexName
            else
              IndexFieldNames := FIndexFields;
          end;
        Filtered := WasFiltered;
      end;
    finally
      EnableControls;
      Dec(FDisableCount);
    end;
  end;
end;

{$HINTS OFF}
procedure TCustomDBTreeView.Insert(AsChild: Boolean);
var
  NewID: string;
  FSelectedID: string;
  NewNode: TTreeNode;
  ParentNode: TTreeNode;
begin
  if (DataSet = nil) then
  begin
    inherited;
    exit;
  end;
  if (FDisableCount = 0) then
  begin
    FTreeViewLink.CheckRefresh;
    if (dtvsNeedReBuild in FState) then
      BuildTree;
  end;
  if not DataSet.CanModify then
    exit;
  Inc(FDisableCount);
  try
    FSelectedID := SelectedID;
    NewID := GetNewID;
    NewNode := nil;
    with DataSet do
    begin
      try
//      DisableControls;
        Append;
        FieldByName(FTableIDField).Value := NewID;
        if AsChild and (Selected <> nil) then
        begin
          if (FSelectedID <> '') and (NewID <> FSelectedID) then
            FieldByName(FTableParentField).Value := FSelectedID;
          NewNode := AddNewNodeFromDataset(Selected, true);
        end
        else
        begin
          if (Selected <> nil) then
          begin
            ParentNode := Selected.Parent;
            if (ParentNode <> nil) and (ParentNode is TTreeIDNode) and
               (TTreeIDNode(ParentNode).ID <> '') and
               (TTreeIDNode(ParentNode).ID <> NewID) then
              FieldByName(FTableParentField).Value := TTreeIDNode(ParentNode).ID;
          end;
          NewNode := AddNewNodeFromDataset(Selected, false);
        end;
        if (NewNode <> nil) then
        begin
          Selected := NewNode;
          if (dtAutoShowRoot in Options) and (Items.Count = 2) and
             IsRootNode(Selected) then
            ShowRoot := true;
        end;
      finally
//        EnableControls;
      end;
    end;
    if (NewNode <> nil) then
    begin
      if (dtFocusOnEdit in Options) then
        SetFocus;
      if Focused then
        NewNode.EditText;
    end;
  finally
    Dec(FDisableCount);
  end;
end;
{$HINTS ON}

function TCustomDBTreeView.GetDeleteQuestion(Node: TTreeNode): string;
begin
  if (Node <> nil) and (Pos('%s', sdbtvDefaultDeleteQuestion) > 0) then
    result := Format(sdbtvDefaultDeleteQuestion, [Node.Text])
  else
    result := sdbtvDefaultDeleteQuestion;
end;

function TCustomDBTreeView.DoDelete(Node: TTreeNode): Boolean;
begin
  if (DataSet = nil) then
  begin
    result := inherited DoDelete(Node);
    exit;
  end;
  if DataSetLocate(IDOfNode(Node)) then
  begin
    if not (DataSet.FieldByName(FTableIDField).Value = IDOfNode(Node)) then
    begin
    { should NEVER happen, but I want to make sure
      not to delete another record }
      result := false;
      exit;
    end;
    Inc(FDisableCount); { no BuildTree please ! }
    try
      if (DataSet.State = dsInsert) then
        DataSet.Cancel { cancel of insert works like deleting it }
      else
        DataSet.Delete;
    finally
      Dec(FDisableCount);
    end;
    result := inherited DoDelete(Node);
    if result and (dtAutoShowRoot in Options) then
      if (Items.Count = 0) then
        ShowRoot := false
      else
        ShowRoot := not IsSingleRootNode(Items[0]);
  end
  else
    result := false;
end;

procedure TCustomDBTreeView.Delete;
begin
  if (DataSet = nil) then
  begin
    inherited;
    exit;
  end;
  if (FDisableCount = 0) then
  begin
    FTreeViewLink.CheckRefresh;
    if (dtvsNeedReBuild in FState) then
      BuildTree;
  end;
  if DataSet.CanModify then
    inherited;
end;

procedure TCustomDBTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
  KillAllTimer;
  if (FDisableCount = 0) then
  begin
    FTreeViewLink.CheckRefresh;
    if (dtvsNeedReBuild in FState) and
       (not (dtvsBuilding in FState)) and
       (not IsEditing) and (FIDOfDeleted = '') then
      BuildTree;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TCustomDBTreeView.WMTimer(var Msg: TWMTimer);
begin
  if (Msg.TimerID = TimerIDRebuild) then
  begin
        if (FDisableCount = 0) and (not (dtvsBuilding in FState)) and
           (not IsEditing) and (FIDOfDeleted = '') and
           (dtvsNeedReBuild in FState) then
        begin
          KillTimer(Handle, TimerIDRebuild);
          FReBuildTimer := 0;
          BuildTree;
        end
        else
          if not (dtvsNeedReBuild in FState) then
          begin
            KillTimer(Handle, TimerIDRebuild);
            FReBuildTimer := 0;
          end;
  end
  else
    inherited;
end;

function TCustomDBTreeView.MoveNode(Source, Destination: TTreeNode;
  Mode: TNodeAttachMode): Boolean;
var
  DestinationID: string;
begin
  if (DataSet = nil) or not DataSet.Active then
  begin
    Result := inherited MoveNode(Source, Destination, Mode);
    exit;
  end;
  Result := false;
  if (Source = nil) then
    exit;
  with DataSet do
  begin
    Inc(FDisableCount);
    try
//    DisableControls;
      if DataSetLocate(IDOfNode(Source)) then
      begin
        Edit;
        try
          Result := inherited MoveNode(Source, Destination, Mode);
          if Result then
          begin
            if (SortType = stNone) then
            begin
              if (Destination <> nil) then
                Destination.AlphaSort
              else
                AlphaSort;
              Source.MakeVisible;
            end;
            if (Source.Parent = nil) then
              DestinationID := FRootID
            else
              DestinationID := IDOfNode(Source.Parent);
            if (DestinationID <> '') then
              DataSet.FieldByName(FTableParentField).Value := DestinationID
            else
              DataSet.FieldByName(FTableParentField).Clear;
            Post;
            if Assigned(FTVRecordList) then
              FTVRecordList.ChangeParent(IDOfNode(Source), DestinationID);
            if (dtAutoShowRoot in Options) then
              if (Items.Count = 0) then
                ShowRoot := false
              else
                ShowRoot := not IsSingleRootNode(Items[0]);
          end
          else
            Cancel;
        except
          if (State = dsEdit) then
            Cancel;
          raise;
        end;
      end;
    finally
//    EnableControls;
      Dec(FDisableCount);
    end;
  end;
end;

function TCustomDBTreeView.GetExpanded(Separator: Char): string;
var
  i: Integer;
  FirstItem: Boolean;
begin
  result := '';
  FirstItem := true;
  for i := 0 to Items.Count - 1 do
  begin
    with Items[i] do
      if Expanded and (Count > 0) then
        if FirstItem then
        begin
          FirstItem := false;
          result := IDOfNode(Items[i]);
        end
        else
          result := result + Separator + IDOfNode(Items[i]);
  end;
end;

procedure TCustomDBTreeView.SetExpanded(const List: string; Separator: Char);
var
  i: Integer;
  xList: string;
  Node: TTreeNode;
begin
  Items.BeginUpdate; { changes are not visible until EndUpdate }
  Node := TopItem;
  xList := Separator + List + Separator;
  for i := 0 to Items.Count - 1 do
    Items[i].Expanded :=
      (Pos(Separator + IDs[i] + Separator, xList) > 0);
  if (Node <> nil) then
    TopItem := Node;
  Node := Selected;
  if (Node <> nil) then
    Node.MakeVisible;
  Items.EndUpdate;
end;

procedure TCustomDBTreeView.WMSetFocus(var Message: TMessage);
begin
{ We just received the focus. If the dateaset is in edit- or insert-mode
  and dtFocusOnEdit is in Options, we have to set the selected node into
  the edit-mode. }
  inherited;
  if (FDisableCount = 0) then
  begin
    FTreeViewLink.CheckRefresh;
    if (dtvsNeedReBuild in FState) then
      BuildTree;
    if ((dtFocusOnEdit in Options) or
        (dtvsLostFocusWhileDatasetInEditModes in FState)) and
       not IsEditing then
    begin
      Exclude(FState, dtvsLostFocusWhileDatasetInEditModes);
      if (DataSet <> nil) then
        with DataSet do
          if (State = dsEdit) or (State = dsInsert) then
          begin
            if not (dtSynchronizeDataSet in Options) then
              SynchronizeSelectedNodeToCurrentRecord;
            if (Selected <> nil) then
              Selected.EditText;
          end;
    end;
  end;
end;

procedure TCustomDBTreeView.RebuildTree;
begin
  Include(FState, dtvsNeedReBuild);
  BuildTree;
end;

function TCustomDBTreeView.FindTextID(const S: string; var ID: string;
  TVFindTextOptions: TTVFindTextOptions): Boolean;
begin
  if Assigned(FTVRecordList) then
    result := FTVRecordList.FindTextID(
      S, ID, TInternalTVFindTextOptions(TVFindTextOptions))
  else
    result := false;
end;

function TCustomDBTreeView.TextIDList(const S: string;
  TVFindTextOptions: TTVFindTextOptions): TStringList;
begin
  if Assigned(FTVRecordList) then
    result := FTVRecordList.TextIDList(
      S, TInternalTVFindTextOptions(TVFindTextOptions))
  else
    result := nil;
end;

function TCustomDBTreeView.IDOfNode(Node: TTreeNode): string;
begin
  if (Node = nil) then
    result := ''
  else
    if Node is TTreeIDNode then
      result := TTreeIDNode(Node).ID
    else
      result := '';
end;

function TCustomDBTreeView.CreateNode: TTreeNode;
begin
  Result := TTreeIDNode.Create(Items);
end;

procedure TCustomDBTreeView.DestroyWnd;
var
  i: Integer;
begin
  if Items.Count > 0 then
  begin
    FSaveIDList := TStringList.Create;
    for i := 0 to Items.Count - 1 do
      FSaveIDList.Add(IDOfNode(Items[i]));
  end;
  inherited DestroyWnd;
end;

procedure TCustomDBTreeView.CreateWnd;
var
  i: Integer;
begin
  inherited CreateWnd;
  if (FSaveIDList <> nil) then
  begin
    if (FSaveIDLis