pdestaticlistaction.pas

pde专用vcl

//SQL语句规则：
//第一列为ID;
//第二列为Caption;
unit PDEStaticListAction;

interface

uses
  SysUtils, ComCtrls, Controls, Classes, ActnList, DB, ADODB, Windows, ListActns;

type
  TPDEStaticListAction = class(TStaticListAction)
  private
    { Private declarations }
    FADOconn:TADOConnection;
    procedure ListAddItem(strItems:TStrings);
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure ListCreate(strSql:string);
    procedure ListLocationByID(ID:string);
    function  GetListItemID():String;
  published
    { Published declarations }
    property ADOconn:TADOConnection Read FADOconn Write FADOconn;
  end;

procedure Register;

implementation

type
  PTNKEY = ^TTREENODEKEY;
  TTREENODEKEY = record
    ID:string;
End;

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

procedure TPDEStaticListAction.ListAddItem(strItems:TStrings);
var
  lstItem:TListControlItem;
  FKey: PTNKEY;
begin
  New(FKey);
  FKey^.ID := strItems[0];
  Self.Items.BeginUpdate;
  try
    lstItem := Self.Items.Add;
    lstItem.Data:= FKey;
    lstItem.Caption:=strItems[1];
    lstItem.ImageIndex:=0;
  finally
    Self.Items.EndUpdate;
  end;
end;

procedure TPDEStaticListAction.ListCreate(strSql:string);
var
  adoquery:TADOQuery;
  subStrs:TStrings;
  iLoop:Integer;
begin
  try
    adoquery := TADOQuery.Create(self);
    adoquery.Connection:=FADOconn;
    adoquery.SQL.add(strSql);
    adoquery.Open;

    Self.Items.Clear;
    while not adoquery.Eof do
    Begin
      subStrs := TStringList.Create;
      for iLoop:= 0 to adoquery.FieldCount -1 do
      begin
        subStrs.Add(adoquery.Fields[iLoop].AsString) ;
      end;
      ListAddItem(subStrs);
      subStrs.Free;
      adoquery.Next;
    End;
    if Self.Items.Count > 0 then
      Self.ItemIndex:=0;
    adoquery.Close;
    adoquery.Destroy;
  except
    on E:Exception do
      Messagebox(HWND(0),PAnsiChar('数据库操作失败！请检查数据连接是否正常。' + chr(10) + chr(13) + '详细错误信息如下：' + chr(10) + chr(13) +  E.Message),PAnsiChar('信息'),MB_OK+MB_ICONINFORMATION);
  end;
end;

function  TPDEStaticListAction.GetListItemID():String;
begin
  if Self.Items.Count = 0 then
    Result:='0'
  else
    Result:=PTNKEY(Self.Items[Self.ItemIndex].Data)^.id;
end;

procedure TPDEStaticListAction.ListLocationByID(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.ItemIndex := iLoop;
      break;
    End;
  end;
end;
end.