| Autor | Správa |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Ne 15.11.09 18:04 |   |
zrejme low ale ako dosiahnem zavolanie tejto procedury napr. pri button onclick?
| kód: | procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
if Index = 2 then
begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clBlack;
end
else
begin
(Control as TListbox).Canvas.Brush.Color := clBlack;
(Control as TListbox).Canvas.Font.Color := clWhite;
end;
(Control as TListbox).Canvas.FillRect(Rect);
(Control as TListbox).Canvas.TextOut(Rect.Left+2,Rect.Top+2,
(Control as TListbox).Items[Index]);
end;
|
|
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1051
 | Zaslal: Ne 15.11.09 22:50 |   |
Pochopil som správne, aby sa po stlačení buttonu vykreslil ListBox (teda zavolala vykresľovacia procedúra) ?
Ak áno, dá sa to takto, ale podľa mňa to je trocha neprofesionálne, keďže hneď po kliknutí na iné miesto, sa ListBox zobrazí ako predtým:
| kód: | procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Style:= lbOwnerDrawFixed;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1DrawItem(ListBox1, ListBox1.ItemIndex, ListBox1.ItemRect(ListBox1.ItemIndex), [odFocused]);
end; |
Na forme je jeden ListBox, jeden Button a procedúra ListBox1DrawItem v mojom kóde je hore uvedená procedúra. |
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 |
No asi som to zle zadefinoval. Chcel by som to tak ze mam listbox (naplni sa pri behu programu) a teraz ked kliknem na button1 tak sa tretia polozka sfarbi na cerveno (iba text nie pozadie), pricom to zostane tak. Cize pri kliku na listbox sa to nezmeni. V podstate chcem vysviecovat a zhasinat urcite zaznamy pri urcitej akcii. |
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1051
 | Zaslal: Po 16.11.09 14:20 |   |
OK, ešte jedna otázka: Keďže po kliku na button má ostať ListBox nezmenený, čo sa farieb týka, z toho mi vyplýva, že buď sa na ten button počas programu môže kliknúť iba raz (tzn od kliknutia na button sa začne ListBox vyfarbovať podľa potrieb až do ukončenia programu) alebo sú buttony dva, pričom jeden zapína vykresľovanie ListBoxu a druhý ho vypína.
Prvý spôsob by vezeral takto:
| kód: |
var access: boolean = false;
// ...
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clBlack;
if (access) then begin
if ( (State = [odFocused, odSelected]) or (State = [odSelected]) or (State = [odFocused])) then
(Control as TListbox).Canvas.Font.Color:= clRed
else
(Control as TListbox).Canvas.Font.Color:= clBlack;
end;
(Control as TListbox).Canvas.FillRect(Rect);
(Control as TListbox).Canvas.TextOut(Rect.Left+2,Rect.Top, (Control as TListbox).Items[Index]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Style:= lbOwnerDrawFixed;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
access:= true;
ListBox1DrawItem(ListBox1, ListBox1.ItemIndex, ListBox1.ItemRect(ListBox1.ItemIndex), [odSelected]);
end; |
(* V ObjectInspectore treba vybrať pre ListBox udalosť onDrawItem a pastnuť tam tento kód a tak isto aj pre OnCreate a OnClick, pretože len skopíraovním tohto kódu do editora to nepôjde, keďže nie sú procedúry priradené udalostiam komponentov - píšem to, pretože niektorí uživatelia píšu, že im kód nefunguje, lebo ich iba surovo skopírovali a vložili bez priradenia *)
Text bude po stlačení buttonu sfarbený do červena (aj po odobratí focusu) a farba pozadia ostane nezmenená. |
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Po 16.11.09 14:39 |   |
dik.
No potreboval by som to na pevne urcenu napr. tretiu polozku. a dalsia vec ked klikam po listboxe tak to sfarbuje zakazdym vybranu polozku. Potreboval by som to tak ze iba button1 by treti item sfarbil a button2 odfarbil, pricom by pohyb (klikanie) po listboxe farby niako neovplyvnovalo
to by malo byt presne to co potrebujem |
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1051
 | Zaslal: Po 16.11.09 15:27 |   |
Snáď to už bude dobre
| kód: | var
access: boolean = false;
cisloPolozky: integer = 2; // tretia polozka
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clBlack;
if ((access) and (Index = cisloPolozky)) then begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clRed;
end;
(Control as TListbox).Canvas.FillRect(Rect);
(Control as TListbox).Canvas.TextOut(Rect.Left+2,Rect.Top, (Control as TListbox).Items[Index]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Style:= lbOwnerDrawFixed;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Button2.Click;
access:= true;
cisloPolozky:= StrToInt(Edit1.Text);
ListBox1DrawItem(ListBox1, cisloPolozky, ListBox1.ItemRect(cisloPolozky), [odSelected]);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
access:= false;
ListBox1DrawItem(ListBox1, cisloPolozky, ListBox1.ItemRect(cisloPolozky), [odSelected]);
end; |
Nevedel som, či sa má pozícia vykreslovaného riadku meniť, tak som určil, že sa meniť môže, konkrétne, že sa zadáva do Editu --> cisloPolozky:= StrToInt(Edit1.Text). V prípade, že má byť počas celého behu programu konštantné, tak stačí odstrániť v procedúre TForm1.Button1Click(Sender: TObject) riadky Button2.Click; a cisloPolozky:= StrToInt(Edit1.Text); |
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Po 16.11.09 16:10 |   |
Skvele! presne takyto model som potreboval. Teraz si to uz vlozim do projektu diki moc |
| |
  |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Po 16.11.09 16:50 |   |
a este by som rad to vyznacovanie pozadia pri oznaceni polozky. Skusal som to ze som pridal prvy riadok ale nieje to dobre. Ostava to sfarbene.
| kód: |
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
if index= (Control as TListbox).itemindex then (Control as TListbox).Canvas.Brush.Color := clBlue else
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clBlack;
if ((access) and (Index = cisloPolozky)) then begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clRed;
end;
(Control as TListbox).Canvas.FillRect(Rect);
(Control as TListbox).Canvas.TextOut(Rect.Left+2,Rect.Top, (Control as TListbox).Items[Index]);
end;
|
|
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1051
 | Zaslal: Po 16.11.09 17:37 |   |
Za predpokladu, že sa pôvodná vykresľovaná položka nemá farebne meniť, tak takto:
| kód: | procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clBlack;
if ((State = [odSelected]) or (State = [odSelected, odFocused])) then
if ((Control as TListbox).Selected[Index]) then
(Control as TListbox).Canvas.Brush.Color := clBlue;
if ((access) and (Index = cisloPolozky)) then begin
(Control as TListbox).Canvas.Brush.Color := clWhite;
(Control as TListbox).Canvas.Font.Color := clRed;
end;
(Control as TListbox).Canvas.FillRect(Rect);
(Control as TListbox).Canvas.TextOut(Rect.Left+2,Rect.Top, (Control as TListbox).Items[Index]);
end; |
|
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Po 16.11.09 17:52 |   |
Vdaka za ochotu  |
| |
  |
 |
|