📄 smartlistview.pas

📁 一个功能增强的Delphi TListView组件TSmartListView + 增加排序功能,带小箭头的那种：） + 增加SaveToExcelFile、SaveToHTMLFile方法
💻 PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
    Items.EndUpdate;
    FreeAndNil(Stream);
  end;

end;

{Save a TListView as an HTML page}
{This Code from http://www.swissdelphicenter.ch/ Autor: Robert Muth  }

function TSmartListView.SaveToHTMLFile(const FileName: string; Center: Boolean): Boolean;
var
  i, j: Integer;
  tfile: TextFile;
begin
  try
    ForceDirectories(ExtractFilePath(FileName));
    AssignFile(tfile, FileName);
    try
      ReWrite(tfile);
      WriteLn(tfile, '<html>');
      WriteLn(tfile, '<head>');
      WriteLn(tfile, '<title>HTML-Ansicht: ' + FileName + '</title>');
      WriteLn(tfile, '</head>');
      // WriteLn(tfile, '<table border="1" bordercolor="#000000">');
      // Modified by HsuChong <Hsuchong@hotmail.com> 2006-12-13 10:03:06
      WriteLn(tfile, '<table border=1 cellspacing=0 cellpadding=0 bordercolor="#000000">');
      WriteLn(tfile, '<tr>');
      for i := 0 to Columns.Count - 1 do
      begin
        if center then
          WriteLn(tfile, '<td><b><center>' + Columns[i].Caption + '</center></b></td>')
        else
          WriteLn(tfile, '<td><b>' + Columns[i].Caption + '</b></td>');
      end;
      WriteLn(tfile, '</tr>');
      WriteLn(tfile, '<tr>');
      for i := 0 to Items.Count - 1 do
      begin
        WriteLn(tfile, '<td>' + Items.Item[i].Caption + '</td>');
        for j := 0 to Columns.Count - 2 do
        begin
          if Items.Item[i].SubItems[j] = '' then
            Write(tfile, '<td>-</td>')
          else
            Write(tfile, '<td>' + Items.Item[i].SubItems[j] + '</td>');
        end;
        Write(tfile, '</tr>');
      end;
      WriteLn(tfile, '</table>');
      WriteLn(tfile, '</html>');
      Result := True;
    finally
      CloseFile(tfile);
    end;
  except
    Result := False;
  end;
end;

function TSmartListView.SaveToExcelFile(const FileName: string): Boolean;
const
  ExcelChar = #9;
var
  ExcelRowText: string;
  i, j: Integer;
  ExcelList: TStrings;
begin
  Result := False;
  try
    ForceDirectories(ExtractFilePath(FileName));
    ExcelList := TStringList.Create;
    try
      ExcelRowText := Columns[0].Caption;
      for i := 1 to Columns.Count - 1 do
        ExcelRowText := ExcelRowText + ExcelChar + Columns[i].Caption;
      ExcelList.Append(ExcelRowText);
      for i := 0 to Items.Count - 1 do
      begin
        ExcelRowText := Items[i].Caption;
        for j := 0 to Items[i].SubItems.Count - 1 do
          ExcelRowText := ExcelRowText + ExcelChar + Items[i].SubItems[j];
        ExcelList.Append(ExcelRowText);
      end;
      ExcelList.SaveToFile(FileName);
    finally
      ExcelList.Free;
    end;
  except
    Result := True;
  end;

end;

procedure TSmartListView.DrawBackgroundPicture;
var
  x, y, dx: Integer;
begin
  x := 0;
  y := 0;
  if Items.Count > 0 then
  begin
    if ViewStyle = vsReport then
      x := TopItem.DisplayRect(drBounds).Left
    else
      x := Items[0].DisplayRect(drBounds).Left;
    y := Items[0].DisplayRect(drBounds).Top - 2;
  end;
  dx := x;
  while y <= ClientHeight do
  begin
    while x <= ClientWidth do
    begin
      Canvas.Draw(x, y, FBackgroundPicture.Graphic);
      inc(x, FBackgroundPicture.Graphic.Width);
    end;
    inc(y, FBackgroundPicture.Graphic.Height);
    x := dx;
  end;
end;

procedure TSmartListView.LVCustomDraw(Sender: TCustomListView;
  const ARect: TRect; var DefaultDraw: Boolean);
begin
  if (FBackgroundPicture.Graphic <> nil) then
  begin
    //绘制背景图
    DrawBackgroundPicture;
    //将画布的背景设为透明模式
    SetBkMode(Canvas.Handle, TRANSPARENT);
    //将Item的文本背景设为透明
    ListView_SetTextBKColor(Handle, CLR_NONE);
  end;
end;

procedure TSmartListView.BackgroundPictureChanged(Sender: TObject);
begin
  Invalidate;
end;

function TSmartListView.GetCop: string;
begin
  Result := FCop;
end;

procedure TSmartListView.SetCop(const Value: string);
begin
  if FCop <> Value then
    FCop := Value;
end;

procedure TSmartListView.SetBackgroundPicture(Value: TPicture);
begin
  if FBackgroundPicture <> Value then
    FBackgroundPicture.Assign(Value);
end;

function TSmartListView.GetCheckedItem: TListItem;
var
  I: Integer;
begin
  Result := nil;
  if Checkboxes then
    for I := 0 to Items.Count - 1 do
      if Items[I].Checked then
      begin
        Result := Items[I];
        Break;
      end;
end;

function TSmartListView.MultiChecked: Boolean;
var
  I, CheckedCount: Integer;
begin
  Result := False;
  CheckedCount := 0;
  if Checkboxes then
    for I := 0 to Items.Count - 1 do
    begin
      if Items[I].Checked then
        Inc(CheckedCount);
      Result := CheckedCount > 1;
      if Result then
        break;
    end;

end;

function TSmartListView.IsChecked: Boolean;
var
  I: Integer;
begin
  Result := False;
  if Checkboxes then
    for I := 0 to Items.Count - 1 do
      if Items[I].Checked then
      begin
        Result := True;
        Break;
      end;
end;

procedure TSmartListView.CheckAll(Checked: Boolean);
var
  I: Integer;
begin
  if Checkboxes then
    for I := 0 to Items.Count - 1 do
      Items[i].Checked := Checked;
end;

procedure TSmartListView.MoveItem(OriginalIndex, NewIndex: Integer);
var
  Selected, Focused: boolean;
  ListItem: TListItem;
begin
  if ((OriginalIndex < 0) or (OriginalIndex > Items.Count)) or
    ((NewIndex < 0) or (NewIndex > Items.Count)) then
    Exit;
  Items.BeginUpdate;
  try
    Selected := Items[OriginalIndex].Selected;
    Focused := Items[OriginalIndex].Focused;
    if NewIndex < OriginalIndex then
      inc(OriginalIndex);
    if (NewIndex > OriginalIndex) then
      ListItem := Items.Insert(NewIndex + 1)
    else
      ListItem := Items.Insert(NewIndex);
    ListItem.Assign(Items[OriginalIndex]);
    Items.Delete(OriginalIndex);
    ListItem.Selected := Selected;
    ListItem.Focused := Focused;
  finally
    Items.EndUpdate;
  end;
end;

procedure TSmartListView.KeyUp(var Key: Word; Shift: TShiftState);
var
  PrevSearch: string;
  Ascii: array[0..1] of char;
  KBState: TKeyboardState;
begin
  inherited;
  if ColumnSearch then
  begin
    GetKeyboardState(KBState);
    if (ToAscii(Key, 0, KBState, Ascii, 0) = 1) and (Ascii[0] in [#32..#127]) then
    begin
      PrevSearch := FSearchStr;         // remember searchstring
      if GetTickCount > FSearchTickCount + 1000 then // last search over one second ago?
        PrevSearch := '';               // reset searchstring
      FSearchStr := PrevSearch + Ascii[0]; // Append searchstring
      FSearchTickCount := GetTickCount; // remember last search time
      Key := 0;                         // prevent automatic search on first column
      if not StringSelect(FSearchStr, FCurColumn) then
      begin
        MessageBeep(MB_ICONSTOP);
        FSearchStr := PrevSearch;
      end;
    end;
  end;
end;

function TSmartListView.StringSelect(const FindStr: string; ColumnIndex: Integer): boolean;
var
  SearchLen, SearchIndex, SearchStart: Integer;
begin
  Result := False;
  SearchLen := Length(FindStr);
  if Assigned(Selected) then            // determine starting item
    SearchStart := Selected.Index + 1
  else
    SearchStart := 1;

  // Searches from currently selected item to last item
  // and from first item to currently selected item until result(found)

  SearchIndex := 0;
  while (SearchIndex < Items.Count) and not Result do
  begin
    if ColumnIndex = 0 then             // find main or subitem?
      Result := AnsiCompareText(Copy(Items[(SearchStart + SearchIndex) mod
        Items.Count].Caption, 0, SearchLen), FindStr) = 0
    else
      Result := AnsiCompareText(Copy(Items[(SearchStart + SearchIndex) mod
        Items.Count].SubItems[ColumnIndex - 1], 0, SearchLen), FindStr) = 0;
    Inc(SearchIndex);
  end;
  if Result then
  begin
    SetFocus;
    Selected := Items[(SearchStart + SearchIndex - 1) mod Items.Count];
    ItemFocused := Selected;
    Selected.MakeVisible(False);
  end;

end;

function TSmartListView.SubStringSelect(const FindStr: string; ColumnIndex: Integer): boolean;
var
  SearchIndex, SearchStart: Integer;
begin
  Result := False;
  if Assigned(Selected) then            // determine starting item
    SearchStart := Selected.Index + 1
  else
    SearchStart := 1;

  // Searches from currently selected item to last item
  // and from first item to currently selected item until result(found)

  SearchIndex := 0;
  while (SearchIndex < Items.Count) and not Result do
  begin
    if ColumnIndex = 0 then             // find main or subitem?
      Result := Pos(FindStr, Items[(SearchStart + SearchIndex) mod
        Items.Count].Caption) > 0
    else
      Result := Pos(FindStr, Items[(SearchStart + SearchIndex) mod
        Items.Count].SubItems[ColumnIndex - 1]) > 0;
    Inc(SearchIndex);
  end;
  if Result then
  begin
    SetFocus;
    Selected := Items[(SearchStart + SearchIndex - 1) mod Items.Count];
    ItemFocused := Selected;
    Selected.MakeVisible(False);
  end;

end;

end.
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -