Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2011.06.19;
Скачать: [xml.tar.bz2];

Вниз

Помогите настроить отображение массива в TListView?   Найти похожие ветки 

 
Пироги   (2011-01-29 19:01) [0]

Задача отображать массив в TListView в режиме OnOwnerDraw.
Делаю так:

Unit1.pas

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   ListView1: TListView;
   CheckBox1: TCheckBox;
   CheckBox2: TCheckBox;
   CheckBox3: TCheckBox;
   Button1: TButton;
   CheckBox4: TCheckBox;
   CheckBox5: TCheckBox;
   Button3: TButton;
   Label2: TLabel;
   procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
     Rect: TRect; State: TOwnerDrawState);
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure ListView1Change(Sender: TObject; Item: TListItem;
     Change: TItemChange);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

const
 Count1 = 5;

{$R *.dfm}

function InRange(const AValue, AMin, AMax: Integer): Boolean;
begin
 Result := (AValue >= AMin) and (AValue <= AMax);
end;

 // &#206;&#242;&#240;&#232;&#241;&#238;&#226;&#234;&#224; &#241;&#242;&#240;&#238;&#247;&#234;&#229; &#226; ListView1.
procedure TForm1.ListView1DrawItem(Sender: TCustomListView;
 Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
 itInd1 : Integer;
 b1     : Boolean;
begin
 if Item = nil then exit;
 itInd1 := Item.Index;
 if not InRange(itInd1, 0, Count1 -1) then exit;
 case itInd1 of
   0: b1 := CheckBox1.Checked;
   1: b1 := CheckBox2.Checked;
   2: b1 := CheckBox3.Checked;
   3: b1 := CheckBox4.Checked;
   4: b1 := CheckBox5.Checked;
 else ShowMessage("Error 1");
 end;
 with Sender do begin
   if b1 then Canvas.Brush.Color := clGreen
         else Canvas.Brush.Color := clWhite;
   Canvas.FillRect(Rect);
   if b1 then Canvas.Font.Color := clWhite;
 end;
 with Sender do begin
   Canvas.TextOut(2 , Rect.Top, IntToStr(itInd1 +1)+" )");
   Canvas.TextOut(20, Rect.Top, IntToStr(Byte(b1)) );
 end;
 if itInd1 = ListView1.ItemIndex then begin
   with Sender do begin
     if b1 then Canvas.Pen.Color := clWhite
           else Canvas.Pen.Color := clBlack;
     Canvas.Brush.Style := bsClear;
     Canvas.Rectangle(Rect.Left  +1, Rect.Top    +1,
                      Rect.Right -1, Rect.Bottom -1);
   end;
 end;
end;

 // &#209;&#242;&#224;&#226;&#232;&#236; &#228;&#224;&#237;&#237;&#251;&#229; &#232;&#231; ListView1 &#226; &#247;&#229;&#234;&#225;&#238;&#234;&#241;&#251;.
procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem;
 Change: TItemChange);
var
 i1 : Integer;
begin
 for i1 := 0 to ListView1.Items.Count -1 do begin
   case i1 of
     0 : CheckBox1.Checked := ListView1.Items[i1].Selected;
     1 : CheckBox2.Checked := ListView1.Items[i1].Selected;
     2 : CheckBox3.Checked := ListView1.Items[i1].Selected;
     3 : CheckBox4.Checked := ListView1.Items[i1].Selected;
     4 : CheckBox5.Checked := ListView1.Items[i1].Selected;
   end;
 end;
 Label2.Caption := "Item index: " +IntToStr(ListView1.ItemIndex);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 ListView1.Items.Count := Count1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 ListView1.Invalidate;
end;

end.


Unit1.dfm

