TListView

TListView в режиме отчета под манифестом XP

2017-09-01T18:54:31+07:00

В TListView со стилем vsReport вызывает нарушение прав доступа когда вы запустите свой проект с ХР манифеста ресурса.

Фантик в VCL есть ошибка и вы должны источник пропатчить.

Просто скопируйте comctrls.pas в папку с вашим собственным проектом и измените метод UpdateColumn.

После компиляции проекта, comctrls.dcu и вы можете заменить оригинальный comctrls.dcu с

пропатчил один.

Подробнее...

Virtual ListView с контекстным меню

2017-08-31T21:22:01+07:00

В Delphi5/Demos есть пример Virtual ListView. программка чем-то напоминает explorer, но без контекстного меню. контекстное меню приделывается так:

Подробнее...

Двоичный поиск для TListView

2017-08-31T21:48:43+07:00

Function ListviewBinarySearch

| Parameters :

| listview: listview to search, assumed to be sorted, must

| be <> nil.

| Item : item caption to search for, cannot be empty

| index : returns the index of the found item, or the

| index where the item should be inserted if it is not

| already in the list.

| Returns : True if there is an item with the passed caption

| in the list, false otherwise.

| Description:

| Uses a binary search and assumes that the listview is sorted

| ascending on the caption of the listitems. The search is

| case-sensitive, like the default alpha-sort routine used by

| the TListview class.

| Note:

| We use the lstrcmp function for string comparison since it

| is the function used by the default alpha sort routine. If

| the listview is sorted by another means (e.g. OnCompare event)

| this needs to be changed, the comparison method used must

| always be the same one used to sort the listview, or the

| search will not work!

| Error Conditions: none

Подробнее...

Дерево каталогов

2017-08-31T21:23:28+07:00

Сегодня поговорим о том, как при помощи TreeView сделать дерево каталогов, то есть нечто, вроде левой части Проводника. Самый простой способ - это при запуске программы найти все каталоги на диске и засунуть их в TreeView. Но у этого способа есть несколько недостатков. Во-первых, он долгий, особенно, если включен zif. Во-вторых, даже если закрыть и открыть какую-то папку, она не обновится. Поэтому лучше всего вначале сделать в TreeView список дисков со значком "+", то есть указать, что на диске есть каталоги. Это не всегда верно, но проверять, правда ли это, долго из-за дисковода. При попытке раскрыть каталог или диск программа ищет подкаталоги и добавляет их в ListView. В каждом подкаталоге программа пытается найти хотя бы один подкаталог. В зависимости от результатов поиска "+" появляется или нет.

В этой программе используются иконки из файла FileCtrl.res, находящемся в каталоге "Delphi5\lib".

Подробнее...

Добавить событие onDblClick на заголовке TListView

2017-08-31T21:51:27+07:00

MS did not see fit to send a notification to the listview when the user Double - clicks on the header. But the header control class does have the

CS_DBLCLKS Style, so it does get WM_LBUTTONDBLCLK messages, it just does not do anything with them. To get at these messages requires API - Style

subclassing of the header control.

Подробнее...

Запретить Hint в TTreeView

2017-08-31T21:28:12+07:00

Code:

const

TVS_NOTOOLTIPS = $80;

begin

with treeview1 do

SetWindowLong(Handle, GWL_STYLE,

GetWindowLong(Handle, GWL_STYLE)

or TVS_NOTOOLTIPS);

end;

Искать текст в TListView

2017-08-31T21:52:57+07:00

// Call FindCaption Method to search for a list view item labeled by the

// string specified as the Value parameter

Подробнее...

Как ListView перевести в режим редактирования по нажатию на F2

2017-08-31T21:54:12+07:00

Code:

procedure TForm1.ListView1KeyDown(Sender: TObject;

var Key: Word; Shift: TShiftState);

begin

if Ord(Key) = VK_F2 then

ListView1.Selected.EditCaption;

