Coloreando una parte del Texto en TreeView

[[enecumene]]

Saludos Compañero, he estado haciendo lo siguiente para poder colorear una parte del texto en un TreeView, pero no me funciona:

Código Delphi [-]
procedure TFSelInfC.FormCreate(Sender: TObject);
Var
    Nodo:Packed Array[0..99] of TTreenode;
    NodoValor:Packed array[0..99] of Variant;
begin
  ZDpto.Open;
    trvDptos.Items.Clear;
    ZDpto.First;
    While not ZDpto.Eof do
    begin
        if NodoValor[0]<> ZDpto.Fields[0].Value then begin
     With ZDpto.Fields[2] do
      begin
        Canvas.Font.Color := clBlue;
      end;
             Nodo[0]:=trvDptos.Items.Add(nil,Vartostr(ZDpto.Fields[0].Value+' ('+ZDpto.Fields[2].AsString+')'));
          NodoValor[0]:=ZDpto.Fields[0].Value;
      Nodo[0].Data := pointer(ZDpto.FieldByName('DPTOID').AsInteger);
     end;
    ZDpto.next;
    end;
end;

Quisiera Quedara así:

Departamentos de Compras (18)

He intentado varias formas, pero no llego.

Saludos.

[[enecumene]]

Lo último que he hecho (un disparate) no funcionó, ya no tengo más ideas:

Código Delphi [-]
procedure TFSelInfC.FormCreate(Sender: TObject);
Var
    Nodo:Packed Array[0..99] of TTreenode;
    NodoValor:Packed array[0..99] of Variant;
  Total: TLabel;
begin
  ZDpto.Open;
    trvDptos.Items.Clear;
    ZDpto.First;
  Total.Caption := ZDpto.Fields[2].AsString;
  Total.Font.Color := ClBlue;
    While not ZDpto.Eof do
    begin
        if NodoValor[0]<> ZDpto.Fields[0].Value then begin
             Nodo[0]:=trvDptos.Items.Add(nil,Vartostr(ZDpto.Fields[0].Value+' ('+Total.Caption+')'));
          NodoValor[0]:=ZDpto.Fields[0].Value;
      Nodo[0].Data := pointer(ZDpto.FieldByName('DPTOID').AsInteger);
     end;
    ZDpto.next;
    end;
end;

Saludos.

[roman]

Hola, ando algo ajuma'o así que no es mucho lo que voy a decir. ¿Qué para pintar nodos de un TreeView no debería usarse uno de sus eventos OnCustomDrawItem u OnAdvancedCustomDrawItem?

// Saludos

[[enecumene]]

¡Hip!, como ves, vengo de la fiesta ¡Hip! aquella ¡Hip!, pero, ¿esos eventos no son para el item completo?, porque lo que quiero darle a una sola parte del texto no todo, digo ¡hip!, eso creo yo.

Salu..¡Hip!..dos.

[roman]

Pos' sip, son para el ítem entero, o sea, que tienes que pintarlo todo tú solito pa' q' salga como quieres.

Y que viva méxico!

Ay guey, no, eso era en el otro salón

// Saludos

[[enecumene]]

Empezado por roman

Ay guey, no, eso era en el otro salón

// Saludos

,

Bueno deja,e acell e inten ¡hip! to.

[[enecumene]]

Bueno, aquí vuelvo con una resaca, y todavía no he logrado nada, por favor, algún alma caritativa que me ayude.

Saludos. (Por favor hablen bajito)

[[enecumene]]

Hola, pues vuelvo con otro invento que no funcionó,

Código Delphi [-]
procedure TFSelInfC.trvDptosCustomDraw(Sender: TCustomTreeView;
  const ARect: TRect; var DefaultDraw: Boolean);
begin
with trvDptos.Items[0] do
  begin
      if ZDpto.Fields[2].Value then begin
        Canvas.Font.Color := clBlue;
    end;
  end;
end;

Ya no sé que hacer

Saludos.

[[enecumene]]

Bueno, con la ayuda de Eduarcol (Todo), hicimos(él hizo) este pedazo de código:

Código Delphi [-]
procedure TFSelInfC.trvDptosCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
   rc: TRect;
begin
   DefaultDraw := False;
   with trvDptos do
   begin
      Canvas.Brush.Style := bsClear;
      Canvas.Font.Color := clBlue;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      rc :=  Node.DisplayRect(False);
      Canvas.TextOut(rc.Left, rc.Top, Copy(Node.Text, 1, Pos('(', Node.Text)));
      Canvas.Refresh;
      Canvas.Font.Color := clRed;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      Canvas.TextOut(rc.Left + Canvas.TextHeight(Copy(Node.Text, 1, Pos('(', Node.Text) - 1)), rc.Top, EntreValores(Node.Text, '(', ')'));
      Canvas.Refresh;
      Canvas.Font.Color := clBlue;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      Canvas.TextOut(rc.Left + Canvas.TextHeight(Node.Text) - 1, rc.Top, Copy(Node.Text, 1, Pos(')', Node.Text)));
 end;
end;

Resultado:

http://img237.imageshack.us/img237/8...sultadouv7.jpg

