📄 pdelistview.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 + -