jvdblookuptreeview.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBLookupTreeView.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Components:
  TJvDBLookupTreeView,
  TJvDBLookupTreeViewCombo

Description:
  db-aware lookup TreeView

History:
 (JVCL Library versions):
  1.20:
    - first release;
  1.61:
    - support for non-bde components;
  2.01:
    - support for BiDi mode
     (thanks to Oussama Al-Rifai);

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDBLookupTreeView.pas,v 1.30 2005/02/18 14:17:23 ahuser Exp $

unit JvDBLookupTreeView;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF VCL}
  Windows, Messages,
  {$ENDIF VCL}
  Classes, Controls, Forms, ComCtrls, DB,
  JvDBTreeView, JvToolEdit, JvComponent, JvExControls;

{********************** Borland **********************}

type
  TJvDBLookupControl = class;

  TJvLookupDataSourceLink = class(TDataLink)
  private
    FDBLookupControl: TJvDBLookupControl;
  protected
    procedure FocusControl(Field: TFieldRef); override;
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
  end;

  TJvLookupListSourceLink = class(TDataLink)
  private
    FDBLookupControl: TJvDBLookupControl;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
  end;

  TJvDBLookupControl = class(TJvCustomControl)
  private
    FLookupSource: TDataSource;
    FDataLink: TJvLookupDataSourceLink;
    FListLink: TJvLookupListSourceLink;
    FDataFieldName: string;
    FKeyFieldName: string;
    FListFieldName: string;
    FListFieldIndex: Integer;
    FDataField: TField;
    FMasterField: TField;
    FKeyField: TField;
    FListField: TField;
    FListFields: TList;
    FKeyValue: Variant;
    FUseFilter: Boolean;
    FSearchText: string;
    FLookupMode: Boolean;
    FListActive: Boolean;
    FFocused: Boolean;
    FSearchTickCount: Integer;
    function CanModify: Boolean;
    procedure CheckNotCircular;
    procedure CheckNotLookup;
    procedure DataLinkActiveChanged;
    procedure DataLinkRecordChanged(Field: TField);
    function GetBorderSize: Integer;
    function GetDataSource: TDataSource;
    function GetKeyFieldName: string;
    function GetListSource: TDataSource;
    function GetReadOnly: Boolean;
    function GetTextHeight: Integer;
    procedure KeyValueChanged; virtual;
    procedure ListLinkActiveChanged; virtual;
    procedure ListLinkDataChanged; virtual;
    function LocateKey: Boolean;
    procedure ProcessSearchKey(Key: Char);
    procedure SelectKeyValue(const Value: Variant);
    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 CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
  protected
    procedure FocusKilled(NextWnd: HWND); override;
    procedure FocusSet(PrevWnd: HWND); override;
    procedure GetDlgCode(var Code: TDlgCodes); override;
    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 UseFilter: Boolean read FUseFilter write FUseFilter;
    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;
    property Field: TField read FDataField;
  end;

  TJvTreePopupDataList = class;

  TDropDownAlign = (daLeft, daRight, daCenter);

  TJvDBLookupTreeViewCombo = class(TJvDBLookupControl)
  private
    FDataList: TJvTreePopupDataList;
    FButtonWidth: Integer;
    FText: string;
//    FDropDownRows: Integer;
    FTracking: Boolean;
    FDropDownWidth: Integer;
    FDropDownHeight: Integer;
    FDropDownAlign: TDropDownAlign;
    FListVisible: Boolean;
    FPressed: Boolean;
    FAlignment: TAlignment;
    FLookupMode: Boolean;
    FOnDropDown: TNotifyEvent;
    FOnCloseUp: TNotifyEvent;
    FMasterField: string;      {new}
    FDetailField: string;      {new}
    FIconField: string;        {new}
    FStartMasterValue: string;
    FFullExpand: Boolean; {new}
    procedure KeyValueChanged; override;
    procedure ListLinkActiveChanged; override;
{    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);}
    procedure StopTracking;
    procedure TrackButton(X, Y: Integer);
    procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
    procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
    procedure WMCancelMode(var Msg: TMessage); message WM_CANCELMODE;
    procedure CMCancelMode(var Msg: TCMCancelMode); message CM_CANCELMODE;
    procedure PopupCloseUp(Sender: TObject; Accept: Boolean); virtual;
  private
    FAutoExpand: Boolean;
    FChangeDelay: Integer;
    FHotTrack: Boolean;
    FRowSelect: Boolean;
    FToolTips: Boolean;
    FOnCustomDraw: TTVCustomDrawEvent;
    FOnCustomDrawItem: TTVCustomDrawItemEvent;
    FOnGetImageIndex: TTVExpandedEvent;
  protected
    procedure FontChanged; override;
    procedure FocusKilled(NextWnd: HWND); override;
    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;
    {added by zelen}
    {$IFDEF JVCLThemesEnabled}
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    {$ENDIF JVCLThemesEnabled}
    {/added by zelen}
  public
    constructor Create(AOwner: TComponent); override;
    procedure CloseUp(Accept: Boolean);
    procedure DropDown;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property KeyValue;
    property ListVisible: Boolean read FListVisible;
    property Text: string read FText;
  published
    property Color;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property DropDownAlign: TDropDownAlign read FDropDownAlign write FDropDownAlign default daLeft;
