poptree_form.pas

滚动下拉框－不过下拉的是树型结构

unit PopTree_Form;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  StdCtrls, ExtCtrls, VirtualTrees, SUIImagePanel;

const CON_DefaultAutoExpandSelectStatus: boolean = true;
const Con_TreeMinWidth: integer = 100;
const Con_TreeMinHeight: integer = 100;
const CON_TreeDefautWidth: integer = 150;
const CON_TreeDefautHeight: integer = 200;

type
  TDataRecord = record
    id: integer;
    Name: string;
  end;
  PDataRecord = ^TDataRecord;
  TSelectedValueEvent = procedure (const id: integer; const Name: string; const index: integer = -1) of Object;
  TPopTreeForm = class(TForm)
    suiPanel1: TsuiPanel;
    Tree: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);
    procedure TreeExit(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure TreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure TreeHotChange(Sender: TBaseVirtualTree; OldNode,
      NewNode: PVirtualNode);
    procedure TreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure TreeFocusChanged(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex);
    procedure TreeEnter(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TreeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    FVisible: boolean;
    FOldSelectNode: PvirtualNode;
    FSelectedValueEvent: TSelectedValueEvent;
    FAutoExpandSelectStatus: boolean;
    function getValue: string;
    procedure setValue(const FValue: string);
    procedure ProcChange;
    procedure AddItems;
  public
    function getAutoExpandSelectStatus: boolean;
    procedure SetAutoExpandSelectStatus(bValue: boolean);
    procedure SelectPrev;
    procedure SelectNext;
    property Value: string read getValue write setValue ;
    property OnSelectedValueEvent: TSelectedValueEvent read FSelectedValueEvent write FSelectedValueEvent default nil;
  end;

implementation

{$R *.dfm}

procedure TPopTreeForm.FormCreate(Sender: TObject);
begin
  self.FAutoExpandSelectStatus := CON_DefaultAutoExpandSelectStatus;
  Left := screen.Width + 1;
  Top := screen.Height + 1;
  Height := CON_TreeDefautHeight;
  Width := CON_TreeDefautWidth;
  self.Tree.NodeDataSize := sizeof(TDataRecord);
  self.FOldSelectNode := nil;
  self.Tree.Clear;
  FVisible := false;
  AddItems;
  TreeEnter(nil);
end;

procedure TPopTreeForm.AddItems;
var
  i, j: integer;
  Root, Node, NodeChird: PVirtualNode;
  Data: PDataRecord;
begin
  Root := self.Tree.AddChild(nil);
  Data := PDataRecord(self.Tree.GetNodeData(Root));
  Data.id := 0; Data.Name := '内容';
  for i:= 1 to 10 do
  begin
    Node := self.Tree.AddChild(Root);
    Data := PDataRecord(self.Tree.GetNodeData(Node));
    Data.id := i; Data.Name := IntToStr(i);
    for J := 100 to 110 do
    begin
      NodeChird := self.Tree.AddChild(Node);
      Data := PDataRecord(self.Tree.GetNodeData(NodeChird));
      Data.id := i; Data.Name := IntToStr(j);
    end;
  end;
  TreeEnter(nil);
end;

function TPopTreeForm.getValue: string;
begin
  Result := '';
  if self.Tree.SelectedCount > 0 then
    Result := PDataRecord(self.Tree.GetNodeData(self.Tree.GetFirstSelected)).Name;
end;

procedure TPopTreeForm.setValue(const FValue: string);
var
  i: Integer;
begin

end;

procedure TPopTreeForm.ProcChange;
var
  Node: PVirtualNode;
begin
    if self.Tree = nil then exit;
    Node := self.Tree.GetFirstSelected;
    if (Node = nil) then exit;
    if (Node <> nil) and self.Tree.Selected[Node] and ((self.FOldSelectNode = nil) or (self.FOldSelectNode <> Node)) and Assigned(OnSelectedValueEvent) then
    begin
      self.FOldSelectNode := Node;
      self.OnSelectedValueEvent(PDataRecord(self.Tree.GetNodeData(Node)).id, PDataRecord(self.Tree.GetNodeData(Node)).Name, Node.Index);
    end;    
    Visible := Visible and FVisible;
    if FVisible then
      FVisible := false;
end;

procedure TPopTreeForm.TreeExit(Sender: TObject);
begin
  FVisible := false;
  Visible := false;
end;

procedure TPopTreeForm.FormDeactivate(Sender: TObject);
begin
  FVisible := false;
  Visible := false;
end;

procedure TPopTreeForm.TreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  Data: PDataRecord;
begin
  if (Node <> nil) and (sender <> nil) then
  begin
    Data := sender.GetNodeData(Node);
    CellText:= Data.Name + '-' + intTostr(Node.Index);
  end;
end;

procedure TPopTreeForm.TreeHotChange(Sender: TBaseVirtualTree; OldNode,
  NewNode: PVirtualNode);
begin
   if (NewNode <> nil) and Sender.Selected[NewNode] and Assigned(OnSelectedValueEvent) then
   // self.OnSelectedValueEvent(PDataRecord(self.Tree.GetNodeData(NewNode)).id, PDataRecord(self.Tree.GetNodeData(NewNode)).Name);

end;

procedure TPopTreeForm.TreeChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
begin
  if (Node <> Nil) and Sender.Selected[Node] then
  begin
    ProcChange;
  end;
end;

procedure TPopTreeForm.TreeFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
begin
  if (Node <> nil) and (Node = self.Tree.GetFirstSelected) then
    self.ProcChange;
end;

procedure TPopTreeForm.TreeEnter(Sender: TObject);
begin

  if FAutoExpandSelectStatus and (self.Tree.GetFirstSelected <> nil) and (self.Tree.GetFirstSelected.Parent <> nil)  then
  begin
    self.Tree.Expanded[self.Tree.GetFirstSelected.Parent] := true;
  end
  else
    self.Tree.Expanded[self.Tree.GetFirstVisible] := true;
end;

procedure TPopTreeForm.FormActivate(Sender: TObject);
begin
  TreeEnter(nil);
end;

function TPopTreeForm.getAutoExpandSelectStatus: boolean;
begin
  Result := self.FAutoExpandSelectStatus;
end;

procedure TPopTreeForm.SetAutoExpandSelectStatus(bValue: boolean);
begin
  self.FAutoExpandSelectStatus:= bValue;
end;

procedure TPopTreeForm.SelectPrev;
var
  Node: PVirtualNode;
  lparam: LongInt;
begin
  lparam := MakeLong(0, MapVirtualKey(VK_Up, 0));
  self.Tree.Perform(WM_KEYDOWN, VK_Up, lparam);
  self.Tree.Perform(WM_KEYUP, VK_Up, lparam or $C0000000);
  Application.ProcessMessages;

  {if (self.Tree <> nil) and (self.Tree.TotalCount > 0) then
  begin
    if (self.Tree.GetFirstSelected = nil) and (self.Tree.GetFirstVisible <> nil) then
      Node := self.Tree.GetFirstVisible
    else if (self.Tree.GetFirstVisible <> nil) then
      Node := self.Tree.GetFirstVisible.PrevSibling
    else 
      Node := nil;
    if Node <> nil then
    begin
      self.Tree.Selected[Node] := true;
    end;
  end;}
end;

procedure TPopTreeForm.SelectNext;
var
  Node: PVirtualNode;
  lparam: LongInt;
begin
  lparam := MakeLong(0, MapVirtualKey(VK_Down, 0));
  SendMessage(self.Tree.Handle, WM_KEYDOWN, VK_Down, lparam);
  SendMessage(self.Tree.Handle, WM_KEYUP, VK_Down, lparam or $C0000000);
  Application.ProcessMessages;

  //SendMessage(self.Tree.Handle, EV_RXCHAR, VK_Down, VK_Down);
  //postmessage(self.Tree.Handle, WM_KEYDOWN, VK_Down, 0);
  {if (self.Tree <> nil) and (self.Tree.TotalCount > 0) then
  begin
    if (self.Tree.GetFirstSelected = nil) and (self.Tree.GetFirstVisible <> nil) then
      Node := self.Tree.GetFirstVisible
    else if (self.Tree.GetFirstVisible <> nil) then
      Node := self.Tree.GetFirstVisible.NextSibling
    else 
      Node := nil;
    if Node <> nil then
    begin
      self.Tree.Selected[Node] := true;
    end;
  end; }
end;

procedure TPopTreeForm.TreeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = windows.VK_RETURN then
  begin
    FVisible := false;
    ProcChange;
  end
  else if Key in [VK_Left, VK_Right, VK_UP, VK_Down] then
  begin
    FVisible := Visible and true;
  end;
end;

end.