fctreecombo.pas

一套及时通讯的原码

unit fctreecombo;
{
//
// Components : TfcTreeCombo
//
// Copyright (c) 2001 by Woll2Woll Software
// 4/10/99 - PYW - When closed up ignore visible when getting the new node.
// 7/24/99 - Publish Color and Text property for Delphi 4 and later
// 11/17/99 - Clear selected so you can type in things not in the list when it is dropped down
// 3/7/00 - Use clGrayText for disabled color
// 7/31/00 - Makes sure modified is set in combo's change
// 7/1/2001- Added mapping capabilites using new StoreDataUsing property.
// 10/1/2001- Exposed OnMouseEnter and OnMouseLeave to be consistent with InfoPower.
// 10/1/2001- Exposed PopupMenu property and OnContextPopup event.
// 11/7/2001- Added method for requested capability to set the SelectedNode programmatically.
// 3/1/2002-Added new function to handle painting in a TDBCtrlGrid
// 3/15/2002 - Don't get new text if user hit Return/Enter key as this messes up Storedatausing path.
// 3/18/2002 - Respect mapped value when framing enabled.
}

interface

{$i fcIfDef.pas}

uses
  Forms, Graphics, Menus, SysUtils, Windows, Messages, Classes,
  Controls, Buttons, fcCommon, fcCombo, fcTreeView, ExtCtrls, Dialogs, Grids,
  db
  {$ifdef fcDelphi4Up}
  , ImgList
  {$endif};

const FCPOPUPTIMERID = 1000;
      FCPOPUPINTERVAL = 50;

type
  TfcPopupPanel = class(TPanel)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TfcCustomTreeCombo = class;

  TfcTreeComboTreeNode = class(TfcTreeNode)
  private
    FSelectable: Boolean;
  protected
    procedure ReadData(Stream: TStream; Info: PfcNodeInfo); override;
    procedure WriteData(Stream: TStream; Info: PfcNodeInfo); override;
    Function GetSizeOfNodeInfo: integer; override;
  public
    constructor Create(AOwner: TfcTreeNodes); override;
  published
    property Selectable: Boolean read FSelectable write FSelectable;
  end;

  TfcPopupTreeView = class(TfcTreeView)
  private
    FLastPoint: TPoint;
    FTimerOn: Boolean;
    FCheckChange: Boolean;
    FTreeCombo: TfcCustomTreeCombo;
    FCloseOnUp: Boolean;
    FClickedInControl: Boolean;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  protected
    procedure CalcNodeAttributes(Node: TfcTreeNode; AItemState: TfcItemStates); override;
    procedure Change(Node: TfcTreeNode); override;
    procedure KillTimer; virtual;
    procedure SetTimer; virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure WndProc(var Message: TMessage); override;
    procedure Collapse(Node: TfcTreeNode); override;

    property TreeCombo: TfcCustomTreeCombo read FTreeCombo;
  public
    constructor Create(AOwner: TComponent); override;
    function ValidNode(Node: TfcTreeNode): Boolean;
    function MovePage(Node: TfcTreeNode; Down: Boolean): TfcTreeNode;
    function GetLastVisible: TfcTreeNode;
    function GetLastNode: TfcTreeNode;
    function SelectValidNode(StartingNode: TfcTreeNode; SelectedNode: TfcTreeNode; Key: Word): Boolean;

    property Items;
  end;

  TfcImgComboOption = (icoExpanded, icoEndNodesOnly);
  TfcImgComboOptions = set of TfcImgComboOption;

  TfcCheckValidItemEvent = procedure(Sender: TObject; Node: TfcTreeNode; var Accept: Boolean) of object;

  TfcCustomTreeCombo = class(TfcCustomCombo)
  private
    // Property Storage Variables
//    FAlignmentVertical: TfcAlignVertical;
    FOriginalNode: TfcTreeNode;
    FOriginalText: String;
    FSelectedNode: TfcTreeNode;
    FPanel: TfcPopupPanel;
    FShowMatchText: Boolean;
    FOptions: TfcImgComboOptions;
    FTreeView: TfcPopupTreeView;
    FDropDownWidth: integer;

    FOnCheckValidItem: TfcCheckValidItemEvent;
    FOnSelectionChange: TNotifyEvent;

    FItemsList: TStringList;
    LastItemIndex: integer;
    LastItemText: string;
    SetModifiedInChangeEvent: boolean;
    FStoreDataUsing: TwwStoreData;

    function GetCalcNodeAttributes: TfcCalcNodeAttributesEvent;
    function GetImageList: TCustomImageList;
    function GetStateImageList: TCustomImageList;
    function GetItems: TfcTreeNodes;
    function GetSorted: Boolean;
    function GetTreeOptions: TfcTreeViewOptions;
//    procedure SetAlignmentVertical(Value: TfcAlignVertical);
    procedure SetCalcNodeAttributes(Value: TfcCalcNodeAttributesEvent);
    procedure SetItems(Value: TfcTreeNodes);
    procedure SetImageList(Value: TCustomImageList);
    procedure SetStateImageList(Value: TCustomImageList);
    procedure SetSorted(Value: Boolean);
    procedure SetTreeOptions(Value: TfcTreeViewOptions);

    // Message Handlers
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure InvalidateImage;
    function CalcImageRect(Rect: TRect): TRect;
  protected
    // Virtual Methods
    function CreatePopupTreeView: TfcPopupTreeView; virtual;
    function GetStartingNode: TfcTreeNode; virtual;
    procedure Change; override;
    procedure ItemsChange(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
      Action: TfcItemChangeAction; NewValue: Variant); virtual;
    procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect; Highlight, GridPaint: Boolean;
      Text: string); override;
    procedure ResyncTreeSelected(LookupText: string); virtual;
    procedure SelectionChange; virtual;
    procedure SelectionChanging; virtual;
    procedure DataChange(Sender: TObject); override;
    procedure UpdateData(Sender: TObject); override;


    // Overridden Methods
    function GetDropDownControl: TWinControl; override;
    function GetDropDownContainer: TWinControl; override;
    function GetItemCount: Integer; override;
    function GetItemSize: TSize; override;
    function GetLeftIndent: Integer; override;
    function GetEditRect: TRect; override;
    procedure CreateWnd; override;
    procedure KeyUp(var Key: WORD; Shift: TShiftState); override;
    procedure KeyDown(var Key: WORD; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
    Function Editable: boolean; override;
    procedure HideCaret; override;
    property ItemsList: TStringList read FItemsList;
  public
    BasePatch: Variant;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function IsValidNode(Node: TfcTreeNode): Boolean; virtual;
    procedure CloseUp(Accept: Boolean); override;
    procedure DrawInGridCell(ACanvas: TCanvas; Rect: TRect;
      State: TGridDrawState); override;
    procedure DropDown; override;
    function IsDroppedDown: Boolean; override;
    procedure SetSelectedNode(Node:TfcTreeNode); virtual;

    property DropDownWidth : integer read FDropDownWidth write FDropDownWidth default 0;
    property Sorted: Boolean read GetSorted write SetSorted;
    property TreeView: TfcPopupTreeView read FTreeView;
    property Images: TCustomImageList read GetImageList write SetImageList;
    property StateImages: TCustomImageList read GetStateImageList write SetStateImageList;
    property Items: TfcTreeNodes read GetItems write SetItems;
    property Options: TfcImgComboOptions read FOptions write FOptions;
    property SelectedNode: TfcTreeNode read FSelectedNode;
    property ShowMatchText: Boolean read FShowMatchText write FShowMatchText;
    property TreeOptions: TfcTreeViewOptions read GetTreeOptions write SetTreeOptions default
        [tvoShowButtons, tvoShowRoot, tvoShowLines, tvoHideSelection, tvoToolTips];

    property StoreDataUsing: TwwStoreData read FStoreDataUsing write FStoreDataUsing default sdStoreText;
    property OnCheckValidItem: TfcCheckValidItemEvent read FOnCheckValidItem write FOnCheckValidItem;
    property OnCalcNodeAttributes: TfcCalcNodeAttributesEvent read GetCalcNodeAttributes write SetCalcNodeAttributes;
    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
  end;

  TfcTreeCombo = class(TfcCustomTreeCombo)
  published
    property Controller;
    property DisableThemes;

    property AlignmentVertical;
    {$ifdef fcDelphi4Up}
    property Anchors;
    property Constraints;
    {$endif}

    property AllowClearKey;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property ButtonStyle;
    property ButtonEffects;
    property ButtonGlyph;
    property ButtonWidth;
    property CharCase;
    {$ifdef fcDelphi4Up}
    property Color;
    property Text;
    {$endif}
    property Frame;
    property DataField;
    property DataSource;
    property DropDownCount;
    property DropDownWidth;
    property Enabled;
    property Font;
    property HideSelection;
    property Images;
    property InfoPower;
    property MaxLength;
    property Items;
    property Options;
    property PopupMenu;
    property ReadOnly;
    property ShowButton;
    property ShowHint;
    property ShowMatchText;
    property Sorted;
    property StateImages;
    property StoreDataUsing;
    property Style;
    property TabOrder;
    property TreeOptions;
    property Visible;

    property OnCalcNodeAttributes;
    property OnClick;
    property OnChange;
    property OnCheckValidItem;
    property OnCloseUp;
    {$ifdef fcDelphi5Up}
    property OnContextPopup;
    {$endif}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnAfterDropDown;
    {$ifdef fcDelphi4up}
    property OnEndDock;
    property OnStartDock;
    {$endif}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSelectionChange;
    property OnStartDrag;
  end;

implementation

uses
{$ifdef fcdelphi6Up}
variants,
{$endif}
 fcframe;
 
//type
//  TwwCheatGridCast = class(TwwDBGrid);

{$ifndef fcDelphi4Up}
function fcIsInwwObjectView(control: TWinControl):boolean;
begin
  result := False;
end;
function fcIsInwwObjectViewPaint(control: TWinControl):boolean;
begin
  result := False;
end;
{$endif}

procedure TfcPopupPanel.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    Style := WS_POPUP or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW;
    {$ifdef fcDelphi4up}
    AddBiDiModeExStyle(ExStyle);
    {$endif}
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

constructor TfcPopupPanel.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csNoDesignVisible, csReflector, csReplicatable];
  BevelInner := bvNone;
  BevelOuter := bvNone;
  Height := 100;
