⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pdelistview.pas

📁 pde专用vcl
💻 PAS
字号:
unit PDEListView;

interface

uses
  SysUtils, Windows, Classes, Controls, ComCtrls, DB, ADODB;
type
  TPDEListView = class(TListView)

  private
    { Private declarations }
    FADOconn: TADOConnection;
    FSql: string;
    FListItemPK: TStrings;
    FListItemCaption: TStrings;
    FListItemValue: TStrings;
    FListItemWidth: TStrings;
  protected
    { Protected declarations }
  public
    { Public declarations }
    {ListItemPK:array of string;
    ListItemCaption:array of string;
    ListItemValue:array of string;
    ListItemWidth:array of Integer; }
    procedure ListViewCreate(imageindex: integer = 0);
    procedure ListViewAddItem(ItemPk: TStrings; ItemValue: TStrings; imageindex:
      integer = 0);
    procedure ListViewModifyItem(ItemPk: TStrings; ItemValue: TStrings);
    procedure ListViewRemoveItem(); overload;
    procedure ListViewRemoveItem(ID: string); overload;
    procedure ListDown();
    procedure ListUp();
    procedure ListLocal(ID: string);
    function GetListItemID(): string; overload;
    function GetListItemID(index: integer): string; overload;
    function GetListItemKey(): string; overload;
    function GetListItemKey(index: integer): string; overload;
    function GetListItemTag(): string; overload;
    function GetListItemTag(index: integer): string; overload;
  published
    { Published declarations }
    property ADOconn: TADOConnection read FADOconn write FADOconn;
    property Sql: string read FSql write FSql;
    property ListItemPK: TStrings read FListItemPK write FListItemPK;
    property ListItemCaption: TStrings read FListItemCaption write
      FListItemCaption;
    property ListItemValue: TStrings read FListItemValue write FListItemValue;
    property ListItemWidth: TStrings read FListItemWidth write FListItemWidth;
  end;

procedure Register;

implementation
type
  PTNKEY = ^TTREENODEKEY;
  TTREENODEKEY = record
    ID: string;
    Key: string;
    Tag: string;
  end;

procedure Register;
begin
  RegisterComponents('PDE', [TPDEListView]);
end;

procedure TPDEListView.ListLocal(ID: string);
var
  iLoop: integer;
begin
  for iLoop := 0 to Self.Items.Count - 1 do
  begin
    if PTNKEY(self.Items[iLoop].Data)^.ID = ID then
    begin
      self.Items[iLoop].Selected := true;
      break;
    end;
  end;
end;

procedure TPDEListView.ListDown();
var
  NewItem: TListItem;
  iIndex: integer;
begin
  if Self.Items.Count <= 1 then
    Exit;
  if Self.SelCount = 0 then
    Exit;
  if Self.Selected.Index = Self.Items.Count - 1 then
    Exit;

  iIndex := Self.Selected.Index;
  NewItem := Self.Items.Insert(iIndex);
  NewItem.Data := Self.Items[iIndex + 2].Data;
  NewItem.Checked := Self.Items[iIndex + 2].Checked;
  NewItem.Caption := Self.Items[iIndex + 2].Caption;
  NewItem.SubItems := Self.Items[iIndex + 2].SubItems;
  Self.Items.Delete(iIndex + 2);
end;

procedure TPDEListView.ListUp();
var
  NewItem: TListItem;
  iIndex: integer;
begin
  if Self.Items.Count <= 1 then
    Exit;
  if Self.SelCount = 0 then
    Exit;
  if Self.Selected.Index = 0 then
    Exit;
  iIndex := Self.Selected.Index;
  NewItem := Self.Items.Insert(iIndex + 1);
  NewItem.Data := Self.Items[iIndex - 1].Data;
  NewItem.Checked := Self.Items[iIndex - 1].Checked;
  NewItem.Caption := Self.Items[iIndex - 1].Caption;
  NewItem.SubItems := Self.Items[iIndex - 1].SubItems;
  Self.Items.Delete(iIndex - 1);
end;

procedure TPDEListView.ListViewAddItem(ItemPk: TStrings; ItemValue: TStrings;
  imageindex: integer = 0);
var
  lstItem: TListItem;
  iLoop: Integer;
  subItems: TStrings;
  FKey: PTNKEY;
begin
  New(FKey);
  for iLoop := 0 to ItemPk.Count - 1 do
  begin
    if iLoop = 0 then
      FKey^.ID := ItemPk[0];
    if iLoop = 1 then
      FKey^.Key := ItemPk[1];
    if iLoop = 2 then
      FKey^.Tag := ItemPk[2];
  end;
  subItems := TStringList.Create;
  for iLoop := 1 to ItemValue.Count - 1 do
  begin
    subItems.Add(ItemValue[iLoop]);
  end;
  Self.Items.BeginUpdate;
  try
    lstItem := Self.Items.Add;
    lstItem.Data := FKey;
    lstItem.Caption := ItemValue[0];
    lstItem.ImageIndex := imageindex;
    if ItemValue.Count > 1 then
    begin
      lstItem.SubItems.AddStrings(subItems);
    end;
    subItems.Free;
    lstItem.Selected := true;
  finally
    Self.Items.EndUpdate;
  end;
end;

procedure TPDEListView.ListViewCreate(imageindex: integer = 0);
var
  adoquery: TADOQuery;
  iLoop: Integer;
  ItemPK: Tstrings;
  ItemValue: Tstrings;
  ItemColumn: TListColumn;
