Конференция "KOL" » ListView польз. отрис. столб. [Delphi]
 
  • lamp (14.09.18 21:48) [0]
    МЛЯ а может кто-нибудь объяснит мне логику работы ЛЩД (ой сорри - КОЛ) с 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]
 
Конференция "KOL" » ListView польз. отрис. столб. [Delphi]
Есть новые Нет новых   [134427   +26][b:0][p:0.011]