Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

OverDraw и TreeView


markers ©   (2006-10-28 01:43:00) 

Имею заполненое дерево  и мне нужно у некоторых итемов "подписать" другим цветом текст, Когда я использовал ListBox я это делал так:
[CODE]var catSel:Integer;
begin
 with (Control as TListBox).Canvas do
  begin
   if odd(Index-1) then Brush.Color:=$FFFFFF
   else Brush.Color:=$F5F5F5;
   if (odSelected in State) or (odFocused in State) or (odComboBoxEdit in State) Then
    begin
     Brush.Color:=clNavy;
     Brush.Style:=bsSolid;
     Font.Color:=clWhite;
    end
   else Font.Color:=(Control as TListBox).Font.Color;
   FillRect(Rect);
   TextOut(Rect.Left+2,Rect.Top+1,CategoryList.Items.Strings[index]);
   if (CatRule = 'NEWMES') or (CatRule = 'OLDMES') Then
    begin
     catSel:=CategoryName.IndexOf(CategoryList.Items.Strings[index]);
     if (CatRule = 'NEWMES') and (CategoryST.Strings[catSel] = '1') Then
      begin
       Font.Color:=CatColor;
       Font.Style:=[fsItalic];
       TextOut (Rect.Left+TextWidth(CategoryList.Items.Strings[index])+5, Rect.Top+1, CatMes);
       if TextWidth(CategoryList.Items.Strings[index]+'  '+CatMes) > MaxLen Then
        begin
         MaxLen:=TextWidth(CategoryList.Items.Strings[index]+'  '+CatMes);
         SendMessage(CategoryList.Handle, LB_SETHORIZONTALEXTENT, MaxLen+5, Longint(0));
        end;
      end
     else if (CatRule = 'OLDMES') and (CategoryST.Strings[catSel] = '0') Then
      begin
       Font.Color:=CatColor;
       Font.Style:=[fsItalic];
       TextOut (Rect.Left+TextWidth(CategoryList.Items.Strings[index])+5, Rect.Top+1, CatMes);
       if TextWidth(CategoryList.Items.Strings[index]+'  '+CatMes) > MaxLen Then
        begin
         MaxLen:=TextWidth(CategoryList.Items.Strings[index]+'  '+CatMes);
         SendMessage(CategoryList.Handle, LB_SETHORIZONTALEXTENT, MaxLen+5, Longint(0));
        end;
      end;
    end
   else
    if TextWidth(CategoryList.Items.Strings[index]) > MaxLen Then
     begin
      MaxLen:=TextWidth(CategoryList.Items.Strings[index]);
      SendMessage(CategoryList.Handle, LB_SETHORIZONTALEXTENT, MaxLen+5, Longint(0));
     end;
  end;
end;[/CODE]
И никак толком не могу реализовать тоже самое с TreeView (Сделал только разноцветность выделением цветом всего итема)

markers   (2006-10-28 03:37:00) [1]

Подскажите ещё плиз, как увеличить длинну итема не меняя его содержимое? Вообщем мне нужно добавить ещё пространство после пункта, когда был ListBox использовал:
 SendMessage(CategoryList.Handle, LB_SETHORIZONTALEXTENT, MaxLen+5, Longint(0));

markers   (2006-10-28 03:20:00) [2]