begin
  try
    Self.Columns.Clear;
    for iLoop := 0 to FListItemCaption.Count - 1 do
    begin
      ItemColumn := Self.Columns.Add;
      ItemColumn.Caption := FListItemCaption[iLoop];
      ItemColumn.Width := strtoInt(FListItemWidth[iLoop]);
    end;
    adoquery := TADOQuery.Create(self);
    adoquery.Connection := FADOconn;
    adoquery.SQL.add(FSql);
    adoquery.Open;
    Self.Items.Clear;
    while not adoquery.Eof do
    begin
      ItemPK := TStringList.Create;
      ItemValue := TStringList.Create;
      for iLoop := 0 to FListItemPK.Count - 1 do
      begin
        ItemPK.add(adoquery.Fields[strtoint(FListItemPK[iLoop])].AsString);
      end;
      if imageindex > 0 then
      begin
        for iLoop := 0 to FListItemValue.Count - 2 do
        begin
          ItemValue.add(adoquery.Fields[strtoint(FListItemValue[iLoop])].AsString);
        end;
        ListViewAddItem(ItemPK, ItemValue,
          adoquery.Fields[strtoint(FListItemValue[FListItemValue.Count -
            1])].AsInteger);
      end
      else
      begin
        for iLoop := 0 to FListItemValue.Count - 1 do
        begin
          ItemValue.add(adoquery.Fields[strtoint(FListItemValue[iLoop])].AsString);
        end;
        ListViewAddItem(ItemPK, ItemValue);
      end;
      adoquery.Next;
      ItemPK.Free;
      ItemValue.Free;
    end;
    adoquery.Close;
    adoquery.Destroy;
  except
    on E: Exception do
      Messagebox(self.Handle,
        PAnsiChar('数据库操作失败!请检查数据连接是否正常。' + chr(10) + chr(13)
        +
        '详细错误信息如下:' + chr(10) + chr(13) + E.Message),
        PAnsiChar('信息'),
        MB_OK + MB_ICONINFORMATION);
  end;
end;

procedure TPDEListView.ListViewModifyItem(ItemPk: TStrings; ItemValue:
  TStrings);
var
  lstItem: TListItem;
  iLoop: Integer;
  subItems: TStrings;
  FKey: PTNKEY;
begin
  New(FKey);
  for iLoop := 0 to ItemPk.Count - 1 do
  begin
    if iLoop = 0 then
      FKey^.ID := ItemPk[0];
    if iLoop = 1 then
      FKey^.Key := ItemPk[1];
    if iLoop = 2 then
      FKey^.Tag := ItemPk[2];
  end;
  subItems := TStringList.Create;
  for iLoop := 1 to ItemValue.Count - 1 do
  begin
    subItems.Add(ItemValue[iLoop]);
  end;
  Self.Items.BeginUpdate;
  try
    lstItem := Self.Selected;
    lstItem.Data := FKey;
    lstItem.Data := FKey;
    lstItem.Caption := ItemValue[0];
    //lstItem.ImageIndex:=0;
    if ItemValue.Count > 1 then
    begin
      lstItem.SubItems.Clear;
      lstItem.SubItems.AddStrings(subItems);
    end;
    subItems.Free;
    lstItem.Selected := true;
  finally
    Self.Items.EndUpdate;
  end;
end;

//ListView删除项目

procedure TPDEListView.ListViewRemoveItem();
var
  iNowIndex: Integer;
begin
  { TODO : add by zlj:修正为选择的错误 } 
  if not Assigned(Self.Selected) then
    exit;
  //}
  iNowIndex := Self.Selected.Index;
  Self.Items.BeginUpdate;
  try
    Self.Items.Delete(Self.Selected.Index);
    if Self.Items.Count = 0 then
      Exit
    else if Self.Items.Count - 1 >= iNowIndex then
      Self.Items[iNowIndex].Selected := true
    else
      Self.Items[Self.Items.Count - 1].Selected := true;
  finally
    Self.Items.EndUpdate;
  end;
end;

procedure TPDEListView.ListViewRemoveItem(ID: string);
var
  iLoop: integer;
begin
  Self.Items.BeginUpdate;
  try
    for iLoop := 0 to self.Items.Count - 1 do
    begin
      if Trim(PTNKEY(self.Items[iLoop].Data)^.ID) = Trim(ID) then
      begin
        Self.Items.Delete(iLoop);
        break;
      end;
    end;
    if Self.Items.Count > 0 then
      Self.Items[0].Selected := true;
  finally
    Self.Items.EndUpdate;
  end;
end;
//得到节点ID值

function TPDEListView.GetListItemID(): string;
begin
  if Self.Items.Count = 0 then
    Result := '0'
  else
    Result := PTNKEY(Self.Selected.Data)^.id;
end;

function TPDEListView.GetListItemID(index: integer): string;
begin
  if Self.Items.Count = 0 then
   Result := '0'
  else
    Result := PTNKEY(Self.Items[index].Data)^.id;
end;
//得到节点KEY值

function TPDEListView.GetListItemKey(): string;
begin
  if Self.Items.Count = 0 then
    Result := ''
  else
    Result := PTNKEY(Self.Selected.Data)^.key;
end;

function TPDEListView.GetListItemKey(index: integer): string;
begin
  if Self.Items.Count = 0 then
    Result := ''
  else
    Result := PTNKEY(Self.Items[index].Data)^.key;
end;
//得到节点Tag值

function TPDEListView.GetListItemTag(): string;
begin
  if Self.Items.Count = 0 then
    Result := ''
  else
    Result := PTNKEY(Self.Selected.Data)^.Tag;
end;

function TPDEListView.GetListItemTag(index: integer): string;
begin
  if Self.Items.Count = 0 then
    Result := ''
  else
    Result := PTNKEY(Self.Items[index].Data)^.Tag;
end;
end.

⌨️ 快捷键说明

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