end;

Как добовлять в ListView полноцветные иконки?

2017-08-31T21:25:15+07:00

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

SysIL : THandle;

SysSIL : THandle;

SFI : TSHFileInfo;

begin

SysImageList1 := TImageList.Create(self);

with SysImageList1 do begin

Width := 16;

Height := 16;

SysSIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI),

SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

if SysSIL <> 0 then begin

SysImageList1.Handle := SysSIL;

ShareImages := True;

end;

SysImageList2 := TImageList.Create(self);

with SysImageList2 do begin

Width := 32;

Height := 32;

SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI),

SHGFI_SYSICONINDEX or SHGFI_LARGEICON);

if SysIL <> 0 then begin

SysImageList2.Handle := SysIL;

ShareImages := True;

end;

function GetIconIndex(const AFile: string; Attrs: DWORD): integer;

var

SFI: TSHFileInfo;

begin

SHGetFileInfo(PChar(AFile), Attrs, SFI, SizeOf(TSHFileInfo),

SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);

Result := SFI.iIcon;

end;

....

with ListView.Items.Add do begin

Caption := FName;

ImageIndex := GetIconIndex(Caption, FILE_ATTRIBUTE_NORMAL);

SubItems.Add(FSize);

SubItems.Add(FType);

SubItems.Add(FDateTime);

end;

Как поменять цвет Header'а в TListView

2017-08-31T21:26:31+07:00

Для этого нужно в оконной процедуре ListView обработать сообщение WM_NOTIFY с кодом NM_CUSTOMDRAW. И в обработчике этого сообщения назначить цвета фона и текста (можно назначить и шрифт). Но при этом правая часть header'а (область заголовка ListView, находящаяся справа от колонок) закрашиваться не будет. Чтобы закрасить и её, надо в оконной процедуре header'а обработать сообщение WM_ERASEBKGND, в котором и залить нужным цветом эту область. Ниже - небольшой примерчик с сабклассингом.

Подробнее...

Как поместить картинку в заголовок TListView?

2017-08-31T20:44:02+07:00

Иногда бывает полезно в заголовке колонки показывать стрелочку, чтобы информировать пользователя, по какой колонке идёт сортировка. Добавьте следующий код в форму:

Подробнее...

Как узнать, по какой колонке был клик в TListView?

2017-08-31T20:55:38+07:00

Метод GetItemAt позволяет получить координаты ListItem, по которой был клик, но только для первой колонки TListView. Если нужно узнать по какому элементу из другой колонки кликнул пользователь, то прийдётся объявить новый метод в наследованном классе:

Подробнее...

Невизуальное дерево

2017-08-31T21:31:17+07:00

Класс TEctoSoftTree представляет собой невизуальное дерево для манипулирования древоподобными структурами в памяти. Мной в очередной раз из любви к искусству

был изобретен велосипед :))), который тем не менее получился вполне съедобным и несмотря на наличие других вариантов решения задачи будет использоваться мной

хотя бы назло врагам :) Буду рад если еще кому-то он придется по вкусу. Просьба при внесении изменений и дополнений в код, а также обнаружении ошибок

(которых здесь нет ;) уведомить автора, т.е. меня

Малышев Владимир aka "мыш"

Подробнее...

Обмен значениями элементов TListView

2017-08-31T21:57:33+07:00

Сегодня я хочу рассказать, как можно заменить некоторые элементы в стандартный TListView.

Например, у вас есть 5 пунктов и хотите поменять местами первый и третий элементы

Проблема, что стандартный компонент TListView не такой способ и вы должны понимать это сами.

Мы помним, что стандартный путь от старого Паскаля раза (для чисел):

Подробнее...

Определить нажатие на CheckBoxe TListView

2017-09-01T16:03:16+07:00

Code:

procedure TForm1.ListView1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Item: TListItem;

HitTest: THitTests;

begin

// Welchem Item gehцrt die CheckBox

