combotree.pas

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

unit ComboTree;

interface

uses
  Windows, StdCtrls, Messages, SysUtils, Classes, Controls,
  Graphics, suiButton, PopTree_Form, Forms, SuiEdit;

type
  TOnSelectEvent = procedure(Sender: TObject; const id: integer; const Name: string; const index: integer = -1) of Object;
  TShowType = (stID, stName);
  TDefaultActionEvent = procedure of Object;
  TMySuiEdit = class(TSuiEdit)
  private
    FDefaultRunAction: TDefaultActionEvent;
    FDefaultPrevAction: TDefaultActionEvent;
    FDefaultNextAction: TDefaultActionEvent;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  public
    property DefaultRunAction: TDefaultActionEvent  read FDefaultRunAction write FDefaultRunAction;
    property DefaultPrevAction: TDefaultActionEvent  read FDefaultPrevAction write FDefaultPrevAction;
    property DefaultNextAction: TDefaultActionEvent  read FDefaultNextAction write FDefaultNextAction;
  end;
  TComboTree = class(TWinControl)
  private
    FListOnly: boolean; //true只显示选择树而不能修改Edit内容
    FShowType: TShowType; //在Edit中显示选择的Tree节点的ID还是Name. 可以添加其他。
    Fbtn : TSuiArrowButton;
    FEdit: TMySuiEdit;
    FIndex : integer;
    FTree: TPopTreeForm;
    FOnSelect: TOnSelectEvent;
    FAutoExpandSelect: boolean;
    procedure ClearEdit;
    function getModify: boolean;
    procedure setModify(value: boolean);
    function getIsDownList: boolean;
    procedure SetEditRect;
    procedure DrawControlBorder(WinControl : TWinControl; BorderColor, Color : TColor; DrawColor : Boolean = true);
    function getSelfHeight: integer;
    procedure setSelfHeight(iValue: integer);
    function getSelfWidth: integer;
    procedure setSelfWidth(iValue: integer);
    function getTreeHeight: integer;
    procedure setTreeHeight(iValue: integer);
    function getTreeWidth: integer;
    procedure setTreeWidth(iValue: integer);
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);  override;
    function getBtnWidth: integer;
    procedure setBtnWidth(const Value: integer);
    function getAutoExpandSelectStatus: boolean;
    procedure SetAutoExpandSelectStatus(bValue: boolean);
  protected
    procedure updateSpace; virtual;
    procedure initCtl; virtual;
    function getIsOK: boolean;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMPAINT(var Msg : TMessage); message WM_PAINT;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure CreateParams(var Params: TCreateParams);
    property IsDownListShowing: boolean read getIsDownList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClearTree;
    procedure btnClick(sender: TObject);
    procedure doBtnClick;
    procedure setSelectValue(const id: integer; const Name: string; const index: integer = -1);
    property Modify: boolean read getModify write setModify;
  published
    property Color;
    property Font;
    property Align;
    property Height: integer read getSelfHeight write setSelfHeight;
    property Width: integer read getSelfWidth write setSelfWidth;
    property ButtonWidth: integer read getBtnWidth write setBtnWidth;
    property TreeHeight: integer read getTreeHeight write setTreeHeight;
    property TreeWidth: integer read getTreeWidth write setTreeWidth;
    property AutoExpandSelect: boolean read getAutoExpandSelectStatus write SetAutoExpandSelectStatus;
    property OnSelected: TOnSelectEvent read FOnSelect write FOnSelect;
    property ShowType: TShowType read FShowType write FShowType default stName;  //在Edit中显示ID还是Name;
  end;
procedure Register;

implementation

uses Dialogs;

const
  CON_Width = 100;
  CON_Height = 19;
  CON_DefaultBtnWidth = 17;

procedure Register;
begin
  RegisterComponents('HotZhu', [TComboTree]);
end;

procedure TMySuiEdit.WMKeyDown(var Message: TWMKeyDown);
begin
  case Message.CharCode of
    13 : begin
        if Assigned(FDefaultRunAction) then
          FDefaultRunAction();
      end;
    VK_UP : begin
        if Assigned(FDefaultPrevAction) then
          FDefaultPrevAction();
      end;
    VK_Down : begin
        if Assigned(FDefaultNextAction) then
          FDefaultNextAction();
      end;
    $21..VK_Left, VK_Down + 1..$7E : ;
    else
      inherited;
  end;
