jvdbtreeview.pas

East make Tray Icon in delphi

procedure TJvCustomDBTreeView.SetItemField(Value: string);
begin
  if ValidField(Value, DefaultValidItemFields) then
  begin
    FItemField := Value;
    RefreshChild(nil);
  end
  else
    Warning(RsItemFieldError);
end;

procedure TJvCustomDBTreeView.SetIconField(Value: string);
begin
  if ValidField(Value, DefaultValidIconFields) then
  begin
    FIconField := Value;
    RefreshChild(nil);
  end
  else
    Warning(RsIconFieldError);
end;

function TJvCustomDBTreeView.GetStartMasterValue: string;
begin
  if FStartMasterValue = Null then
    Result := ''
  else
    Result := FStartMasterValue;
end;

procedure TJvCustomDBTreeView.SetStartMasterValue(Value: string);
begin
  if Length(Value) > 0 then
    FStartMasterValue := Value
  else
    FStartMasterValue := Null;
end;

function TJvCustomDBTreeView.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TJvCustomDBTreeView.SetDataSource(Value: TDataSource);
begin
  if Value = FDataLink.DataSource then
    Exit;
  Items.Clear;
  FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TJvCustomDBTreeView.CMGetDataLink(var Msg: TMessage);
begin
  Msg.Result := Integer(FDataLink);
end;

procedure TJvCustomDBTreeView.Notification(Component: TComponent; Operation: TOperation);
begin
  inherited Notification(Component, Operation);
  if (FDataLink <> nil) and (Component = DataSource) and (Operation = opRemove) then
    DataSource := nil;
end;

function TJvCustomDBTreeView.CreateNode: TTreeNode;
begin
  Result := TJvDBTreeNode.Create(Items);
end;

procedure TJvCustomDBTreeView.HideEditor;
begin
  if Selected <> nil then
    Selected.EndEdit(True);
end;

function TJvCustomDBTreeView.ValidDataSet: Boolean;
begin
  Result := FDataLink.Active and Assigned(FDataLink.DataSet) and FDataLink.DataSet.Active;
end;

procedure TJvCustomDBTreeView.LinkActive(Value: Boolean);

  function AllFieldsValid: Boolean;
  begin
    Result := False;
    if ValidDataSet then
    begin
      if (FMasterField = '') or (FDataLink.DataSet.FindField(FMasterField) = nil) then
      begin
        Warning(RsMasterFieldEmpty);
        Exit;
      end;
      if (FDetailField = '') or (FDataLink.DataSet.FindField(FDetailField) = nil) then
      begin
        Warning(RsDetailFieldEmpty);
        Exit;
      end;
      if (FItemField = '') or (FDataLink.DataSet.FindField(FItemField) = nil) then
      begin
        Warning(RsItemFieldEmpty);
        Exit;
      end;
     { if (FDataLink.DataSet.FindField(FMasterField).DataType <> FDataLink.DataSet.FindField(FDetailField).DataType) then
       begin
        Warning(RsMasterDetailFieldError);
        Exit;
      end; }
      if (FDataLink.DataSet.FindField(FItemField).DataType in
        [ftBytes, ftVarBytes, ftBlob, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary]) then
      begin
        Warning(RsItemFieldError);
        Exit;
      end;
      if (FIconField <> '') and not (FDataLink.DataSet.FindField(FIconField).DataType in
        [ftSmallInt, ftInteger, ftWord]) then
      begin
        Warning(RsIconFieldError);
        Exit;
      end;
    end;
    Result := True;
  end;
begin
  if not Value then
    HideEditor;
  if not AllFieldsValid then
    Exit;
  //if ( csDesigning in ComponentState ) then Exit;
  if ValidDataSet then
  begin
    RefreshChild(nil);
    OldRecCount := FDataLink.DataSet.RecordCount;
  end
  else
    if FUpdateLock = 0 then
      Items.Clear;
end;

procedure TJvCustomDBTreeView.UpdateLock;
begin
  Inc(FUpdateLock);
end;

procedure TJvCustomDBTreeView.UpdateUnLock(const AUpdateTree: Boolean);
begin
  if FUpdateLock > 0 then
    Dec(FUpdateLock);
  if (FUpdateLock = 0) then
    if AUpdateTree then
      UpdateTree
    else
      OldRecCount := FDataLink.DataSet.RecordCount;