// Which item belongs to the checkbox

Item := ListView1.GetItemAt(x, y);

// Was wurde vom Item genau angeklickt

// What kind of thing was hit on the item

HitTest := ListView1.GetHitTestInfoAt(x, y);

// Falls ein Item angeklickt wurde und davon die Checkbox

// If an Item was hit and exactly his checkbox

if (Item <> nil) and (HitTest = [htOnStateIcon]) then

begin

////////////////////////////////

// Hier das OnCheck behandeln //

// Handle OnCheck here //

////////////////////////////////

// Beispiel

// Example

// if Item.Checked = False then

// begin

// if (Item.Index = 0) or (ListView1.Items.Item[Item.Index - 1].Checked = True) then

// Item.Checked := True else Item.Checked := False;

// end else

// begin

// if (Item.Index = ListView1.Items.Count - 1) or (ListView1.Items.Item[Item.Index + 1].Checked = False) then Item.Checked := False else

// Item.Checked := True;

// end;

end;

Отображать элементы TListView как группу XP

2017-09-01T18:38:13+07:00

Code:

// declarations from commctrl.h

type

TLVGROUP = record

cbSize: UINT;

mask: UINT;

pszHeader: LPWSTR;

cchHeader: Integer;

pszFooter: LPWSTR;

cchFooter: Integer;

iGroupIdL: Integer;

stateMask: UINT;

state: UINT;

uAlign: UINT;

end;

tagLVITEMA = packed record

mask: UINT;

iItem: Integer;

iSubItem: Integer;

state: UINT;

stateMask: UINT;

pszText: PAnsiChar;

cchTextMax: Integer;

iImage: Integer;

lParam: lParam;

iIndent: Integer;

iGroupId: Integer;

cColumns: UINT;

puColumns: PUINT;

end;

TLVITEMA = tagLVITEMA;

const

LVM_ENABLEGROUPVIEW = LVM_FIRST + 157;

LVM_MOVEITEMTOGROUP = LVM_FIRST + 154;

LVM_INSERTGROUP = LVM_FIRST + 145;

LVIF_GROUPID = $0100;

LVGF_HEADER = $00000001;

LVGF_ALIGN = $00000008;

LVGF_GROUPID = $00000010;

LVGA_HEADER_LEFT = $00000001;

LVGA_HEADER_CENTER = $00000002;

LVGA_HEADER_RIGHT = $00000004;

procedure TForm1.Button1Click(Sender: TObject);

var

LvGroup: TLVGROUP;

LvItemA: TLVITEMA;

ListItem: TListItem;

I: Byte;

begin

// Fill listview with random data

Randomize;

for i := 1 to 10 do

begin

ListItem := ListView1.Items.Add;

ListItem.Caption := IntToStr(Random(100));

end;

SendMessage(ListView1.Handle, LVM_ENABLEGROUPVIEW, 1, 0);

// Create Group1

FillChar(LvGroup, SizeOf(TLVGROUP), 0);

with LvGroup do

begin

cbSize := SizeOf(TLVGROUP);

mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;

pszHeader := 'Group 1';

cchHeader := Length(LvGroup.pszHeader);

iGroupIdL := 0;

uAlign := LVGA_HEADER_CENTER;

end;

SendMessage(ListView1.Handle, LVM_INSERTGROUP, 0, Longint(@LvGroup));

// Create Group2

FillChar(LvGroup, SizeOf(LvGroup), 0);

with LvGroup do

begin

cbSize := SizeOf(TLVGROUP);

mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;

pszHeader := 'Group 2';

cchHeader := Length(LvGroup.pszHeader);

iGroupIdL := 1;

uAlign := LVGA_HEADER_LEFT

end;

SendMessage(ListView1.Handle, LVM_INSERTGROUP, 1, Longint(@LvGroup));

// Assign items to the groups

for I := 0 to ListView1.Items.Count - 1 do