end;

procedure TComboTree.CreateParams(var Params: TCreateParams);
begin
    inherited;
    Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TComboTree.WMPAINT(var Msg: TMessage);
begin
  inherited;
end;

procedure TComboTree.DrawControlBorder(WinControl : TWinControl; BorderColor, Color : TColor; DrawColor : Boolean = true);
var
    DC : HDC;
    Brush : HBRUSH;
    R: TRect;
begin
    DC := GetWindowDC(WinControl.Handle);
    GetWindowRect(WinControl.Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    Brush := CreateSolidBrush(ColorToRGB(BorderColor));
    FrameRect(DC, R, Brush);
    DeleteObject(Brush);
    if DrawColor then
    begin
        Brush := CreateSolidBrush(ColorToRGB(Color));
        R := Rect(R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom - 1);
        FrameRect(DC, R, Brush);
        DeleteObject(Brush);
    end;
    ReleaseDC(WinControl.Handle, DC);
end;

procedure TComboTree.SetEditRect;
var
    Loc: TRect;
begin
    SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
    Loc.Right := Loc.Right - FBtn.Width - 2;
    SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
    SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); {debug}
    Loc.Top := Loc.Top;
end;

procedure TComboTree.btnClick(sender: TObject);
begin
  doBtnClick;
end;

procedure TComboTree.doBtnClick;
var
  p: TPoint;
begin
  if (self.FTree <> nil) then
  begin
    p.x := self.FEdit.Left;
    P.Y := self.FEdit.Top + self.FEdit.Height;
    P := self.FEdit.ClientToScreen(p);
    self.FTree.Top := P.y - 1;
    self.FTree.Left := P.x - 1;
    if self.FTree.Visible then
      self.FTree.BringToFront
    else
      self.FTree.show;
  end;
end;

procedure TComboTree.ClearTree;
begin
  self.FEdit.Text := '';
  if (self.FTree <> nil) and (self.FTree.Tree <> nil) then
    self.FTree.Tree.Clear;
end;

procedure TComboTree.ClearEdit;
begin
  self.FEdit.Text := '';
end;

procedure TComboTree.initCtl;
begin
  FEdit.ReadOnly := true;
  updateSpace;
  self.Invalidate;
  FEdit.Modified := false;
end;

procedure TComboTree.updateSpace;
begin
  if FBtn <> nil then
    FBtn.Align := alRight;
  if FEdit <> nil then
  begin
    FEdit.Align := alClient;
    FEdit.Align := alNone;
    FEdit.Width := FEdit.Width + 1;
  end;
  self.Invalidate;
end;

constructor TComboTree.Create(AOwner: TComponent);
const
  EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight];
begin
  inherited Create(AOwner);
  if (self <> nil) and (self.parent = nil) and (AOwner <> nil) and AOwner.InheritsFrom(TForm) then
  //  self.parent := AOwner as TForm;
  ControlStyle := EditStyle;
  FIndex := -1;
  self.AutoSize := false;
  self.Height := CON_Height;
  self.Width := CON_Width;
  self.ParentColor := false;
  self.ShowType := stName;
  self.Font.Charset := GB2312_CHARSET;
  self.Font.Name := '宋体';
  self.Font.Size := 9;
  self.FListOnly := true;
  FBtn := TsuiArrowButton.Create(self);
  FBtn.Parent := self;
  FBtn.AutoSize := false;
  FBtn.Arrow := suiDown;
  FBtn.Width := CON_DefaultBtnWidth;
  FBtn.Height := self.Height;
  FBtn.Align := alright;
  FEdit:= TMySuiEdit.Create(self);
  FEdit.Parent := self;
  FEdit.Align := alClient;
  FEdit.Align := alNone;
  FEdit.Top := FBtn.Top;
  FEdit.Height := FBtn.Height;
  FEdit.Left := self.Left;
  FEdit.Width := self.Width - FBtn.Width + 1;
  FEdit.ReadOnly := true;
  FEdit.ParentFont := true;
  FEdit.ParentColor := true;
  FEdit.Ctl3D := false;
  initCtl;
  ClearTree;
  FBtn.Visible := true;
  FEdit.Visible := true;
  self.Visible := true;
  self.Modify := false;
  self.Fbtn.OnClick := btnClick;
  FTree:= TPopTreeForm.Create(self);
  self.FTree.OnSelectedValueEvent := setSelectValue;
  self.TreeHeight:= CON_TreeDefautHeight;
  self.TreeWidth:= CON_TreeDefautWidth;
  AutoExpandSelect:= CON_DefaultAutoExpandSelectStatus;
  FEdit.DefaultRunAction := doBtnClick;
  FEdit.DefaultPrevAction := self.FTree.SelectPrev;
  FEdit.DefaultNextAction := self.FTree.SelectNext;
  self.Invalidate;