object Form1: TForm1
 Left = 279
 Top = 113
 Width = 401
 Height = 304
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 PixelsPerInch = 96
 TextHeight = 13
 object Label2: TLabel
   Left = 320
   Top = 16
   Width = 32
   Height = 13
   Caption = "Label2"
 end
 object ListView1: TListView
   Left = 0
   Top = 0
   Width = 121
   Height = 270
   Align = alLeft
   Columns = <
     item
     end>
   FlatScrollBars = True
   MultiSelect = True
   OwnerData = True
   OwnerDraw = True
   ReadOnly = True
   RowSelect = True
   TabOrder = 0
   ViewStyle = vsReport
   OnChange = ListView1Change
   OnDrawItem = ListView1DrawItem
 end
 object CheckBox1: TCheckBox
   Left = 144
   Top = 56
   Width = 97
   Height = 17
   Caption = "CheckBox1"
   TabOrder = 1
 end
 object CheckBox2: TCheckBox
   Left = 144
   Top = 80
   Width = 97
   Height = 17
   Caption = "CheckBox2"
   TabOrder = 2
 end
 object CheckBox3: TCheckBox
   Left = 144
   Top = 104
   Width = 97
   Height = 17
   Caption = "CheckBox3"
   TabOrder = 3
 end
 object Button1: TButton
   Left = 136
   Top = 8
   Width = 75
   Height = 25
   Caption = "Invalidate"
   TabOrder = 4
   OnClick = Button1Click
 end
 object CheckBox4: TCheckBox
   Left = 144
   Top = 128
   Width = 97
   Height = 17
   Caption = "CheckBox4"
   TabOrder = 5
 end
 object CheckBox5: TCheckBox
   Left = 144
   Top = 152
   Width = 97
   Height = 17
   Caption = "CheckBox5"
   TabOrder = 6
 end
 object Button3: TButton
   Left = 232
   Top = 8
   Width = 75
   Height = 25
   Caption = "Item index"
   TabOrder = 7
 end
end


Вместо массива здесь используются чекбоксы, просто для отладки.

Вроде бы всё в порядке, может выбирать строчки в ListView, и чекбоксы выставляются в соответствии с выбором, и наоборот, можно выставить чек-боксы в нужные значения, потом нажать на кнопку Invalidate и строчки в ListView выбирутся в соответствии с чекбоксами.

Но оказалось, есть случаи когда это не срабатывает. Например.
Выбираем в ListView элемент 2, нажимаем Shift и выбираем элемент 4. У нас выделяются 3 элемента и 3 чекбокса соответствующие им. Теперь отключаем CheckBox2 и нажимаем на Invalidate, теперь в ListView выбрано только два элемента. Всё правильно. Дальше жмём на Ctrl и жмём на четвёртый элемент. В результате у нас должен был бы остаться выделенным только третий элемент, а вместо этого их остаётся выделенными два, второй и третий и чек-боксов тоже выделено два.

Как исправить код, чтобы этого глюка не возникало?


 
sniknik ©   (2011-01-29 20:12) [1]

> Как исправить код, чтобы этого глюка не возникало?
меняешь что то, следи чтобы это не вызывало событие "обратного изменения"
ну и Invalidate не устанавливает Selected.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   ListView1: TListView;
   CheckBox1: TCheckBox;
   CheckBox2: TCheckBox;
   CheckBox3: TCheckBox;
   CheckBox4: TCheckBox;
   CheckBox5: TCheckBox;
   procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
   procedure ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
   procedure CheckBoxClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   Auto: boolean;
 public
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
 i: integer;
 b: Boolean;
begin
 i:= Item.Index;
 case i of
   0: b:= CheckBox1.Checked;
   1: b:= CheckBox2.Checked;
   2: b:= CheckBox3.Checked;
   3: b:= CheckBox4.Checked;
   4: b:= CheckBox5.Checked;
 end;
 with Sender do begin
   if b then begin
     Canvas.Brush.Color:= clGreen;
     Canvas.Font.Color := clWhite;
   end else
     Canvas.Brush.Color:= clWhite;

   Canvas.TextRect(Rect, 2 , Rect.Top, "( "+IntToStr(i+1)+" ) "+IntToStr(Byte(b)));

   if odFocused in State then begin
     Canvas.Pen.Color  := clWhite;
     Canvas.Brush.Style:= bsClear;
     Canvas.Rectangle(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom -1);
   end;
 end;
end;

procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
 Auto:= true;
 with ListView1 do
   try
     CheckBox1.Checked:= Items[0].Selected;
     CheckBox2.Checked:= Items[1].Selected;
     CheckBox3.Checked:= Items[2].Selected;
     CheckBox4.Checked:= Items[3].Selected;
     CheckBox5.Checked:= Items[4].Selected;
   finally
     Auto:= false;
   end;
