Coloreando una parte del Texto en TreeView
 

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.

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.

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

¡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.

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

:D :D :D,

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

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)

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.

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.

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

No funcionó amigo Eduardo :(

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 :cool:

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 :D IMAGEN

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

¡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 :D.

Saludod.

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 :D


Por cierto primera vez que trabajo con la canvas.

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 :D
Qué bueno que encontraste la forma. Ahora ya sabemos algo más :)

// Saludos

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.

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

Saludos.

Una pregunta xEsk:

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

// Saludos

Ops, es un error, es basura de una prueba que realicé! xDD

Ahora lo borraré! :P

Cierto, cambiándolo a true se soluciona :p

Saludos