end;

function TJvCustomDBTreeView.UpdateLocked: Boolean;
begin
  Result := FUpdateLock > 0;
end;

procedure TJvCustomDBTreeView.RefreshChild(ANode: TJvDBTreeNode);
var
  ParentValue: Variant;
  BK: TBookmark;
  OldFilter: string;
  OldFiltered: Boolean;
  PV: string;
  // I: Integer;

  cNode: TTreeNode;
  fbnString: string;
begin
//  CheckDataSet;
  if not ValidDataSet or UpdateLocked then
    Exit;
  Inc(FUpdateLock);
  with FDataLink.DataSet do
  begin
    BK := GetBookmark;
    try
      DisableControls;
      if ANode <> nil then
      begin
        ANode.DeleteChildren;
        ParentValue := ANode.FMasterValue;
      end
      else
      begin
        Items.Clear;
        ParentValue := FStartMasterValue;
      end;
      OldFiltered := False;
      OldFilter := '';
      if FUseFilter then
      begin
        if ParentValue = Null then
          PV := 'Null'
        else
          PV := '''' + Var2Type(ParentValue, varString) + '''';
        OldFilter := Filter;
        OldFiltered := Filtered;
        if Filtered then
          Filter := '(' + OldFilter + ') and (' + FDetailField + '=' + PV + ')'
        else
          Filter := '(' + FDetailField + '=' + PV + ')';
        Filtered := True;
      end;
      try
        First;
        while not Eof do
        begin
          fbnString := FieldByName(FDetailField).AsString; // avoid overhead
          if FUseFilter or
            (((ParentValue = Null) and
            ((fbnString = '') or
            (Copy(Trim(fbnString), 1, 1) = '-'))) or
            (FieldByName(FDetailField).Value = ParentValue)) then
          begin
            with Items.AddChild(ANode, FieldByName(FItemField).Text) as TJvDBTreeNode do
            begin
              FMasterValue := FieldValues[FMasterField];
              if FIconField <> '' then
              begin
                ImageIndex := Var2Type(FieldValues[FIconField], varInteger);
                SelectedIndex := ImageIndex + FSelectedIndex;
              end;
            end;
          end;
          Next;
        end;
      finally
        if FUseFilter then
        begin
          Filtered := OldFiltered;
          Filter := OldFilter;
        end;
      end;
      if ANode = nil then
        begin
          cNode := Items.GetFirstNode;
          while Assigned(cNode) do
            with TJvDBTreeNode(cNode) do
            begin
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null;
              cNode := cNode.GetNext;
            end;
          {
          // Peter Zolja - inefficient code, faster code above
          for I := 0 to Items.Count - 1 do
            with Items[I] as TJvDBTreeNode do
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
          }
        end
      else
        begin
          cNode := ANode.getFirstChild;
          while Assigned(cNode) do
            with TJvDBTreeNode(cNode) do
            begin
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null;
              cNode := cNode.GetNext;
            end;
          {
          // Peter Zolja - inefficient code, faster code above
          for I := 0 to ANode.Count - 1 do
            with ANode[I] as TJvDBTreeNode do
              HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
          }
        end;
    finally
      try
        GotoBookmark(BK);
        FreeBookmark(BK);
        EnableControls;
      finally
        Dec(FUpdateLock);
      end;
    end;
  end;
end;

function TJvCustomDBTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
  Result := inherited CanExpand(Node);
  if Result and (Node.Count = 0) then
    RefreshChild(Node as TJvDBTreeNode);
end;

procedure TJvCustomDBTreeView.Collapse(Node: TTreeNode);
var
  HasChildren: Boolean;
begin
  inherited Collapse(Node);
  if not FPersistentNode then
  begin
    HasChildren := Node.HasChildren;
    Node.DeleteChildren;
    Node.HasChildren := HasChildren;
  end;
end;

function TJvCustomDBTreeView.FindNode(AMasterValue: Variant): TJvDBTreeNode;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
  begin
    Result := Items[I] as TJvDBTreeNode;
    if Result.FMasterValue = AMasterValue then
      Exit;
  end;
  Result := nil;
end;

