dbtreecbox.pas

delphi编程控件

unit dbTreeCBox;

{ TDbTreeLookupComboBox: ComboBox that shows a DBTreeView instead of a list.
  Version 0.8  Jun-14-1997  (C) 1997 Christoph R. Kirchner
  !! This component is currently UNDER CONSTRUCTION !!
}

{ Requires the TDBTreeView component, a data-aware TTreeView component
  that you can find in dbTree.PAS. If you do not have it, please look at:
  http://www.geocities.com/SiliconValley/Heights/7874/delphi.htm
}

{ Users of this unit must accept this disclaimer of  warranty:
    "This unit is supplied as is. The author disclaims all warranties,
    expressed or implied, including, without limitation, the warranties of
    merchantability and of fitness for any purpose.
    The author assumes no liability for damages, direct or consequential,
    which may result from the use of this unit."

  This Unit is donated to the public as public domain.

  This Unit can be freely used and distributed in commercial and private
  environments provided this notice is not modified in any way.

  If you do find this Unit handy and you feel guilty for using such a great
  product without paying someone - sorry :-)

  Please forward any comments or suggestions to Christoph Kirchner at:
  [e-mail]

  Maybe you can find an update of this component at my homepage:
  http://www.geocities.com/SiliconValley/Heights/7874/delphi.htm
}

{$DEFINE RedefineTDBLookupControl} { See below about this switch...}
{ Please $DEFINE RedefineTDBLookupControl if you do not want to change the
  definition of TDBLookupControl in the unit DBCtrls.

  Otherwise you have to do the following: (Tested with Delphi 2.0 only)
  - Copy DBCtrls.PAS from Delphi\Source\VCL into Delphi\Lib
  - Replace the definition of TDBLookupControl in the unit DBCtrls with the
    definition of TCustomDBLookupControl in this unit.
    (Changes are marked with *)

  This is needed because the TDBLookupControl is useless outside DBCtrls.PAS -
  too many important functions are in the private section. This could happen
  due to a (IMHO) big mistake in Borlands definition of the Delphi-language:
  Private declarations are not private but protected inside the unit. For this,
  the Borland-programmers did not care about a useful declaration of
  TDBLookupControl - they just declared all decendants in the same unit.
}
{ Thanks to Peter M. Jagielski ([e-mail]) for contributing
  an idea how to get the rect a window can use without getting hidden by the
  Win95-Taskbar. (He published a procedure SizeForTaskBar in sizetask.zip). }

interface

uses SysUtils, Windows, Messages, Classes, Controls, Forms,
  Graphics, Menus, StdCtrls, ExtCtrls, DB, DBTables, Mask, Buttons,
  DBCtrls, ComCtrls, dbTree, TreeVwEx;

type

  TDbTreeLookupComboBox = class;

  TCloseUpAction = (caCancel, caAccept, caClear);
  TCloseUpEvent = procedure (Action: TCloseUpAction) of object;
  TAcceptNodeEvent = procedure (Node: TTreeNode; var Accept: Boolean) of object;

  TDBTreeLCBOption = (dtAcceptLeavesOnly, dtDontAcceptRoot,
                      dtKeepDataSetConnected);
  TDBTreeLCBOptions = set of TDBTreeLCBOption;

{ Options:

  dtAcceptLeavesOnly:
    The User can only select nodes that have no children.
    If you use the event OnAcceptNode, Accept is set to false if the
    node has children. But you can accept the node anyway by setting
    Accept to true.
  dtDontAcceptRoot:
    The User can not select the root-node.
    If you use the event OnAcceptNode, Accept is set to false if the
    node is the root-node. But you can accept the node anyway by setting
    Accept to true.
  dtKeepDataSetConnected:
    The DataSource TDbTreeLookupComboBox.ListSource or the LookupDataSet
    of TDbTreeLookupComboBox.ListField will be always connected to the
    TDBTreeView of the dropdown-panel. If you set dtKeepDataSetConnected
    to false, a complete rebuild of the tree is needed before each dropdown.
}


  TTreeSelect = class(TForm)
  private
    FCallingDbTreeLookupComboBox: TDbTreeLookupComboBox;
    FOnCloseUp: TCloseUpEvent;
    FOnAcceptNode: TAcceptNodeEvent;
    FDBTreeView: TCustomDBTreeView;
    FOldOnDBTreeViewMouseSelect: TNotifyEvent;
    FDBTreeViewSelfCreated: Boolean; { true: We will destroy it at end }
    FPosUnderComboBox: Boolean;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Deactivate; override;
    procedure Loaded; override;
    procedure OnDBTreeViewMouseSelect(Sender: TObject); virtual;
    function  GetDBTreeView: TCustomDBTreeView; virtual;
    procedure SetDBTreeView(Value: TCustomDBTreeView); virtual;
    property OnAcceptNode: TAcceptNodeEvent
      read FOnAcceptNode write FOnAcceptNode;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CloseUp(Action: TCloseUpAction);
    function CanAccept(Node: TTreeNode): Boolean; virtual;
    property DBTreeView: TCustomDBTreeView read GetDBTreeView write SetDBTreeView;
    property OnCloseUp: TCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property CallingDbTreeLookupComboBox: TDbTreeLookupComboBox
      read FCallingDbTreeLookupComboBox;
    property PosUnderComboBox: Boolean read FPosUnderComboBox;
  end;