begin

with LvItemA do

begin

FillChar(LvItemA, SizeOf(TLvItemA), 0);

mask := LVIF_GROUPID;

iItem := I;

iGroupId := Random(2);

end;

SendMessage(ListView1.Handle, LVM_SETITEM, 0, Longint(@LvItemA))

end;

// XPManifest needed!

Переместить элемент в TListView

2017-09-01T18:39:08+07:00

Code:

// Move item 1 after item 4

function MoveListViewItem(listView: TListView; ItemFrom, ItemTo: Word): Boolean;

var

Source, Target: TListItem;

begin

Result := False;

listview.Items.BeginUpdate;

try

Source := listview.Items[ItemFrom];

Target := listview.Items.Insert(ItemTo);

Target.Assign(Source);

Source.Free;

Result := True;

finally

listview.Items.EndUpdate;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

// Listview1.ViewStyle := vsReport;

if MoveListViewItem(Listview1, 1, 4) then

ShowMessage('Moved!');

end;

Перехват изменения размера колонки в TListView

2017-09-01T18:41:48+07:00

Code:

{

Question:

How do I capture a column resize event in TListView, the OnResize

only works when the ListView is changed?

Answer:

The event can be added with a bit of work. See the custom TListview derivative

below. It has 3 new events:

OnColumnResize, OnBeginColumnResize, OnEndColumnResize

}

unit PBExListview;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls;

type

TLVColumnResizeEvent = procedure(Sender: TCustomListview;

columnindex: Integer;

columnwidth: Integer) of object;

TPBExListview = class(TListview)

private

FBeginColumnResizeEvent: TLVColumnResizeEvent;

FEndColumnResizeEvent: TLVColumnResizeEvent;

FColumnResizeEvent: TLVColumnResizeEvent;

protected

procedure DoBeginColumnResize(columnindex, columnwidth: Integer);

virtual;

procedure DoEndColumnResize(columnindex, columnwidth: Integer);

virtual;

procedure DoColumnResize(columnindex, columnwidth: Integer);

virtual;

procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;

function FindColumnIndex(pHeader: pNMHdr): Integer;

function FindColumnWidth(pHeader: pNMHdr): Integer;

procedure CreateWnd; override;

published

property OnBeginColumnResize: TLVColumnResizeEvent

read FBeginColumnResizeEvent write FBeginColumnResizeEvent;

property OnEndColumnResize: TLVColumnResizeEvent

read FEndColumnResizeEvent write FEndColumnResizeEvent;

property OnColumnResize: TLVColumnResizeEvent

read FColumnResizeEvent write FColumnResizeEvent;

end;

procedure Register;

implementation

uses CommCtrl;

procedure Register;

begin

RegisterComponents('PBGoodies', [TPBExListview]);

end;

procedure TPBExListview.DoBeginColumnResize(columnindex, columnwidth: Integer);

begin

if Assigned(FBeginColumnResizeEvent) then

FBeginColumnResizeEvent(Self, columnindex, columnwidth);

end;

procedure TPBExListview.DoEndColumnResize(columnindex, columnwidth: Integer);

begin

if Assigned(FEndColumnResizeEvent) then

FEndColumnResizeEvent(Self, columnindex, columnwidth);

end;

procedure TPBExListview.DoColumnResize(columnindex, columnwidth: Integer);

begin

if Assigned(FColumnResizeEvent) then

FColumnResizeEvent(Self, columnindex, columnwidth);

end;

function TPBExListview.FindColumnIndex(pHeader: pNMHdr): Integer;

var

hwndHeader: HWND;

iteminfo: THdItem;

ItemIndex: Integer;

buf: array [0..128] of Char;

begin

Result := -1;

hwndHeader := pHeader^.hwndFrom;

ItemIndex := pHDNotify(pHeader)^.Item;

FillChar(iteminfo, SizeOf(iteminfo), 0);

