Выделить строчку айтема в листбоксе

← →
Polenov (2005-05-19 10:48) [0]

Помогите, пожалуйста!! Мне нужно определенные айтемы в листбоксе как-ниб. выделить (сделать жирным или другим цветом). По идее нужно использовать OnDrawItem, только я понятия не имею как его использовать. В хелпе не понял ничего, в лит-ре не нашел... Подскажите кто знает!!!

← →
Игорь Шевченко © (2005-05-19 10:54) [1]

http://www.schevchenko.net.ru/SRC/EnumFunctions_60.zip

Там этих примеров есть

← →
Polenov (2005-05-19 19:27) [2]

Спасибо!!! Это мне очень помогло. Код абсолютно понятный.
А теперь столкнулся с другой проблемой: в листбоксе нет горизонтального скроллинга. Нашёл в одной книжке, что можно использовать Perform(...) с сообщением LB_SETHORIZONTALEXTENT, но что-то не работает... В хелпе не нашел. Может Delphi 7 не поддерживает это сообщение... Помогите кто может!!!!!

← →
begin...end © (2005-05-19 19:45) [3]

> Polenov (19.05.05 19:27) [2]

> Нашёл в одной книжке, что можно использовать Perform(...)
> с сообщением LB_SETHORIZONTALEXTENT, но что-то не работает...

Значит, что-то неправильно делаете. Как Вы это делаете, Вы не уточнили. Следовательно, определить, что именно неправильно, нельзя.

> В хелпе не нашел.

Вероятно, не в том хелпе смотрели.

> Может Delphi 7 не поддерживает это сообщение...

Поддерживает.

> Помогите кто может!!!!!

По крайней мере, в Delphi 7 у TListBox есть свойство ScrollWidth. При его изменении listbox"у как раз будет посылаться LB_SETHORIZONTALEXTENT. Так что лучше посмотреть описание этого свойства в справке и воспользоваться им.

← →
Polenov (2005-05-19 20:19) [4]

Цитирую:
I. Как получить горизонтальную прокрутку (scrollbar) в ListBox? Так же как в случае с TMemo, здесь можно использовать сообщения. Например, сообщение может быть отослано в момент создания формы: procedure TForm1.FormCreate(Sender: TObject); begin ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0)); end; Второй параметр в вызове - ширина прокрутки в точках.

Если у меня некая строка не помещается в айтем листбокса, как рациональнее всего расширить скроллинг ???

← →
Polenov (2005-05-19 20:52) [5]

Для того, чтобы скроллинг увеличивался ровно настолько, насколько не влазит строка в айтем .

← →
charlie (2005-05-19 20:56) [6]

Надо поискать книжку Пачеко, так как раз такая модификация TListBox приведена в качестве примера. Если я найду у себя исходник, тогда выложу

← →
charlie (2005-05-19 21:04) [7]

Ага, вот, попробуй

{
Copyright © 1998 by Delphi 4 Developer"s Guide - Xavier Pacheco and Steve Teixeira
}

unit Lbtab;

interface

uses
SysUtils, Windows, Messages, Classes, Controls, StdCtrls;

type

EddgTabListboxError = class(Exception);

TddgTabListBox = class(TListBox)
private
FLongestString: Word;
FNumTabStops: Word;
FTabStops: PWord;
FSizeAfterDel: Boolean;
function GetLBStringLength(S: String): word;
procedure FindLongestString;
procedure SetScrollLength(S: String);
procedure LBAddString(var Msg: TMessage); message lb_AddString;
procedure LBInsertString(var Msg: TMessage); message lb_InsertString;
procedure LBDeleteString(var Msg: TMessage); message lb_DeleteString;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
procedure SetTabStops(A: array of word);
published
property SizeAfterDel: Boolean read FSizeAfterDel write FSizeAfterDel default True;
end;

implementation

uses PixDlg;

constructor TddgTabListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSizeAfterDel := True;
{ set tab stops to Windows defaults... }
FNumTabStops := 1;
GetMem(FTabStops, SizeOf(Word) * FNumTabStops);
FTabStops^ := DialogUnitsToPixelsX(32);
end;

procedure TddgTabListBox.SetTabStops(A: array of word);
{ This procedure sets the listbox"s tabstops to those specified
in the open array of word, A. New tabstops are in pixels, and must
be in ascending order. An exception will be raised if new tabs
fail to set. }
var
i: word;
TempTab: word;
TempBuf: PWord;
begin
{ Store new values in temps in case exception occurs in setting tabs }
TempTab := High(A) + 1; // Figure number of tabstops
GetMem(TempBuf, SizeOf(A)); // Allocate new tabstops
Move(A, TempBuf^, SizeOf(A));// copy new tabstops }
{ convert from pixels to dialog units, and... }
for i := 0 to TempTab - 1 do
A[i] := PixelsToDialogUnitsX(A[i]);
{ Send new tabstops to listbox. Note that we must use dialog units. }
if Perform(lb_SetTabStops, TempTab, Longint(@A)) = 0 then
begin
{ if zero, then failed to set new tabstops, free temp
tabstop buffer and raise an exception }
FreeMem(TempBuf, SizeOf(Word) * TempTab);
raise EddgTabListboxError.Create("Failed to set tabs.")
end
else begin
{ if nonzero, then new tabstops set okay, so
Free previous tabstops }
FreeMem(FTabStops, SizeOf(Word) * FNumTabStops);
{ copy values from temps... }
FNumTabStops := TempTab; // set number of tabstops
FTabStops := TempBuf; // set tabstop buffer
FindLongestString; // reset scrollbar
Invalidate; // repaint
end;
end;

procedure TddgTabListBox.CreateParams(var Params: TCreateParams);
{ We must OR in the styles necessary for tabs and horizontal scrolling
These styles will be used by the API CreateWindowEx() function. }
begin
inherited CreateParams(Params);
{ lbs_UseTabStops style allows tabs in listbox
ws_HScroll style allows horizontal scrollbar in listbox }
Params.Style := Params.Style or lbs_UseTabStops or ws_HScroll;
end;

function TddgTabListBox.GetLBStringLength(S: String): word;
{ This function returns the length of the listbox string S in pixels }
var
Size: Integer;
begin
// Get the length of the text string
Canvas.Font := Font;
Result := LoWord(GetTabbedTextExtent(Canvas.Handle, PChar(S),
StrLen(PChar(S)), FNumTabStops, FTabStops^));
// Add a little bit of space to the end of the scrollbar extent for looks
Size := Canvas.TextWidth("X");
Inc(Result, Size);
end;

procedure TddgTabListBox.SetScrollLength(S: String);
{ This procedure resets the scrollbar extent if S is longer than the }
{ previous longest string }
var
Extent: Word;
begin
Extent := GetLBStringLength(S);
// If this turns out to be the longest string...
if Extent > FLongestString then
begin
// reset longest string
FLongestString := Extent;
//reset scrollbar extent
Perform(lb_SetHorizontalExtent, Extent, 0);
end;
end;

procedure TddgTabListBox.LBInsertString(var Msg: TMessage);
{ This procedure is called in response to a lb_InsertString message.
This message is sent to the listbox every time a string is inserted.
Msg.lParam holds a pointer to the null-terminated string being
inserted. This will cause the scrollbar length to be adjusted if
the new string is longer than any of the existing strings. }
begin
inherited;
SetScrollLength(PChar(Msg.lParam));
end;

procedure TddgTabListBox.LBAddString(var Msg: TMessage);
{ This procedure is called in response to a lb_AddString message.
This message is sent to the listbox every time a string is added.
Msg.lParam holds a pointer to the null-terminated string being
added. This Will cause the scrollbar length to be ajdusted if the
new string is longer than any of the existing strings.}
begin
inherited;
SetScrollLength(PChar(Msg.lParam));
end;

procedure TddgTabListBox.FindLongestString;
var
i: word;
Strg: String;
begin
FLongestString := 0;
{ iterate through strings and look for new longest string }
for i := 0 to Items.Count - 1 do
begin
Strg := Items[i];
SetScrollLength(Strg);
end;
end;

procedure TddgTabListBox.LBDeleteString(var Msg: TMessage);
{ This procedure is called in response to a lb_DeleteString message.
This message is sent to the listbox everytime a string is deleted.
Msg.wParam holds the index of the item being deleted. Note that
by setting the SizeAfterDel property to False, you can cause the
scrollbar update to not occur. This will improve performance
if you"re deleting often. }
var
Str: String;
begin
if FSizeAfterDel then
begin
Str := Items[Msg.wParam]; // Get string to be deleted
inherited; // Delete string
{ Is deleted string the longest? }
if GetLBStringLength(Str) = FLongestString then
FindLongestString;
end
else
inherited;
end;

end.

{
Copyright © 1999 by Delphi 5 Developer"s Guide - Xavier Pacheco and Steve Teixeira
}

unit Pixdlg;

interface

function DialogUnitsToPixelsX(DlgUnits: word): word;
function DialogUnitsToPixelsY(DlgUnits: word): word;
function PixelsToDialogUnitsX(PixUnits: word): word;
function PixelsToDialogUnitsY(PixUnits: word): word;

implementation

uses WinProcs;

function DialogUnitsToPixelsX(DlgUnits: word): word;
begin
Result := (DlgUnits * LoWord(GetDialogBaseUnits)) div 4;
end;

function DialogUnitsToPixelsY(DlgUnits: word): word;
begin
Result := (DlgUnits * HiWord(GetDialogBaseUnits)) div 8;
end;

function PixelsToDialogUnitsX(PixUnits: word): word;
begin
Result := PixUnits * 4 div LoWord(GetDialogBaseUnits);
end;

function PixelsToDialogUnitsY(PixUnits: word): word;
begin
Result := PixUnits * 8 div HiWord(GetDialogBaseUnits);
end;

end.

← →
Polenov (2005-05-19 21:06) [8]

Заранее спасибо =))

← →
Polenov (2005-05-19 21:43) [9]

Большое спасибо! Очень умный компонент!

← →
charlie (2005-05-19 21:51) [10]

not at all)

Выделить строчку айтема в листбоксе Найти похожие ветки