{$IFDEF RedefineTDBLookupControl}
{ This part is copied from the unit DBCtrls.
  Copyright (c) 1995,96 Borland International }

  TCustomDBLookupControl = class;

  TDataSourceLink = class(TDataLink)
  private
    FDBLookupControl: TCustomDBLookupControl;
  protected
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
  end;

  TListSourceLink = class(TDataLink)
  private
    FDBLookupControl: TCustomDBLookupControl;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
  end;

  TCustomDBLookupControl = class(TCustomControl)
  private
    FLookupSource: TDataSource;
    FDataLink: TDataSourceLink;
    FListLink: TListSourceLink;
    FDataFieldName: string;
    FKeyFieldName: string;
    FListFieldName: string;
    FListFieldIndex: Integer;
    FDataField: TField;
    FMasterField: TField;
    FKeyField: TField;
    FListField: TField;
    FListFields: TList;
    FKeyValue: Variant;
    FSearchText: string;
    FLookupMode: Boolean;
    FListActive: Boolean;
    FFocused: Boolean;
    procedure CheckNotCircular;
    procedure CheckNotLookup;
    procedure DataLinkActiveChanged;
    function GetDataSource: TDataSource;
    function GetKeyFieldName: string;
    function GetListSource: TDataSource;
    function GetReadOnly: Boolean;
    procedure SetDataFieldName(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetKeyFieldName(const Value: string);
    procedure SetKeyValue(const Value: Variant);
    procedure SetListFieldName(const Value: string);
    procedure SetListSource(Value: TDataSource);
    procedure SetLookupMode(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
  protected
  { * Moved from private to protected and made virtual: }
    procedure DataLinkRecordChanged(Field: TField);  virtual;
  { * Moved (virtual) procedures from private to protected: }
    function CanModify: Boolean;
    procedure KeyValueChanged; virtual;
    procedure ListLinkActiveChanged; virtual;
    procedure ListLinkDataChanged; virtual;
    function LocateKey: Boolean;
    procedure SelectKeyValue(const Value: Variant);
    function GetTextHeight: Integer;
    function GetBorderSize: Integer;
  { * Read private "Fxxx" with protected "FFxxx":}
    property FFLookupMode: Boolean read FLookupMode;
    property FFKeyField: TField read FKeyField;
    property FFDataField: TField read FDataField;
    property FFDataFieldName: string read FDataFieldName;
    property FFDataLink: TDataSourceLink read FDataLink;
    property FFListLink: TListSourceLink read FListLink;
    property FFListField: TField read FListField;
    property FFListActive: Boolean read FListActive;
    property FFFocused: Boolean read FFocused;
  { * Read and write private "Fxxx" with protected "FFxxx":}
    property FFSearchText: string read FSearchText write FSearchText;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    property DataField: string read FDataFieldName write SetDataFieldName;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property KeyField: string read GetKeyFieldName write SetKeyFieldName;
    property KeyValue: Variant read FKeyValue write SetKeyValue;
    property ListField: string read FListFieldName write SetListFieldName;
    property ListFieldIndex: Integer
      read FListFieldIndex write FListFieldIndex default 0;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property ParentColor default False;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property TabStop default True;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
{$ELSE DEF RedefineTDBLookupControl}
  TCustomDBLookupControl = class(TDBLookupControl)
  end;
{$ENDIF DEF RedefineTDBLookupControl}

{ TDbTreeLookupComboBox }

  TCreateTreeSelectEvent = function: TTreeSelect of object;
  TGetTreeSelectEvent = function: TTreeSelect of object;
  TDropDownAlign = (daLeft, daRight, daCenter);

  TDbTreeLookupComboBox = class(TCustomDBLookupControl)
  private
    FButtonWidth: Integer;
    FText: string;
    FDropDownWidth: Integer;
    FDropDownAlign: TDropDownAlign;
    FDropDownHeight: Integer;
    FListVisible: Boolean;
    FPressed: Boolean;
    FTracking: Boolean;
    FAlignment: TAlignment;
    FOnDropDown: TNotifyEvent;
    FOnCloseUp: TCloseUpEvent;
    FNoMouseDropDown: Boolean;
    FOptions: TDBTreeLCBOptions;
    procedure ListLinkActiveChanged; override;
    procedure StopTracking;
    procedure TrackButton(X, Y: Integer);
    procedure ProcessSearchKey(Key: Char);
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  private { TreeView }
    FTreeSelect: TTreeSelect;
    FTreeSelectSelfCreated: Boolean;
    FListTreeIDField: string;
    FListTreeParentField: string;
    FListTreeRootID: string;
    FOnAcceptNode: TAcceptNodeEvent;
    FOnCreateTreeSelect: TCreateTreeSelectEvent;
    FTreeSelectOnDestroy: TNotifyEvent;
    procedure AcceptNode(Node: TTreeNode; var Accept: Boolean);
    procedure SetTreeSelect(Value: TTreeSelect);
    function GetTreeSelect: TTreeSelect;
    procedure SetListTreeIDField(const Value: String);
    procedure SetListTreeParentField(const Value: String);
    procedure TreeSelectFormDestroy(Sender: TObject);
    function GetTvDataset: TDataset;
    function GetDBTreeView: TCustomDBTreeView;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure DataLinkRecordChanged(Field: TField);
      {$IFDEF RedefineTDBLookupControl} override; {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CloseUp(Action: TCloseUpAction);
    procedure DropDown;
    procedure KeyValueChanged; override;
    property KeyValue;
    property ListVisible: Boolean read FListVisible;
    property Text: string read FText;
  { TreeView }
  { You can use PrepareDropdown to build the tree of the dropdown-panel
    before first dropdown happens (datasets have to be open already) -
    the first dropdown will get faster then: }
    procedure PrepareDropdown;
  { The dataset of the DBTreeView of the dropdown-panel: }
    property DBTreeViewDataset: TDataset read GetTvDataset;
  { The dropdown-panel itself: }
    property TreeSelect: TTreeSelect read GetTreeSelect write SetTreeSelect;
  { The DBTreeView of the dropdown-panel: }
    property DBTreeView: TCustomDBTreeView read GetDBTreeView;
  published
    property Color;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property DropDownAlign: TDropDownAlign
      read FDropDownAlign write FDropDownAlign default daLeft;
    property DropDownWidth: Integer
      read FDropDownWidth write FDropDownWidth default 0;
    property DropDownHeight: Integer
      read FDropDownHeight write FDropDownHeight default 0;
    property Enabled;
    property Font;
    property KeyField;
    property ListField;
{   property ListFieldIndex; }
    property ListSource;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnCloseUp: TCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  published { TreeView }
    property ListTreeIDField: string
      read FListTreeIDField write SetListTreeIDField;
    property ListTreeParentField: string
      read FListTreeParentField write SetListTreeParentField;
    property ListTreeRootID: string
      read FListTreeRootID write FListTreeRootID;
    property OnAcceptNode: TAcceptNodeEvent
      read FOnAcceptNode write FOnAcceptNode;
    property OnCreateTreeSelect: TCreateTreeSelectEvent
      read FOnCreateTreeSelect write FOnCreateTreeSelect;
    property Options: TDBTreeLCBOptions read FOptions write FOptions
      default [dtKeepDataSetConnected];
  end;



implementation

{$IFDEF RedefineTDBLookupControl}
uses DBConsts;


{ TDataSourceLink }

procedure TDataSourceLink.ActiveChanged;
begin
  if FDBLookupControl <> nil then FDBLookupControl.DataLinkActiveChanged;
end;

procedure TDataSourceLink.RecordChanged(Field: TField);
begin
  if FDBLookupControl <> nil then FDBLookupControl.DataLinkRecordChanged(Field);
end;

{ TListSourceLink }