iteminfo.Mask := HDI_TEXT;

iteminfo.pszText := buf;

iteminfo.cchTextMax := SizeOf(buf) - 1;

Header_GetItem(hwndHeader, ItemIndex, iteminfo);

if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then

Result := ItemIndex

else

begin

for ItemIndex := 0 to Columns.Count - 1 do

if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then

begin

Result := ItemIndex;

Break;

end;

procedure TPBExListview.WMNotify(var Msg: TWMNotify);

begin

inherited;

case Msg.NMHdr^.code of

HDN_ENDTRACK:

DoEndColumnResize(FindColumnIndex(Msg.NMHdr),

FindColumnWidth(Msg.NMHdr));

HDN_BEGINTRACK:

DoBeginColumnResize(FindColumnIndex(Msg.NMHdr),

FindColumnWidth(Msg.NMHdr));

HDN_TRACK:

DoColumnResize(FindColumnIndex(Msg.NMHdr),

FindColumnWidth(Msg.NMHdr));

end;

procedure TPBExListview.CreateWnd;

var

wnd: HWND;

begin

inherited;

wnd := GetWindow(Handle, GW_CHILD);

SetWindowLong(wnd, GWL_STYLE,

GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG);

end;

function TPBExListview.FindColumnWidth(pHeader: pNMHdr): Integer;

begin

Result := -1;

if Assigned(PHDNotify(pHeader)^.pItem) and