//    property DropDownRows: Integer read FDropDownRows write FDropDownRows default 7;
    property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
    {new}
    property DropDownHeight: Integer read FDropDownHeight write FDropDownHeight default 100;

    property Enabled;
    property Font;
    property KeyField;
    property ListField;
    property UseFilter;
    {new}
    property MasterField: string read FMasterField write FMasterField;
    property DetailField: string read FDetailField write FDetailField;
    property IconField: string read FIconField write FIconField;
    property StartMasterValue: string read FStartMasterValue write FStartMasterValue;

    property ListFieldIndex;
    property ListSource;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnCloseUp: TNotifyEvent 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;
    property ImeMode;
    property ImeName;
    property Anchors;
    property BiDiMode;
    property BorderWidth;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
    property AutoExpand: Boolean read FAutoExpand write FAutoExpand;
    property ChangeDelay: Integer read FChangeDelay write FChangeDelay;
    property HotTrack: Boolean read FHotTrack write FHotTrack;
    property RowSelect: Boolean read FRowSelect write FRowSelect;
    property ToolTips: Boolean read FToolTips write FToolTips;
    property OnCustomDraw: TTVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
    property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem;
    property OnGetImageIndex: TTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex;
    property FullExpand: Boolean read FFullExpand write FFullExpand default False;
  end;

{###################### Borland ######################}

  TJvPopupTree = class(TJvDBTreeView)
  private
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
  protected
    procedure FocusSet(PrevWnd: HWND); override;
    procedure DblClick; override;
  end;

  TJvTreePopupDataList = class(TJvPopupWindow)
  private
    FTree: TJvPopupTree;
  protected
    function GetValue: Variant; override;
    procedure SetValue(const Value: Variant); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function GetPopupText: string; override;
  end;

  TJvDBLookupTreeView = class(TJvDBLookupControl)
  private
    FTree: TJvDBTreeView;
    FBorderStyle: TBorderStyle;
    InKeyValueChanged: Boolean;
    procedure SetBorderStyle(Value: TBorderStyle);
    function GetMasterField: string;
    procedure SetMasterField(Value: string);
    function GetDetailField: string;
    procedure SetDetailField(Value: string);
    function GetStartMasterValue: string;
    procedure SetStartMasterValue(Value: string);
    function GetIconField: string;
    procedure SetIconField(const Value: string);
    procedure KeyValueChanged; override;
   {Tree}
    function GetShowButtons: Boolean;
    function GetShowLines: Boolean;
    function GetShowRoot: Boolean;
    function GetReadOnly: Boolean;
    function GetHideSelection: Boolean;
    function GetIndent: Integer;
    procedure SetShowButtons(Value: Boolean);
    procedure SetShowLines(Value: Boolean);
    procedure SetShowRoot(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure SetHideSelection(Value: Boolean);
    procedure SetIndent(Value: Integer);
    function GetRightClickSelect: Boolean;
    procedure SetRightClickSelect(Value: Boolean);
    function GetAutoExpand: Boolean;
    function GetChangeDelay: Integer;
    function GetHotTrack: Boolean;
    function GetOnGetImageIndex: TTVExpandedEvent;
    function GetRowSelect: Boolean;
    function GetToolTips: Boolean;
    procedure SetAutoExpand(const Value: Boolean);
    procedure SetChangeDelay(const Value: Integer);
    procedure SetHotTrack(const Value: Boolean);
    procedure SetOnGetImageIndex(const Value: TTVExpandedEvent);
    procedure SetRowSelect(const Value: Boolean);
    procedure SetToolTips(const Value: Boolean);
    function GetOnCustomDraw: TTVCustomDrawEvent;
    function GetOnCustomDrawItem: TTVCustomDrawItemEvent;
    procedure SetOnCustomDraw(const Value: TTVCustomDrawEvent);
    procedure SetOnCustomDrawItem(const Value: TTVCustomDrawItemEvent);
  protected
    procedure FocusSet(PrevWnd: HWND); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure ListLinkActiveChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Color;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property KeyField;
    property ListField;
    property ListFieldIndex;
    property ListSource;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property ImeMode;
    property ImeName;
    property Anchors;
    property BiDiMode;
    property BorderWidth;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;

    property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand;
    property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay;
    property HotTrack: Boolean read GetHotTrack write SetHotTrack;
    property RowSelect: Boolean read GetRowSelect write SetRowSelect;
    property ToolTips: Boolean read GetToolTips write SetToolTips;
    property OnCustomDraw: TTVCustomDrawEvent read GetOnCustomDraw write SetOnCustomDraw;
    property OnCustomDrawItem: TTVCustomDrawItemEvent read GetOnCustomDrawItem write SetOnCustomDrawItem;
    property OnGetImageIndex: TTVExpandedEvent read GetOnGetImageIndex write SetOnGetImageIndex;
    {Tree}
    property MasterField: string read GetMasterField write SetMasterField;
    property DetailField: string read GetDetailField write SetDetailField;
    property IconField: string read GetIconField write SetIconField;
    property StartMasterValue: string read GetStartMasterValue write SetStartMasterValue;
    property ShowButtons: Boolean read GetShowButtons write SetShowButtons;
    property ShowLines: Boolean read GetShowLines write SetShowLines;
    property ShowRoot: Boolean read GetShowRoot write SetShowRoot;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    property RightClickSelect: Boolean read GetRightClickSelect write SetRightClickSelect;
    property HideSelection: Boolean read GetHideSelection write SetHideSelection;
    property Indent: Integer read GetIndent write SetIndent;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (