TListView
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; end;
|
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; |
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; |
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. }
|
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; end; end; |
Сортировка 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; |
Да какое описание...
Вообщем можно просто 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; |
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; 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; |
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; end; 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; |
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; |
Страница 3 из 3