end;

constructor TfcTreeComboTreeNode.Create(AOwner: TFCTreeNodes);
begin
  inherited Create(AOwner);
  FSelectable := True;
  SelectedIndex := -1;
end;

// Read/WriteData Methods overridden and implemented to support any
// boolean properties added to TfcTreeComboTreeNode.  The Selectable
// property, to be specific.

Function TfcTreeComboTreeNode.GetSizeOfNodeInfo: integer;
var BoolProps: TStringList;
begin
  BoolProps := TStringList.Create;
  result:= inherited GetSizeOfNodeInfo;
  fcGetBooleanProps(self, BoolProps);
  result:= result + BoolProps.Count* SizeOf(boolean) + SizeOf(Integer);
  BoolProps.Free;
end;


procedure TfcTreeComboTreeNode.ReadData(Stream: TStream; Info: PfcNodeInfo);
var BoolProps: TStringList;
    i: Integer;
    CurBool: Boolean;
    Count: Integer;
    {$ifdef fcDelphi4Up}
    L, Size: integer;
    {$endif}
begin
  if TfcCustomTreeView(TreeView).StreamVersion=1 then inherited;

  BoolProps := TStringList.Create;
  fcGetBooleanProps(self, BoolProps);

  if TfcCustomTreeView(TreeView).StreamVersion=1 then
  begin
     { If streaming from TfcTreeView then don't read in flags }
     { ReadDataSize represents the size of the node written to the stream }
     {$ifdef fcDelphi4Up}
      L := Length(Text);
     if L > 255 then L := 255;
     Size := GetSizeOfNodeInfo + L - 255;

     if (ReadDataSize<Size) then
     begin
        BoolProps.Free;
        exit; { No more data to read so finished }
     end
     else
     {$endif}

     { Base class does not know about our structure so subtract the amount }
     Stream.Position:= Stream.Position - (GetSizeOfNodeInfo - SizeOf(Info^));
  end;

  Stream.ReadBuffer(Count, SizeOf(Count));
  for i := 0 to Count - 1 do
  begin
    Stream.ReadBuffer(CurBool, SizeOf(CurBool));
    fcSetOrdProp(self, BoolProps[i], ord(CurBool));
  end;
  BoolProps.Free;