((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then

Result := PHDNotify(pHeader)^.pItem^.cxy;

end;

end.

Показать TRadioButtons в TListView

2017-09-01T18:42:49+07:00

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ComCtrls;

type

TMain = class(TForm)

ListView1: TListView;

Button1: TButton;

Button2: TButton;

procedure FormCreate(Sender : TObject);

procedure FormDestroy(Sender : TObject);

procedure Button1Click(Sender : TObject);

procedure Button2Click(Sender : TObject);

private

ListViewRadioList: TList;

procedure ListViewRadioCreate(List : TListView; R : TRect);

procedure ListViewRadioClear(List : TListView; Liste : TList);

procedure ListViewRadioFree(List : TListView; Liste : TList);

procedure ListViewListSelected(Item : integer; List : TListView);

procedure ListViewRadioClick(Sender : TObject);

public

{ Public-Deklarationen }

end;

var

Main : TMain;

implementation

{$R *.DFM}

procedure TMain.FormCreate(Sender : TObject);

begin

ListViewRadioList := TList.Create;

end;

procedure TMain.FormDestroy(Sender : TObject);

begin

ListViewRadioFree(ListView1, ListViewRadioList);

end;

procedure TMain.Button1Click(Sender : TObject);

var

R : TRect;

NewColumn : TListColumn;

ListItem : TListItem;

I : integer;

begin

with ListView1 do

begin

ViewStyle := vsReport;

Align := alLeft;

RowSelect := True;

ReadOnly := True;

ShowColumnHeaders := False;

NewColumn := Columns.Add;

NewColumn.Width := 15;

NewColumn := Columns.Add;

NewColumn.Width := Width - 15 - 19; // - breite Button - breite vom Scrollbalken

Items.BeginUpdate;

for I := 0 to 9 do

begin

ListItem := Items.Add;

R := Items[I].DisplayRect(drBounds);

R.Left := 1;

R.Right := Columns[0].Width;

ListViewRadioCreate(ListView1, R);

Items[I].Data := TRadioButton(ListViewRadioList[I]);

ListItem.SubItems.Add('Test' + IntToStr(I));

end;

Items.EndUpdate;

end;

procedure TMain.Button2Click(Sender : TObject);

begin

ListViewRadioClear(ListView1, ListViewRadioList);

end;

//------------------------------------------------------------------------------

procedure TMain.ListViewRadioCreate(List : TListView; R : TRect);

function NewViewRadio: TRadioButton;

begin

Result := TRadioButton.Create(Self);

Result.Parent := List;

Result.BoundsRect := R;

Result.OnClick := ListViewRadioClick;

end;

begin

ListViewRadioList.Add(NewViewRadio);

end;

//------------------------------------------------------------------------------

procedure TMain.ListViewRadioFree(List : TListView; Liste : TList);

var

I : integer;

begin

if Liste.Count - 1 < 0 then exit;

for I := 0 to Liste.Count - 1 do TRadioButton(Liste[I]).Free;

Liste.Free;

end;

//------------------------------------------------------------------------------

procedure TMain.ListViewRadioClear(List : TListView; Liste : TList);

var

I : integer;

begin

if Liste.Count - 1 < 0 then exit;

List.Items.BeginUpdate;

for I := 0 to Liste.Count - 1 do TRadioButton(Liste[I]).Free;

List.Items.Clear;

Liste.Clear;

List.Items.EndUpdate;

end;

//------------------------------------------------------------------------------

procedure TMain.ListViewListSelected(Item : integer; List : TListView);

begin

with List do

begin

try

SetFocus;

except

end;

Selected := Items[Item];

ItemFocused := Selected;

end;

//------------------------------------------------------------------------------

procedure TMain.ListViewRadioClick(Sender : TObject);

var

I : integer;

begin

for I := 0 to ListViewRadioList.Count - 1 do

if TRadioButton(ListViewRadioList[I]).Checked then

begin

ListViewListSelected(I, ListView1);

break;

end;

end.

Показать файлы с ассоциированными с ними иконками в TListView

2017-09-01T18:45:09+07:00

The following example shows how to show all files and their associated icons of a folder in a TListView.

To test the code, you need a ListView1 and a ImageList1 where the icons are stored.

Подробнее...

Получить все выделенные элементы TListView

2017-09-01T18:47:14+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

i: integer;

begin

with Listview1 do

// MultiSelect := True;

// ViewStyle := vsReport;

for i := 0 to Items.Count - 1 do

if Items[i].Selected then

Items[i].Caption := Items[i].Caption + ' - Selected!';

end;

Получить путь к выделенному файлу в TShellListView

2017-09-01T18:48:04+07:00

Code:

Label1.Caption := ShellListView1.Folders[ShellListView1.ItemIndex].PathName

{**************************************************************}

{

To retrieve full paths to each file selected files:

}

var

path: string;

begin

for i:=0 to ShellListView1.SelCount-1 do

begin

path := ShellListView1.Folders[ShellListView1.GetNextItem(ShellListView1.Selected,

sdAll,[isSelected]).Index+i-1].PathName;

// ...

end;

end

Получить список файлов в ListView как в проводнике

2017-09-01T18:49:12+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

ListItem: TListItem;

sr: tsearchrec;

NewColumn: TListColumn;

begin

NewColumn := ListView1.Columns.Add;

NewColumn := ListView1.Columns.Add; // добавдяются колонки

if FindFirst('*.*', faAnyFile - faDirectory - faVolumeId, sr) = 0 then

begin

ListItem := ListView1.Items.Add; // создается объект

ListItem.Caption := sr.name;

ListItem.SubItems.Add(inttostr(sr.size));

ListItem.SubItems.Add(datetimetostr(FileDateToDateTime(sr.time)));

while FindNext(sr) = 0 do

begin

ListItem := ListView1.Items.Add;

ListItem.Caption := sr.name;

ListItem.SubItems.Add(inttostr(sr.size));

ListItem.SubItems.Add(datetimetostr(FileDateToDateTime(sr.time)));

end;

FindClose(sr);

end;

Предотвратить изменение ширины колонки для TListView

2017-09-01T18:50:06+07:00

Code:

private

FListViewOldWndProc: TWndMethod;

procedure ListViewNewWndProc(var Msg: TMessage);

end;

{....}

implementation

uses

CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);

begin

//Sichern der ursprunglichen WindowProc der Listview

FListViewOldWndProc := ListView1.WindowProc;

//Subclassing: Umleiten der WindowProc auf unsere eigene Procedur

Listview1.WindowProc := ListViewNewWndProc;

end;

procedure TForm1.ListViewNewWndProc(var Msg: TMessage);

var

hdn: ^THDNotify;

begin

if Msg.Msg = WM_NOTIFY then

begin

hdn := Pointer(Msg.lParam);

//Abfangen und loschen der HDN_BeginTrack Botschaft

if (hdn.hdr.code = HDN_BeginTrackW) or (hdn.hdr.code = HDN_BeginTrackA) then

Msg.Result := 1

else

FListViewOldWndProc(Msg);

end

// ansonsten Botschaft an die ursprungliche WindowProc weiterreichen

else

FListViewOldWndProc(Msg);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

//vor dem Beenden Original WindowProc wiederherstellen

ListView1.WindowProc := FlistViewOldWndProc;

FListViewOldWndProc := nil;

end;

Прокрутка для TListView или TTreeView

2017-09-01T18:55:18+07:00

Code:

// KEYWORDS: SendMessage, WM_HSCROLL, WM_VSCROLL

// scroll a ListView vertically down

SendMessage(ListView1->Handle, WM_VSCROLL, SB_LINEDOWN, 0);

// scroll a TreeView vertically up

SendMessage(TreeView1->Handle, WM_VSCROLL, SB_LINEUP, 0);

// Here are some other scroll parameters that can be sent...

{

SB_BOTTOM Scrolls to the lower right.

SB_ENDSCROLL Ends scroll.

SB_LINEDOWN Scrolls one line down.

SB_LINEUP Scrolls one line up.

SB_PAGEDOWN Scrolls one page down.

SB_PAGEUP Scrolls one page up.

SB_TOP Scrolls to the upper left.

}

Сортировка ListView

2017-08-31T20:35:36+07:00

Сортировка ListView в режиме vsReport при нажатии на заголовок колонки

Code:

function CustomDateSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;

begin

result:=0;

if strtodatetime(item1.SubItems[0])> strtodatetime(item2.SubItems[0]) then

Result :=1

else

if strtodatetime(item1.SubItems[0])< strtodatetime(item2.SubItems[0]) then

Result :=-1;

end;

procedure TForm1.lv1ColumnClick(Sender: TObject; Column: TListColumn);

begin

if column =lv1.columns[0] then

LV1.CustomSort(@CustomNameSortProc, 0)

else

LV1.CustomSort(@CustomDateSortProc, 0)

end;

Подробнее...

Сохранить TListView как HTML страницу

2017-09-01T18:56:39+07:00

Code:

function ListViewConfHTML(Listview:TListview; output:string; center: Boolean) : Boolean;

var

i,f: Integer;

tfile: TextFile;

begin

try

ForceDirectories(ExtractFilePath(output));

AssignFile(tfile,output);

ReWrite(tfile);

WriteLn(tfile,'<html>');

WriteLn(tfile,'<head>');

WriteLn(tfile,'<title>HTML-Ansicht: '+listview.Name+'</title>');

WriteLn(tfile,'</head>');

WriteLn(tfile,'<table border="1" bordercolor="#000000">');

WriteLn(tfile,'<tr>');

for i := 0 to listview.Columns.Count - 1 do

begin

if center then

WriteLn(tfile,'<td><b><center>'+listview.columns[i].caption+'</center></b></td>') else

WriteLn(tfile,'<td><b>'+listview.columns[i].caption+'</b></td>');

end;

WriteLn(tfile,'</tr>');

WriteLn(tfile,'<tr>');

for i := 0 to listview.Items.Count-1 do

begin

WriteLn(tfile,'<td>'+listview.items.item[i].caption+'</td>');

for f := 0 to listview.Columns.Count-2 do

begin

if listview.items.item[i].subitems[f]='' then Write(tfile,'<td>-</td>') else

Write(tfile,'<td>'+listview.items.item[i].subitems[f]+'</td>');

end;

Write(tfile,'</tr>');

end;

WriteLn(tfile,'</table>');

WriteLn(tfile,'</html>');

CloseFile(tfile);

Result := True;

except

Result := False;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if ListViewConfHTML(form1.ListView1,'C:\text.html', true) then

ShowMessage('OK/ Hat geklappt') else

ShowMessage('Error occured/ Hat nicht geklappt');

end;

Спрятать горизонтальную или вертикальную полосу прокрутки в TListView

2017-09-01T18:55:59+07:00

Code:

type

TForm1 = class(TForm)

ListView1: TListView;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FListViewWndProc: TWndMethod;

procedure ListViewWndProc(var Msg: TMessage);

public

{ Private declarations }

FShowHoriz: Boolean;

FShowVert: Boolean;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListViewWndProc(var Msg: TMessage);

begin

ShowScrollBar(ListView1.Handle, SB_HORZ, FShowHoriz);

ShowScrollBar(ListView1.Handle, SB_VERT, FShowVert);

FListViewWndProc(Msg); // process message

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FShowHoriz := True; // show the horiz scrollbar

FShowVert := False; // hide vert scrollbar

FListViewWndProc := ListView1.WindowProc; // save old window proc

ListView1.WindowProc := ListViewWndProc; // subclass

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

ListView1.WindowProc := FListViewWndProc; // restore window proc

FListViewWndProc := nil;

end;

Ускорить удаление элементов из TListView

2017-09-01T18:57:17+07:00

Code:

procedure AddNewListViewItems;

var

oldViewStyle: TViewStyle;

begin

odlViewStyle := ListView1.ViewStyle;

ListView1.ViewStyle := vsList;

ListView1.Items.Clear;

{ Add new Listitems here }

{ An dieser werden die neuen ListItems eingefugt }

ListView1.ViewStyle := oldViewStyle;

end;

Цветные строки для TListView

2017-09-01T18:58:10+07:00

Code:

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;

Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

begin

with ListView1.Canvas.Brush do

begin

case Item.Index of

0: Color := clYellow;

1: Color := clGreen;

2: Color := clRed;

end;

Чередование фона строк в TListView

2017-09-01T18:59:43+07:00

Да какое описание...

Вообщем можно просто copy/past сделать...

Хотя реализация не оптимальная, но общая идея - та что нужна =)))