end;

destructor TComboTree.Destroy;
begin
  inherited;
end;

function TComboTree.getModify: boolean;
begin
  result := self.FEdit.Modified;
end;

procedure TComboTree.setModify(value: boolean);
begin
  self.FEdit.Modified := value;
end;

function TComboTree.getIsOK: boolean;
begin

end;

procedure TComboTree.WMSize(var Message: TWMSize);
begin
  inherited;
  updateSpace;
end;

function TComboTree.getIsDownList: boolean;
begin
  if (self.FTree <> nil) and (self.FTree.Visible) then
    Result := true
  else
    Result := false;
end;

procedure TComboTree.setSelectValue(const id: integer; const Name: string; const index: integer = -1);
begin
  case ShowType of
    stID : self.FEdit.Text := IntToStr(id);
    stName: self.FEdit.Text := Name;
  end;
  self.FIndex := index;
end;

function TComboTree.getAutoExpandSelectStatus: boolean;
begin
 if self.FTree = nil then
   Result := CON_DefaultAutoExpandSelectStatus
 else
   Result := self.FTree.getAutoExpandSelectStatus
end;

procedure TComboTree.SetAutoExpandSelectStatus(bValue: boolean);
begin
  if self.FTree <> nil then
    self.FTree.SetAutoExpandSelectStatus(bValue);
end;

procedure TComboTree.setSelfHeight(iValue: integer);
begin
  //if iValue > 0 then
  begin
    inherited Height := iValue;
    //self.updateSpace;
  end;
end;

function TComboTree.getSelfWidth: integer;
begin
  Result := inherited Width;
end;

procedure TComboTree.setSelfWidth(iValue: integer);
begin
  //if iValue > 0 then
  begin
    inherited Width := iValue;
    //self.updateSpace;
  end;
end;

function TComboTree.getSelfHeight: integer;
begin
  Result := inherited Height;
end;

procedure TComboTree.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  self.updateSpace;
end;

function TComboTree.getTreeHeight: integer;
begin
  if self.FTree = nil then
    Result := CON_TreeDefautHeight
  else
    Result := self.FTree.Height;
end;

function TComboTree.getTreeWidth: integer;
begin
  if self.FTree = nil then
    Result := CON_TreeDefautWidth
  else
    Result := self.FTree.Width;
end;

procedure TComboTree.setTreeHeight(iValue: integer);
begin
  if self.FTree <> nil then
  begin
    if iValue > CON_TreeMinHeight then
      self.FTree.Height := iValue;
  end;
end;

procedure TComboTree.setTreeWidth(iValue: integer);
begin
  if self.FTree <> nil then
  begin
    if iValue > CON_TreeMinWidth then
      self.FTree.Width := iValue;
  end;
end;

function TComboTree.getBtnWidth: integer;
begin
  if FBtn = nil then
    Result := CON_DefaultBtnWidth
  else
    Result := self.FBtn.Width;
end;

procedure TComboTree.setBtnWidth(const Value: integer);
begin
  if (Value > 0) and (Value < self.Width) then
  begin
    self.Fbtn.Width := Value;
    self.updateSpace;
  end;
end;


procedure TComboTree.CNKeyDown(var Message: TWMKeyDown);
begin
  inherited;

end;

procedure TComboTree.WMKeyDown(var Message: TWMKeyDown);
begin
  case Message.CharCode of
    38: self.FTree.SelectPrev;
    40: self.FTree.SelectNext;
  else
    inherited;
  end;
end;

initialization
  //Classes.RegisterClass(TPopTreeForm);
finalization
  //Classes.UnRegisterClass(TPopTreeForm);

end.