Sin comentarios.

Saludos.

[[eduarcol]]

pero veo que aun sigue montado el texto, no se soluciono eso?

[[enecumene]]

Empezado por eduarcol

pero veo que aun sigue montado el texto, no se soluciono eso?

No funcionó amigo Eduardo

[[eduarcol]]

bueno, esperemos que llegue algun maestro del canvas a ver que hace con esto.... Recuerda que te dije que no estoy muy puesto en el tema

[[eduarcol]]

Listo, no era nada del canvas ni eso... un simple error por el cansancio de ayer

Código Delphi [-]
procedure TForm1.trvDptosCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
   rc: TRect;
begin
   DefaultDraw := False;
   with trvDptos do
   begin
      Canvas.Brush.Style := bsClear;
      Canvas.Font.Color := clBlue;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      rc :=  Node.DisplayRect(False);
      Canvas.TextOut(rc.Left, rc.Top, Copy(Node.Text, 1, Pos('(', Node.Text)));
      Canvas.Refresh;
      Canvas.Font.Color := clRed;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      Canvas.TextOut(rc.Left + Canvas.TextWidth(Copy(Node.Text, 1, Pos('(', Node.Text))), rc.Top, EntreValores(Node.Text, '(', ')'));
      Canvas.Refresh;
      Canvas.Font.Color := clBlue;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      Canvas.TextOut(rc.Left + Canvas.TextWidth(Node.Text) - 1, rc.Top, Copy(Node.Text, Pos(EntreValores(Node.Text, '(', ')'), Node.Text) + Length(EntreValores(Node.Text, '(', ')')), Pos(')', Node.Text)));
 end;
end;

si te fijas cambian las formulas que calculan los valores del texto IMAGEN

[roman]

Eso está muy bien. Yo había intentado hacerlo llegando más o menos a lo mismo pero no podía cambiar el color (por eso no había dicho nada). Veo que lo han resuelto con un Refresh. Estupendo.

// Saludos

[[enecumene]]

¡Vale!, Me ha funcionado de maravillas, he quitado el canvas.Brush.style, porque al estar en bsClear no me muestra la selección del item. Muchas gracias Eduarcol, eres un master .

Saludod.

[[eduarcol]]

Empezado por roman

Eso está muy bien. Yo había intentado hacerlo llegando más o menos a lo mismo pero no podía cambiar el color (por eso no había dicho nada). Veo que lo han resuelto con un Refresh. Estupendo.

// Saludos

Pues eso es de mi epoca cuando trabajaba en Pascal o C con la BGI, para que cambiara el color del texto habia que darle un clrscr, y buscando eso encontre el refresh funciono y sorpresa


Por cierto primera vez que trabajo con la canvas.

[roman]

Yo había hecho un ejemplo a dos colores pero en un DBGrid y sin necesidad del Refresh, por ello no me pasó por la mente, aunque en realidad ya no me pasaba nada por la mente
Qué bueno que encontraste la forma. Ahora ya sabemos algo más

// Saludos

[[xEsk]]

He probado el ejemplo "final", y siento decir, que pierde la gracia del TTreeView xD Los SubItems aparecen en el nivel 0

Aquí un pequeño parche xD

Código Delphi [-]
procedure TForm2.trvDptosCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
   rc: TRect;
   // Details: TThemedElementDetails; // ESTO ES basura de una prueba, lo comento en lugar de borrarlo, para que se entienda el mensaje de enecumene xD

begin
   DefaultDraw := False;
   with trvDptos do
   begin
      Canvas.Brush.Style := bsClear;
      Canvas.Font.Color := clBlue;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      rc :=  Node.DisplayRect(False);
      // sub-niveles
      rc.Left:=(Node.Level + 1) * TTreeView(Sender).indent;
      // miramos si esta seleccionado
      if Node.Selected then
          Canvas.Brush.Color:=clSilver
      else
          Canvas.Brush.Color:=clWindow;
      // pintamos texto
      Canvas.TextOut(rc.Left, rc.Top, Copy(Node.Text, 1, Pos('(', Node.Text)));
      Canvas.Refresh;
      Canvas.Font.Color := clRed;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      Canvas.TextOut(rc.Left + Canvas.TextWidth(Copy(Node.Text, 1, Pos('(', Node.Text))), rc.Top, EntreValores(Node.Text, '(', ')'));
      Canvas.Refresh;
      Canvas.Font.Color := clBlue;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Size := 10;
      Canvas.TextOut(rc.Left + Canvas.TextWidth(Node.Text) - 3, rc.Top, Copy(Node.Text, Pos(EntreValores(Node.Text, '(', ')'), Node.Text) + Length(EntreValores(Node.Text, '(', ')')), Pos(')', Node.Text)));
 end;
end;

Saludos.

[[enecumene]]

¡Vaya!, excelente, una cosa, ¿donde utilizas la variable Details?, no lo encuentro en el código.

Saludos.

[roman]

Una pregunta xEsk:

El rc ¿no se puede obtener directamente si en lugar de usar Node.DisplayRect(False) usamos Node.DisplayRect(True)?

// Saludos