УРА!!! Часть проблемы смог решить таким вот извращенским способом :)
procedure TMainForm.CatsViewCustomDrawItem(Sender: TCustomTreeView;
 Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var Rect:TRect;
   Rect2:TRect;
   inc:Integer;
   cattype:string;
begin
 if CatsView.Items.Count = 0 then Exit;
 with TTreeView(Sender).Canvas do
  begin
   DefaultDraw:=True;
   Rect:=Node.DisplayRect(False);
   Rect2:=Node.DisplayRect(True);
   if Node.Level > 0 then
    begin
     inc:=Node.Index+Node.Parent.Index;
    end
   else inc:=Node.Index-1;
   if odd(inc) then Brush.Color:=$FFFFFF
   else Brush.Color:=$F5F5F5;
   if (cdsSelected in State) or (cdsFocused in State) Then
    begin
     Brush.Color:=clNavy;
     Brush.Style:=bsSolid;
     Font.Color:=clWhite;
     Refresh;
     Font.Style:=[];
    end;
   FillRect(Rect);
   FillRect(Rect2);
   if Integer(Node.Data) > 0 then
    cattype:=GetCatStat(IntToStr(Integer(Node.Data)))
   else
    begin
     if Integer(Node.Data) = -1 then
      cattype:='New'
     else if Integer(Node.Data) = -2 then
      cattype:='Spec';
    end;
   if cattype <> 'Normal' then
    begin
     Font.Style:=[fsItalic];
     if cattype = 'New' then
      begin
       Font.Color:=clRed;
       TextOut (Rect2.Left+TextWidth(Node.Text)+7, Rect2.Top+1, 'New!');
       Refresh;
       Font.Color:=clGray;
       TextOut(Rect2.Left+2,Rect2.Top+1,Node.Text);
      end
     else if cattype = 'Spec' then
      begin
       Font.Color:=clGreen;
       TextOut (Rect2.Left+TextWidth(Node.Text)+7, Rect2.Top+1, 'Сп!');
       Refresh;
       Font.Color:=clGray;
       TextOut(Rect2.Left+2,Rect2.Top+1,Node.Text);
      end;
    end;
  end;
end;

Gero   (2006-10-28 03:16:00) [3]

> [5] markers ©   (28.10.06 02:55)

Что значит «дописать строку»?

RASkov   (2006-10-28 03:07:00) [4]

> [7] markers ©   (28.10.06 03:03)

Невнимательный...я.

RASkov   (2006-10-28 03:06:00) [5]

> [5] markers ©   (28.10.06 02:55)

Ну может ченить так:
...
  TextOut(NodeRect.Left, NodeRect.Top, Node.Text);
  Font.Color:=clBlue;
  TextOut(NodeRect.Left+TextWidth(Node.Text), NodeRect.Top, ' blabla');
...

Сейчас еще подумаю....

markers   (2006-10-28 03:03:00) [6]

Кстати можно вообще забить на то что там рисует TreeView, но тогда слишком много чего рисовать надо будет (Линии, +/- и т.д.)

markers   (2006-10-28 03:01:00) [7]

Gero ©   (28.10.06 1:57) [3]
Пробовал всяко разно, ну примерно так:
procedure TMainForm.CatsViewCustomDrawItem(Sender: TCustomTreeView;
 Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var Rect:TRect;
   Rect2:TRect;
   inc:Integer;
   cattype:string;
begin
 if CatsView.Items.Count = 0 then Exit;
 with TTreeView(Sender).Canvas do
  begin
   Font.Color:=CatsView.Font.Color;
   Font.Style:=[];
   DefaultDraw:=True;
   Rect:=Node.DisplayRect(False);
   Rect2:=Node.DisplayRect(True);
   if Node.Level > 0 then
    begin
     inc:=Node.Index+Node.Parent.Index;
    end
   else inc:=Node.Index-1;
   if odd(inc) then Brush.Color:=$FFFFFF
   else Brush.Color:=$F5F5F5;
   if (cdsSelected in State) or (cdsFocused in State) Then
    begin
     Brush.Color:=clNavy;
     Brush.Style:=bsSolid;
     Font.Color:=clWhite;
     Font.Style:=[];
    end
   else Font.Color:=CatsView.Font.Color;
   FillRect(Rect);
   FillRect(Rect2);
   TextOut(Rect2.Left+2,Rect2.Top+1,Node.Text);
   if Integer(Node.Data) > 0 then
    cattype:=GetCatStat(IntToStr(Integer(Node.Data)))
   else
    begin
     if Integer(Node.Data) = -1 then
      cattype:='New'
     else if Integer(Node.Data) = -2 then
      cattype:='Spec';
    end;
   if cattype <> 'Normal' then
    begin
     Font.Color:=clRed;
     Font.Style:=[fsItalic];
     if cattype = 'New' then
      begin
       Font.Color:=clRed;
       TextOut (Rect2.Left+TextWidth(Node.Text)+7, Rect2.Top+1, 'New!');
      end
     else if cattype = 'Spec' then
      begin
       Font.Color:=clGreen;
       TextOut (Rect2.Left+TextWidth(Node.Text)+7, Rect2.Top+1, 'Сп!');
      end;
    end;
  end;
end;

markers   (2006-10-28 02:55:00) [8]

RASkov   (28.10.06 2:26) [4]
В вашем примере выделяется вся строка, это я и так сделал, а мне нужно "дописать" строку другим цветом!

RASkov   (2006-10-28 02:26:00) [9]

procedure TForm1.TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
 State: TCustomDrawState; var DefaultDraw: Boolean);
var
 NodeRect: TRect;
begin
 with TreeView1.Canvas do begin
  NodeRect := Node.DisplayRect(True);
  FillRect(NodeRect);
  if cdsSelected in State then begin
   Font.Color:=clYellow;
   Font.Style:=[fsBold];
   Brush.Color := clBlack;
  end else begin
   if Node.Text ='NEWMES' then Font.Color:=clLime
    else if Node.Text ='OLDMES' then Font.Color:=clRed
   else Font.Color:=clNavy;
  end;
  TextOut(NodeRect.Left, NodeRect.Top, Node.Text);
 end;
end;

Gero   (2006-10-28 01:57:00) [10]

А как пробовал и что не получилось?

markers   (2006-10-28 01:53:00) [11]

Gero ©   (28.10.06 1:50) [1]
Да уж знаю..... Но неполучается ничего :(

Gero   (2006-10-28 01:50:00) [12]

OnCustomDrawItem

Наверх

Титульная страница Поиск, карта сайта Написать письмо