end;

procedure TForm1.CheckBoxClick(Sender: TObject);
begin
 if Auto then Exit;

 with ListView1 do begin
   OnChange:= nil;
   try
     Items[0].Selected:= CheckBox1.Checked;
     Items[1].Selected:= CheckBox2.Checked;
     Items[2].Selected:= CheckBox3.Checked;
     Items[3].Selected:= CheckBox4.Checked;
     Items[4].Selected:= CheckBox5.Checked;
   finally
     OnChange:= ListView1Change;
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 ListView1.Items.Count:= 5;
 Auto:= false;
end;

end.

object Form1: TForm1
 Left = 279
 Top = 113
 Width = 401
 Height = 304
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 PixelsPerInch = 96
 TextHeight = 13
 object ListView1: TListView
   Left = 0
   Top = 0
   Width = 121
   Height = 277
   Align = alLeft
   Columns = <
     item
     end>
   FlatScrollBars = True
   MultiSelect = True
   OwnerData = True
   OwnerDraw = True
   ReadOnly = True
   RowSelect = True
   TabOrder = 0
   ViewStyle = vsReport
   OnChange = ListView1Change
   OnDrawItem = ListView1DrawItem
 end
 object CheckBox1: TCheckBox
   Left = 152
   Top = 8
   Width = 97
   Height = 17
   Caption = "CheckBox1"
   TabOrder = 1
   OnClick = CheckBoxClick
 end
 object CheckBox2: TCheckBox
   Left = 152
   Top = 32
   Width = 97
   Height = 17
   Caption = "CheckBox2"
   TabOrder = 2
   OnClick = CheckBoxClick
 end
 object CheckBox3: TCheckBox
   Left = 152
   Top = 56
   Width = 97
   Height = 17
   Caption = "CheckBox3"
   TabOrder = 3
   OnClick = CheckBoxClick
 end
 object CheckBox4: TCheckBox
   Left = 152
   Top = 80
   Width = 97
   Height = 17
   Caption = "CheckBox4"
   TabOrder = 4
   OnClick = CheckBoxClick
 end
 object CheckBox5: TCheckBox
   Left = 152
   Top = 104
   Width = 97
   Height = 17
   Caption = "CheckBox5"
   TabOrder = 5
   OnClick = CheckBoxClick
 end
end


 
sniknik ©   (2011-01-29 20:16) [2]

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
 i: integer;
 b: Boolean;
begin
 i:= Item.Index;
 case i of
   0: b:= CheckBox1.Checked;
   1: b:= CheckBox2.Checked;
   2: b:= CheckBox3.Checked;
   3: b:= CheckBox4.Checked;
   4: b:= CheckBox5.Checked;
 end;

 with Sender.Canvas do begin
   if b then begin
     Brush.Color:= clGreen;
     Font.Color := clWhite;
   end else
     Brush.Color:= clWhite;

   TextRect(Rect, 2 , Rect.Top, "( "+IntToStr(i+1)+" ) "+IntToStr(Byte(b)));

   if odFocused in State then begin
     if b then Pen.Color:= clWhite
          else Pen.Color:= clBlack;
     Brush.Style:= bsClear;
     Rectangle(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom -1);
   end;
 end;
end;


 
Пироги   (2011-01-29 20:36) [3]


> procedure TForm1.CheckBoxClick(Sender: TObject);


Мне не нужен CheckBoxClick, у меня нет никаких чекбоксов, есть массив. Чекбоксы введены временно, только для отловли этого глюка.


> var
>  i: integer;
>  i:= Item.Index;


Зачем менять itInd на ничего не значащее i ? Я не спрашивал во что мне переименовать itInd , я спросил как решить проблему.


 
KilkennyCat ©   (2011-01-29 21:05) [4]


> sniknik ©

спасибо.
это я тебе вместо него сказал, оценив проделанный труд.


 
sniknik ©   (2011-01-29 21:20) [5]

> я спросил как решить проблему.
на это отвечено. прямым текстом. + код расширен, с половинчатого, до более универсального примера. но...
не доходят сообщения? попробуйте перечитать их еще раз...
не доходит после повторного? смени занятие на что попроще, с метлой например потренируйся. вдруг хоть это получится.


 
Andy BitOff ©   (2011-01-29 21:23) [6]

