Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

ListView польз. отрис. столб. [Delphi]


lamp   (14.09.18 21:48

МЛЯ а может кто-нибудь объяснит мне логику работы ЛЩД (ой сорри - КОЛ) с ListView?

я про пользовательскую отрисовку столбов. Я попутала когда заценила код, предлагающий по циклу (по их кол-ву) запрашивать прогу о цвете текста.

Ладно бы это хотя бы работало.

ВОПРОС: надо точно велеть листвьюеру В КАЖДОЙ колонке печатать текст МОИМ цветом.
КАК?

PS Желательно в ListView.OnMessage


RusSun ©   (15.09.18 20:39[1]

Доброе время суток. to lamp.
Форум статичный и практически вымерший, поэтому ...
Итак начнем
Ваше сообщение Слегка все сумбурно. и многое вырвано из контекста.
"Телепатия это дар,..." Но все же попробуем.

Вы используете МСК? или как в коде ниже "не визуальное"?
Вы покажите код?
Если это трудно могу на яндекс диск ссылки кинуть?
Чтобы можно было скачать и посмотреть пример.
Почему именно: "Желательно в ListView.OnMessage ?"
Для примера:

program Project1;

uses
Windows,KOL;
{$R *.res}
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
  Form,Lv: PControl;
public
 function SubitemDraw(Sender: PControl; DC: HDC; Dummy {always 0 !}: DWORD;
ItemIdx, SubItemIdx: Integer; const Rect: TRect;
ItemState: TDrawState; var TextColor, BackColor: TColor ): Boolean;
 // procedure Timer1Timer(Sender: PObj);
end;
 function TForm1.SubItemDraw(Sender: PControl; DC: HDC; Dummy {always 0 !}: DWORD;
ItemIdx, SubItemIdx: Integer; const Rect: TRect;
ItemState: TDrawState; var TextColor, BackColor: TColor ): Boolean;
begin
  if SubItemIdx>0 then Form.Caption:=form.Caption+int2str(SubItemIdx); //else Form.Caption:=form.Caption+int2str(SubItemIdx);

  BackColor:=$00FFFF*((ItemIdx+SubItemIdx) and 1);//шахматная раскраска

  Result:=true //если true, то единицы
  //если  Result:=false; //если true, то ничего не пишет

end;

var
Form1: PForm1;

procedure NewForm1(var Result: PForm1; AParent: PControl);
var x,y,n:Integer;
begin
New(Result, Create);
with Result^ do
begin
  Form := NewForm(AParent, 'Test ListView Subitem Draw ');
  Form.Add2AutoFree(Result);
  Applet := Form;
  Form.SetClientSize(520, 340).CenterOnParent;
  Lv:=newListView(Form,LvsDetail,[LvoNoSortheader,LvoRowSelect],nil, nil, nil).SetAlign(caClient);
  for x := 0 to 9 do Lv.lvColadd('rrr',taCenter,50);
  for y := 0 to 10 do begin
      n:= Lv.LVItemAdd('yyy');

     for x := 1 to 9 do
     
     if n mod 2=0 then
                             begin
     if x mod 2=0 then LV.LVItems[n,x]:='   ' else LV.LVItems[n,x]:='xxx'
                             end else
                             begin
      if x mod 2=0 then LV.LVItems[n,x]:='xxx' else LV.LVItems[n,x]:='   '
                             end;
     

                        end;
lv.onLVsubItemDraw := SubItemDraw
end; //end of result
end; //end of procedure

                           { begin
     if x mod 2=0 then LV.LVItems[n,x]:='xxx' else LV.LVItems[n,x]:='   '
                             end else
                             begin
      if x mod 2=0 then LV.LVItems[n,x]:='   ' else LV.LVItems[n,x]:='xxx'
                             end;  }

begin
NewForm1(Form1, nil);
Run(Form1.Form);
end.



program Project1;

uses
 windows,
 kol;
type  TOnEvent = procedure( Sender: PObj )of object;
{$R *.res}
var
form,REdit,Panel,
Test1,Button1:PControl;

//область для процедур
procedure Test1Click(Dummy:Pointer;Sender:PControl; var mouse:TMouseEventData);
const Colors: array[ 0..9 ] of TColor = ( clBlack, clNavy, clBlue, clAqua,
 clLime, clGreen, clOlive, clYellow, clRed, clMaroon );
var I, N: Integer;
begin
 N := REdit.Pos2Item( REdit.TextSize );
 for I := 1 to 10 do
 begin
   REdit.SelStart := REdit.TextSize;
   REdit.ReplaceSelection( 'Test' + Int2Str( N+I ) + #13#10, FALSE );
 end;
 for I := 0 to 9 do
 begin
   REdit.SelStart := REdit.Item2Pos( N+I );
   REdit.SelLength := REdit.Item2Pos( N+I + 1 ) - REdit.SelStart;
   REdit.RE_FmtFontColor := Colors[ I ];
 end;
 REdit.SelStart := 0;

end;
procedure clickbutton1(Dummy:Pointer;Sender:PControl; var mouse:TMouseEventData);
const Colors: array[ 0..9 ] of TColor = ( clWhite, clNavy, clBlue, clAqua,
 clLime, clGreen, clOlive, clYellow, clRed, clMaroon );
var I, N: Integer;
begin
 N := REdit.Pos2Item( REdit.TextSize );
 for I := 1 to 10 do
 begin
   REdit.SelStart := REdit.TextSize;
   REdit.ReplaceSelection( 'Test' + Int2Str( N+I ) + #13#10, FALSE );
 end;
 for I := 0 to 9 do
 begin
   REdit.SelStart := REdit.Item2Pos( N+I );
   REdit.SelLength := REdit.Item2Pos( N+I + 1 ) - REdit.SelStart;
   REdit.RE_FmtBackColor := Colors[ I ];
 end;
 REdit.SelStart := 0;
end;
Begin
form:=NewForm(Applet,'form').SetPosition( 192, 124 ).SetClientSize( 475, 281 ).centeronparent.Tabulate;
form.Border := 6;
REdit := NewRichEdit( form, [ eoMultiline ] ).SetAlign ( caClient );
REdit.Color := clWindow;
Panel := NewPanel( form, esLowered ).SetAlign ( caBottom ).SetSize( 0, 38 );
Panel.Border := 2;
Test1 := NewButton( Panel, 'Test1' ).SetPosition( 7, 7 ).SetSize( 137, 0 );
Button1 := NewButton( Panel, 'Test2' ).SetPosition( 151, 7 ).SetSize( 137, 0 );

//область для работы
Test1.OnClick:=TonEvent(MakeMethod(nil,@Test1Click));
Button1.OnClick:=TonEvent(MakeMethod(nil,@clickbutton1));
Run(form);
end.


https://yadi.sk/d/4wMquVWNmbkNTg
https://yadi.sk/d/Uh1k9tGf03zt_w


RusSun ©   (15.09.18 21:00[2]

Новичкам всегда трудно.) Мини офф. топ.
Всего два пути:
1) Обидеться и навсегда покинуть форум. Что не требует доп. усилий.
2) Пообщаться и попробовать сделать то, что задумали.


QAZ ©   (18.09.18 20:11[3]

2)хочу в ЛВ раскрашивать отдельные слова в приложении


RusSun ©   (02.10.18 04:49[4]

код VCL взят из данной темы http://www.cyberforum.ru/delphi-beginners/thread1505475.html

Код тестовый

program Project1;

uses
Windows,KOL;
 {$R *.res}
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
  Form: PControl;
public
function GetWordRect(ItemIdx, SubItem: Integer; FWord: string): TRect;
end;

var
Form1: PForm1;
Button: PControl;
Button2: PControl;
Edit1: PControl;
ResultView:  PControl;
Memo1: PControl;

procedure clickbutton1(Sender:PControl; var mouse:TMouseEventData);
var I:integer;  R2: TRect;
begin
ResultView.Canvas.Brush.Color := clWindow; //clblack
ResultView.Canvas.Font.Color := clRed;

for I:=0 to ResultView.LVCount-1 do  begin // выделяем во всех строках
 R2:=  form1.GetWordRect(I,1,Edit1.Text);
 ResultView.Canvas.TextRect(R2, R2.Left, R2.Top, Edit1.Text);//ItemIdx, SubItem: Integer;
                                       end;
end;

procedure clickbutton2(Sender:PControl; var mouse:TMouseEventData);
begin
ResultView.Invalidate;
Memo1.Clear;
end;

procedure form_create;
begin
//    for I:=0 to 9 do  begin
//  // добавляем несколько элементов
//  ResultView.LVItemAdd( '№'+Int2Str(I+1) ); // задаем имя и текст
//  ResultView.LVItems[I,1]:=MakeRandomSpace(5)+'Какой-то текст с выделенным словом №'+Int2Str(I+1);
//                        end;

 ResultView.LVItemAdd( '№1' ); // задаем имя и текст
 ResultView.LVItems[0,1]:=' Какой-то текст с выделенным словом №1';

 ResultView.LVItemAdd( '№2' ); // задаем имя и текст
 ResultView.LVItems[1,1]:='    Какой-то текст с выделенным словом №2';

 ResultView.LVItemAdd( '№3' ); // задаем имя и текст
 ResultView.LVItems[2,1]:='       Какой-то текст с выделенным словом №3';

 ResultView.LVItemAdd( '№4' ); // задаем имя и текст
 ResultView.LVItems[3,1]:='    Какой-то текст с выделенным словом №4';
end;

function TForm1.GetWordRect(ItemIdx, SubItem: Integer; FWord: string): TRect;

var  ColW: Integer;          // Ширина колонки
    WordWidth: Integer;    // Размер слова
    TextWidth: Integer;    // Размер текста
    WordPosition: Integer; // Позиция слова в тексте
    SubItemText: string;
begin
Result := MakeRect(0,0,0,0);
ColW := ResultView.LVColWidth[1];// Ширина колонки

    Memo1.Add('ItemIdx '+ Int2Str(ItemIdx)+' SubItem '+ Int2Str(SubItem)+ ' FWord '+ FWord+#13#10);

     Memo1.Add(''+#13#10);

if (ItemIdx >= ResultView.LVCount) or (FWord='') then Exit;  // если указанный элемент не существует, то выходим

Result := ResultView.LVItemRect( ItemIdx, lvipBounds ); // получаем область для рисования

Inc(Result.Left, ResultView.LVColWidth[0]); // смещаемся на позицию элемента  Работает только для первого случая потом почему-то не сбрасывает!

         Memo1.Add('Result.Left '+Int2Str(Result.Left)+#13#10);

Result.Right := Result.Left + ResultView.LVColWidth[0];  // задаем конечную границу справа

         WordWidth := ResultView.Canvas.TextWidth(FWord); // размер слова

         SubItemText := ResultView.LVItems[ItemIdx, SubItem] ; // текст элемента  lv1.Items[ItemIdx].SubItems[SubItem]

         WordPosition := Pos(FWord, SubItemText); // позиция слова в тексте

         if (WordPosition=0) then Begin Result := MakeRect(0,0,0,0); Exit; End; // если не найдена, то выходим

TextWidth := ResultView.Canvas.TextWidth(Copy(SubItemText,1,WordPosition)); // получаем размер текста +9

         if TextWidth>= ColW then Begin Result := MakeRect(0,0,0,0); Exit; End; // если нужное слово за границами видимости, то выходим

// если слово видно целиком, то
if TextWidth+WordWidth<= ColW then // возвращаем его область

 Result := MakeRect(Result.Left+TextWidth,
               Result.Top,
               Result.Left+TextWidth+WordWidth,
               Result.Bottom-1) else // если нет, то рисуем до конца колонки

 Result := MakeRect(Result.Left+TextWidth,
               Result.Top,
               Result.Right,
               Result.Bottom-1);

// form1.Form.Caption:= 'Размеры '+Int2Str(Result.Left)+' '+Int2Str(Result.Top)+' '+Int2Str(Result.Right)+' '+Int2Str(Result.Bottom);
Memo1.Add( 'Размеры '+Int2Str(Result.Left)+' '+Int2Str(Result.Top)+' '+Int2Str(Result.Right)+' '+Int2Str(Result.Bottom)+#13#10 );
Memo1.Add(''+#13#10);
end;

procedure NewForm1(var Result: PForm1; AParent: PControl);
begin
New(Result, Create);
with Result^ do
begin
  Form := NewForm(AParent, 'Test');
  Form.Add2AutoFree(Result);
  Applet := Form;
  Form.SetClientSize(1105,372).CenterOnParent;
  //Form.SetClientSize(625,372).CenterOnParent;
  Form.Font.FontName := 'Tahoma';
  Form.Font.FontHeight := -11;
  Form.Font.FontStyle := [];
Button:=NewButton(form,'Выбрать слово').SetSize(113,25).SetPosition(112,304);
Button2:=NewButton(form,'Снять выделение').SetSize(113,25).SetPosition(358,304);
  Edit1:=NewEditBox(Form,[]).SetPosition(231,306).SetSize(121,21);
  Edit1.Color:=clWhite;
  Edit1.Text:='выделенным';

Button.OnClick:=TonEvent(MakeMethod(nil,@clickbutton1));
Button2.OnClick:=TonEvent(MakeMethod(nil,@clickbutton2));

ResultView := NewListView( form, lvsDetail, [lvoGridLines],nil, nil, nil ).SetPosition(88,8 ).SetSize( 465,281 ); //.SetAlign(caClient);
   ResultView.LVColAdd( 'Items', taLeft, 60);
   ResultView.LVColAdd( 'SubItems', taLeft,250);
   Memo1 := NewEditBox( form, [ eoMultiline, eoNoHScroll ] ).SetPosition( 608,8 ).SetSize(465,281);//.SetAlign ( caClient );
   Memo1.Color :=clWhite;

   //ResultView.onLVsubItemDraw := SubItemDraw;
  // ResultView.OnLVCustomDraw := ListView1LVCustomDraw;

end;
 form_create;
end;

begin
NewForm1(Form1, nil);
Run(Form1.Form);
end.


RusSun ©   (02.10.18 04:52[5]

комментарий -"Работает только для первого случая потом почему-то не сбрасывает!"
Остался с тестирования можно на него не обращать внимания!


RusSun ©   (02.10.18 04:59[6]

дополнительная информация http://kolmck.000webhostapp.com/demos/DemoLVCustomDraw.zip

http://delphimaster.net/?s=DemoLVCustomDraw.zip&pcount=50&forum=11&user=&order=REPLYDATE&dir=desc&title= 1&message=1&date_begin=&date_end=


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо