Последние записи
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
- Взаимодействие через командную строку
- Сравнение языков на массивах. Часть 1
- Сравнение языков по скорости
- Чтение огромных xml-файлов
- Как в Python+Selenium webdriver открыть новую вкладку в уже открытом браузере?
Интенсив по 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 (Компьютерное железо)