фига, какая наглая школота поперла


 
sniknik ©   (2011-01-29 21:26) [7]

> Мне не нужен CheckBoxClick
мало ли, что тебе не нужно... в примере он более показателен. а если не можешь понять смысл действий, только из-за смены компонента/события... это твои проблемы. или программирование это не твое.


 
sniknik ©   (2011-01-29 21:28) [8]

> фига, какая наглая школота поперла
ну так, он же сюда не учится пришел, а ему тут вдруг код на понимание процесса дали, а не для копи пасте...


 
Inovet ©   (2011-01-29 22:13) [9]

> [3] Пироги   (29.01.11 20:36)
> Я не спрашивал во что мне переименовать itInd , я спросил
> как решить проблему.

Вумный вьюнош? Так зачем сюдв тогда пожаловал? Кстати, i в данном случае понятнее чем itInd, так что учись у тех, кто не первый день, год и даже не перый, о ужас, десяток лет этим занимается. Впрочем, советы по альтернативным видам деятельности тебе тоже дали на твоё же благо.


 
Пироги   (2011-02-03 17:56) [10]


> sniknik ©   (29.01.11 20:12) [1]
>      Items[0].Selected:= CheckBox1.Checked;
>      Items[1].Selected:= CheckBox2.Checked;
>      Items[2].Selected:= CheckBox3.Checked;
>      Items[3].Selected:= CheckBox4.Checked;
>      Items[4].Selected:= CheckBox5.Checked;


Скажите, если у вас миллион значений, то вы так и будете каждый раз засандаливать в миллион Items их значения Selected ? Вместо того, чтобы обновить только отображаемые на экране элементы ListView.


> Andy BitOff ©   (29.01.11 21:23) [6]
> фига, какая наглая школота поперла


Действительно.


 
sniknik ©   (2011-02-03 19:29) [11]

> Скажите, если у вас миллион значений, то вы так и будете каждый раз засандаливать в миллион Items их значения Selected ?
у меня такого бреда не бывает, пример вообще то твой, я только исправил...
и да, придется таки "засандаливать" пока в другой части кода значения этих переменных используются.

> Вместо того, чтобы обновить только отображаемые на экране элементы ListView.
флаг в руки, считаешь что знаешь лучше всех? тогда не спрашивай. делай!
но пока твои измышления не работают - учись.


 
Пироги   (2011-03-10 20:43) [12]


> sniknik ©   (03.02.11 19:29) [11]
>
> > Скажите, если у вас миллион значений, то вы так и будете
> каждый раз засандаливать в миллион Items их значения Selected
> ?
> у меня такого бреда не бывает, пример вообще то твой, я
> только исправил...
> и да, придется таки "засандаливать" пока в другой части
> кода значения этих переменных используются.


То есть как работать с событие OnData вы не знаете. Понятно.
Так бы сразу и сказали.

Прежде чем советовать лучше сначала научиться. Потому, что кому нужны советы от того, кто ничего не знает. Верно?


 
KilkennyCat ©   (2011-03-10 21:33) [13]


> событие OnData

че-то не видать его в коде.


 
sniknik ©   (2011-03-10 22:10) [14]

> То есть как работать с событие OnData вы не знаете.
да че там учится то? наливай да пей!
был бы OnData в исходном, кривом коде исправил бы и с ним. а так... "я его слепила из того, что было".

> Потому, что кому нужны советы от того, кто ничего не знает.
тому кто знает еще меньше. если он конечно хочет учится... а тебе бы пора научится тому, что переменные нужно инициализировать перед использованием... или не использовать.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2011.06.19;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.52 MB
Время: 0.003 c
11-1212932481
Psy
2008-06-08 17:41
2011.06.19
Баг Grush


15-1298035148
Palladin
2011-02-18 16:19
2011.06.19
Почему у Спока


15-1298375142
Empleado
2011-02-22 14:45
2011.06.19
Goto in Delphi


15-1298680305
KilkennyCat
2011-02-26 03:31
2011.06.19
Никсовая сборка-роутер?


15-1298755792
Юрий
2011-02-27 00:29
2011.06.19
С днем рождения ! 27 февраля 2011 воскресенье





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский