:: MVP ::
|
|
:: RSS ::
|
|
|
Как добавить горизонтальную полосу прокрутки в TListBox?
// Этот код находит ширину, в пикселях,
// самой длинной строки в окне списка.
// Два дополнительных пиксела добавлены к MaxWidth,
// чтобы сдвинуть оконечные символы от правой границы окна списка.
procedure TForm1.FormCreate(Sender: TObject);
var
i, MaxWidth: integer;
begin
MaxWidth := 0;
for i := 0 to ListBox1.Items.Count - 1 do
if MaxWidth < ListBox1.Canvas.TextWidth( ListBox1.Items.Strings[i] ) then
MaxWidth := ListBox1.Canvas.TextWidth( ListBox1.Items.Strings[i] );
SendMessage( ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0 );
end;
|
Как поместить картинки в ListBox?
// ListBox1.Style = lbOwnerDrawFixed, при этом,
// на форме должен быть ImageList1 c набором иконок
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
// Заполняем прямоугольник
ListBox1.Canvas.FillRect( Rect );
// Рисуем иконку
ImageList1.Draw( ListBox1.Canvas, Rect.Left, Rect.Top, Index );
// Пишем текст после иконки
ListBox1.Canvas.TextOut( Rect.Left + ImageList1.Width + 2, Rect.Top,
ListBox1.Items[Index] );
end;
|
Как в TListBox перетаскивать итемы?
// ListBox1.DragMode = dmAutomatic
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := True;
end;
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
NewIndex: integer;
begin
with Sender as TListBox do
begin
NewIndex := ItemAtPos( Point( X, Y ), True );
Items.Move( ItemIndex, NewIndex );
ItemIndex:= NewIndex;
end;
end;
|
Как осуществить быстрый поиск в ListBox?
// ListBox1.MultiSelect = false
// Этим способом можно искать не только по полному совпадению,
// но и по начальным символам строки.
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Perform( LB_SELECTSTRING, ListBox1.ItemIndex,
longint( Pchar( Edit1.text ) ) );
end;
// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := Edit1.Text;
with ListBox1 do
ItemIndex := Perform( LB_SELECTSTRING, ItemIndex, LongInt( s ) );
end;
|
Как показывать хинты для частично видимых элементов ListBox?
// ListBox1.ShowHint = true
var
Form1: TForm1;
OldIdx: Longint = -1;
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Idx: Longint;
begin
with Sender as TListBox do
begin
Idx := ItemAtPos( Point( x, y ), True );
if ( Idx < 0 ) or ( Idx = OldIdx ) then Exit;
Application.ProcessMessages;
Application.CancelHint;
OldIdx := Idx;
Hint := '';
if Canvas.TextWidth( Items[Idx] ) > ( ( Sender as TListBox ).Width - 4 ) then
Hint := Items[Idx];
end;
end;
|
Как изменить фоновый цвет текста в различных строчках TListBox?
// TListBox.Style = lbOwnerDrawFixed
// Если не изменить свойство Style,
// то событие OnDrawItem никогда не вызовется.
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
myColor: TColor;
myBrush: TBrush;
begin
myBrush := TBrush.Create;
with ( Control as TListBox ).Canvas do
begin
if not Odd( Index ) then
myColor := clSilver
else
myColor := clYellow;
myBrush.Style := bsSolid;
myBrush.Color := myColor;
Windows.FillRect( Handle, Rect, myBrush.Handle );
Brush.Style := bsClear;
TextOut( Rect.Left, Rect.Top, ( Control as TListBox ).Items[Index] );
MyBrush.Free;
end;
end;
// или немного по-другому
// TListBox.Style = lbOwnerDrawFixed
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
With ListBox1 do
begin
if odSelected in State then
Canvas.Brush.Color := clTeal
else
Canvas.Brush.Color := clWindow;
Canvas.FillRect( Rect );
Canvas.TextOut( Rect.Left + 2, Rect.Top, Items[Index] );
end;
end;
|
Как из TListBox убрать вертикальный ScrollBar?
type
TListBoxNoVScroll = class(TListBox)
public
procedure CreateParams( var Params: TCreateParams ); override;
end;
var
Form1: TForm1;
MyListBox: TListBoxNoVScroll;
implementation
{$R *.dfm}
{ TListBoxNoVScroll }
procedure TListBoxNoVScroll.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams( Params );
Params.Style := Params.Style and not WS_VSCROLL;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: byte;
begin
MyListBox := TListBoxNoVScroll.Create( Self );
MyListBox.Parent := Form1;
for i := 0 to 50 do
MyListBox.Items.Add( IntToStr( i ) );
MyListBox.Show;
end;
|
Как изменить шрифт в TListBox на моноширный?
// SYSTEM_FIXED_FONT или ANSI_FIXED_FONT
procedure TForm1.FormCreate(Sender: TObject);
begin
SendMessage( ListBox1.Handle, WM_SETFONT,
GetStockObject( SYSTEM_FIXED_FONT ), 1 );
end;
|
Как обработать щелчок мыши в пустой области TListBox?
// Способ первый
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
with Sender as TListBox do
begin
if ItemAtPos(Point(X, Y), True) = -1 then
if ssDouble in Shift then
ShowMessage('Двойной щелчок в пустой области ListBox');
end;
end;
end;
// Способ второй
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
p: TPoint;
begin
GetCursorPos(p);
if ListBox1.ItemAtPos(ListBox1.ScreenToClient(p), True) = -1 then
ShowMessage('Двойной щелчок в пустой области ListBox');
end;
|
При использовании материала - ссылка на сайт обязательна
|
|