Code:

{

>> Чередование фона строк в TListView

Зависимости: нету =)

Автор: Subfire, Питер

***************************************************** }

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;

Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

var

i: word;

begin

if item = nil then

EXIT;

i := Item.Index;

if trunc((i) / 2) < (i / 2) then

sender.canvas.brush.Color := cl3DLight

else

sender.canvas.brush.Color := clwhite;

end;

Экспорт TListView в TStringGrid

2017-09-01T19:00:22+07:00

Code:

procedure ListView2StringGrid(Listview: TListView; StringGrid: TStringGrid);

const

MAX_SUBITEMS = 5;

var

i, j: Integer;

begin

with ListView do

for i := 0 to Items.Count - 1 do

begin

{Get Item of First Column}

StringGrid.Cells[1, i + 1] := Items[i].Caption;

{loop through SubItems}

for j := 0 to MAX_SUBITEMS do

begin

if Items[i].SubItems.Count > j then

StringGrid.Cells[j + 2, i + 1] := Items[i].SubItems.Strings[j]

else

break;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

i: Integer;

begin

// Clear the StringGrid if necessary

// Falls notig, zuerst das StringGrid loschen

i := 0;

while i < StringGrid1.RowCount do

begin

StringGrid1.Rows[i].Clear;

Inc(i);

end;

// Copy ListView1 to StringGrid1

ListView2StringGrid(ListView1, StringGrid1);

end;