
Последние записи
- Как из ip адреса вывести последние цифры
- Вставка символа Unicode в RichEdit в Delphi 7
- Как поменять иконки все папок Windows 11 со стандартной желтой на свою?
- WinIO для чтения/записи портов I/O и физической памяти
- Delphi: Вывести N директорий в заданной (без рекурсии вложенных папок)
- Дополнительные кнопки мышки
- Курсы программистов. Стоит ли?
- Удаление одинаковых строк
- Создание потоков в процессе
- Вывод на печать графического файла

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
18th
Апр
Графический ListBox
Posted by obzor under Delphi
Есть ли у кого-то графический ListBox на подобии UserListBox либо же адаптированный под XE7. Данный компонент устанавливается без проблем, но когда бросаешь на форму куча не достающих *.dcu. Либо же как добавить изображение от и больше 32*32 в стандартный ListBox.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure Button1Click(Sender: TObject);
private
FImgList: TImageList;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ShellAPI, ImgList;
function GetIconIndex(const FileName: string): Integer;
var
FileInfo: TSHFileInfo;
begin
SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX);
Result := FileInfo.iIcon;
end;
function GetSysImgListHandle: THandle;
var
FileInfo: TSHFileInfo;
begin
Result := SHGetFileInfo(nil, 0, FileInfo, SizeOf(FileInfo),
SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FImgList := TImageList.Create(Self);
FImgList.Handle := GetSysImgListHandle;
FImgList.DrawingStyle := dsTransparent;
FImgList.ShareImages := True;
ListBox1.Style := lbOwnerDrawVariable;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
S: string;
LB: TListBox;
begin
LB := TListBox(Control);
S := LB.Items[Index];
with LB.Canvas do
begin
FillRect(Rect);
with Rect do
begin
FImgList.Draw(LB.Canvas, Left + 1, Top + 1, GetIconIndex(S));
TextOut(Left + FImgList.Width + 5, Top + (Bottom - Top - TextHeight(S)) div 2, S);
end;
if odFocused in State then
DrawFocusRect(Rect);
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
Height := FImgList.Height + 2;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
with OpenDialog1 do
if Execute then
ListBox1.Items.Add(FileName);
end;
end.
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту

пеллетные котлы

Пеллетный котел Emtas

Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)