function TJvCustomDBTreeView.SelectNode(AMasterValue: Variant): TTreeNode;
var
  V: Variant;
  Node: TJvDBTreeNode;
  Parents: Variant; {varArray}
  I: Integer;

  function GetDetailValue(const AMasterValue: Variant; var DetailValue: Variant): Boolean;
  var
    V: Variant;
  begin
    if Assigned(FGetDetailValue) then
    begin
      Result := FGetDetailValue(AMasterValue, DetailValue);
      if DetailValue = FStartMasterValue then
        raise EJvDBTreeViewError.CreateRes(@RsEErrorValueForDetailValue);
    end
    else
    begin
      V := FDataLink.DataSet.Lookup(FMasterField, AMasterValue, FMasterField + ';' + FDetailField);
      Result := ((VarType(V) and varArray) = varArray) and (V[1] <> Null);
      if Result then
      begin
        DetailValue := V[1];
        if DetailValue = FStartMasterValue then
          raise EJvDBTreeViewError.CreateRes(@RsEInternalError);
      end;
    end;
  end;

begin
  Result := FindNode(AMasterValue);
  if Result = nil then
  try
     // Inc(FUpdateLock);
    Parents := VarArrayCreate([0, 0], varVariant);
    V := AMasterValue;
    I := 0;
    repeat
      if not GetDetailValue(V, V) then
        Exit;
      Node := FindNode(V);
      if Node <> nil then
      begin
        { To open all branches from that found to the necessary [translated] }
        //..
        Node.Expand(False);
        while I > 0 do
        begin
          FindNode(Parents[I]).Expand(False);
          Dec(I);
        end;
        Result := FindNode(AMasterValue);
      end
      else
      begin
        { To add in the array of parents [translated] }
        Inc(I);
        VarArrayRedim(Parents, I);
        Parents[I] := V;
      end;
    until Node <> nil;
  finally
     // Dec(FUpdateLock);
  end;
  if Result <> nil then
    Result.Selected := True;
end;

procedure TJvCustomDBTreeView.UpdateTree;
var
  I: Integer;
  BK: TBookmark;
  AllChecked: Boolean;

  procedure AddRecord;
  var
    Node, ParentNode: TJvDBTreeNode;
  begin
    { If the current record is absent from the tree, but it must be in it, then
      add [translated] }
    Node := FindNode(FDataLink.DataSet[FMasterField]);
    if Node = nil then
    begin
      ParentNode := FindNode(FDataLink.DataSet[FDetailField]);
      if (((ParentNode <> nil) and (not ParentNode.HasChildren or (ParentNode.Count <> 0))) or
        (FDataLink.DataSet[FDetailField] = FStartMasterValue)) then
      begin
        if FDataLink.DataSet[FDetailField] = FStartMasterValue then
          Node := nil
        else
        begin
          Node := FindNode(FDataLink.DataSet[FDetailField]);
          if (Node = nil) or (Node.HasChildren and (Node.Count = 0)) then
            Exit;
        end;
        with FDataLink.DataSet, Items.AddChild(Node, FDataLink.DataSet.FieldByName(FItemField).Text) as TJvDBTreeNode do
        begin
          FMasterValue := FieldValues[FMasterField];
          if FIconField <> '' then
          begin
            ImageIndex := Var2Type(FieldValues[FIconField], varInteger);
            SelectedIndex := ImageIndex + FSelectedIndex;
          end;
          HasChildren := Lookup(FDetailField, FMasterValue, FDetailField) <> Null
        end;
      end;
    end;
  end;

begin
  CheckDataSet;
  if UpdateLocked or (InTreeUpdate) then
    Exit;
  InTreeUpdate := True;
  Items.BeginUpdate;
  try
    with FDataLink.DataSet do
    begin
      BK := GetBookmark;
      DisableControls;
      try
        {*** To delete from a tree the remote/removed records [translated] }
        repeat
          AllChecked := True;
          for I := 0 to Items.Count - 1 do
            if not Locate(FMasterField, (Items[I] as TJvDBTreeNode).FMasterValue, []) then
            begin
              Items[I].Free;
              AllChecked := False;
              Break;
            end
            else
              Items[I].HasChildren := Lookup(FDetailField, (Items[I] as TJvDBTreeNode).FMasterValue, FDetailField) <>
                Null;
        until AllChecked;
       {###}
        {*** To add new [translated]}
        First;
        while not Eof do
        begin