home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RxLookup.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  93KB  |  3,191 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi VCL Extensions (RX)                      }
  4. {                                                       }
  5. {       Copyright (c) 1995,1997 Borland International   }
  6. {       Portions copyright (c) 1995, 1996 AO ROSNO      }
  7. {       Portions copyright (c) 1997, 1998 Master-Bank   }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit RxLookup;
  12.  
  13. interface
  14.  
  15. {$I RX.INC}
  16.  
  17. uses SysUtils, Windows, DBCtrls, VDBConsts, Variants, Messages, Classes, Controls, Forms, Graphics, Menus, DB, Mask,
  18.   {$IFNDEF RX_D3} DBTables, {$ENDIF} Buttons, StdCtrls, DBUtils, ToolEdit;
  19.  
  20. const
  21.   DefFieldsDelim = ',';
  22.  
  23. type
  24.  
  25. { TRxLookupControl }
  26.  
  27.   TLookupListStyle = (lsFixed, lsDelimited);
  28.   TRxLookupControl = class;
  29.   TGetImageEvent = procedure (Sender: TObject; IsEmpty: Boolean;
  30.     var Graphic: TGraphic; var TextMargin: Integer) of object;
  31.  
  32.   TDataSourceLink = class(TDataLink)
  33.   private
  34.     FDataControl: TRxLookupControl;
  35.   protected
  36.     procedure ActiveChanged; override;
  37.     procedure LayoutChanged; override;
  38.     procedure FocusControl(Field: TFieldRef); override;
  39.     procedure RecordChanged(Field: TField); override;
  40.   end;
  41.  
  42.   TLookupSourceLink = class(TDataLink)
  43.   private
  44.     FDataControl: TRxLookupControl;
  45.   protected
  46.     procedure ActiveChanged; override;
  47.     procedure LayoutChanged; override;
  48.     procedure DataSetChanged; override;
  49.   end;
  50.  
  51.   TRxLookupControl = class(TCustomControl)
  52.   private
  53.     FLookupSource: TDataSource;
  54.     FDataLink: TDataSourceLink;
  55.     FLookupLink: TLookupSourceLink;
  56.     FDataFieldName: string;
  57.     FLookupFieldName: string;
  58.     FLookupDisplay: string;
  59.     FDisplayIndex: Integer;
  60.     FDataField: TField;
  61.     FMasterField: TField;
  62.     FKeyField: TField;
  63.     FDisplayField: TField;
  64.     FListFields: TList;
  65.     FValue: string;
  66.     FDisplayValue: string;
  67.     FDisplayEmpty: string;
  68.     FSearchText: string;
  69.     FEmptyValue: string;
  70.     FEmptyItemColor: TColor;
  71.     FListActive: Boolean;
  72.     FPopup: Boolean;
  73.     FFocused: Boolean;
  74.     FLocate: TLocateObject;
  75.     FIndexSwitch: Boolean;
  76.     FIgnoreCase: Boolean;
  77.     FItemHeight: Integer;
  78.     FFieldsDelim: Char;
  79.     FListStyle: TLookupListStyle;
  80.     FOnChange: TNotifyEvent;
  81.     FOnGetImage: TGetImageEvent;
  82. {$IFDEF WIN32}
  83.     FLookupMode: Boolean;
  84.     procedure CheckNotFixed;
  85.     procedure SetLookupMode(Value: Boolean);
  86.     function GetKeyValue: Variant;
  87.     procedure SetKeyValue(const Value: Variant);
  88. {$ENDIF}
  89.     function CanModify: Boolean;
  90.     procedure CheckNotCircular;
  91.     procedure DataLinkActiveChanged;
  92.     procedure CheckDataLinkActiveChanged;
  93.     procedure DataLinkRecordChanged(Field: TField);
  94.     function GetBorderSize: Integer;
  95.     function GetField: TField;
  96.     function GetDataSource: TDataSource;
  97.     function GetLookupField: string;
  98.     function GetLookupSource: TDataSource;
  99.     function GetReadOnly: Boolean;
  100.     function GetTextHeight: Integer;
  101.     function DefaultTextHeight: Integer;
  102.     function GetItemHeight: Integer;
  103.     function LocateKey: Boolean;
  104.     function LocateDisplay: Boolean;
  105.     function ValueIsEmpty(const S: string): Boolean;
  106.     function StoreEmpty: Boolean;
  107.     procedure ProcessSearchKey(Key: Char);
  108.     procedure UpdateKeyValue;
  109.     procedure SelectKeyValue(const Value: string);
  110.     procedure SetDataFieldName(const Value: string);
  111.     procedure SetDataSource(Value: TDataSource);
  112.     procedure SetDisplayEmpty(const Value: string);
  113.     procedure SetEmptyValue(const Value: string);
  114.     procedure SetEmptyItemColor(Value: TColor);
  115.     procedure SetLookupField(const Value: string);
  116.     procedure SetValueKey(const Value: string);
  117.     procedure SetValue(const Value: string);
  118.     procedure SetDisplayValue(const Value: string);
  119.     procedure SetListStyle(Value: TLookupListStyle); virtual;
  120.     procedure SetFieldsDelim(Value: Char); virtual;
  121.     procedure SetLookupDisplay(const Value: string);
  122.     procedure SetLookupSource(Value: TDataSource);
  123.     procedure SetReadOnly(Value: Boolean);
  124.     procedure SetItemHeight(Value: Integer);
  125.     function ItemHeightStored: Boolean;
  126.     procedure DrawPicture(Canvas: TCanvas; Rect: TRect; Image: TGraphic);
  127.     procedure UpdateDisplayValue;
  128.     function EmptyRowVisible: Boolean;
  129.     procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
  130.     procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
  131.     procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
  132.   protected
  133.     procedure Change; dynamic;
  134.     procedure KeyValueChanged; virtual;
  135.     procedure DisplayValueChanged; virtual;
  136.     procedure ListLinkActiveChanged; virtual;
  137.     procedure ListLinkDataChanged; virtual;
  138.     procedure Notification(AComponent: TComponent;
  139.       Operation: TOperation); override;
  140.     function GetPicture(Current, Empty: Boolean; var TextMargin: Integer): TGraphic; virtual;
  141.     procedure UpdateDisplayEmpty(const Value: string); virtual;
  142.     function SearchText(var AValue: string): Boolean;
  143.     function GetWindowWidth: Integer;
  144.     property DataField: string read FDataFieldName write SetDataFieldName;
  145.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  146.     property DisplayEmpty: string read FDisplayEmpty write SetDisplayEmpty;
  147.     property EmptyValue: string read FEmptyValue write SetEmptyValue stored StoreEmpty;
  148.     property EmptyItemColor: TColor read FEmptyItemColor write SetEmptyItemColor default clWindow;
  149.     property IgnoreCase: Boolean read FIgnoreCase write FIgnoreCase default True;
  150.     property IndexSwitch: Boolean read FIndexSwitch write FIndexSwitch default True;
  151.     property ItemHeight: Integer read GetItemHeight write SetItemHeight
  152.       stored ItemHeightStored;
  153.     property ListStyle: TLookupListStyle read FListStyle write SetListStyle default lsFixed;
  154.     property FieldsDelimiter: Char read FFieldsDelim write SetFieldsDelim default DefFieldsDelim;
  155.     property LookupDisplay: string read FLookupDisplay write SetLookupDisplay;
  156.     property LookupDisplayIndex: Integer read FDisplayIndex write FDisplayIndex default 0;
  157.     property LookupField: string read GetLookupField write SetLookupField;
  158.     property LookupSource: TDataSource read GetLookupSource write SetLookupSource;
  159.     property ParentColor default False;
  160.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  161.     property TabStop default True;
  162.     property Value: string read FValue write SetValue stored False;
  163.     property DisplayValue: string read FDisplayValue write SetDisplayValue stored False;
  164. {$IFDEF WIN32}
  165.     property KeyValue: Variant read GetKeyValue write SetKeyValue stored False;
  166. {$ENDIF}
  167.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  168.     property OnGetImage: TGetImageEvent read FOnGetImage write FOnGetImage;
  169.   public
  170.     constructor Create(AOwner: TComponent); override;
  171.     destructor Destroy; override;
  172.     procedure ClearValue;
  173.     function Locate(const SearchField: TField; const AValue: string;
  174.       Exact: Boolean): Boolean;
  175.     procedure ResetField; virtual;
  176. {$IFDEF RX_D4}
  177.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  178.     function UpdateAction(Action: TBasicAction): Boolean; override;
  179.     function UseRightToLeftAlignment: Boolean; override;
  180. {$ENDIF}
  181.     property Field: TField read GetField;
  182.   end;
  183.  
  184. { TRxDBLookupList }
  185.  
  186.   TRxDBLookupList = class(TRxLookupControl)
  187.   private
  188.     FRecordIndex: Integer;
  189.     FRecordCount: Integer;
  190.     FRowCount: Integer;
  191.     FBorderStyle: TBorderStyle;
  192.     FKeySelected: Boolean;
  193.     FTracking: Boolean;
  194.     FTimerActive: Boolean;
  195.     FLockPosition: Boolean;
  196.     FSelectEmpty: Boolean;
  197.     FMousePos: Integer;
  198.     function GetKeyIndex: Integer;
  199.     procedure ListDataChanged;
  200.     procedure SelectCurrent;
  201.     procedure SelectItemAt(X, Y: Integer);
  202.     procedure SetBorderStyle(Value: TBorderStyle);
  203.     procedure SetRowCount(Value: Integer);
  204.     procedure StopTimer;
  205.     procedure StopTracking;
  206.     procedure TimerScroll;
  207.     procedure UpdateScrollBar;
  208.     procedure UpdateBufferCount(Rows: Integer);
  209.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  210.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  211.     procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
  212.     procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  213.     procedure WMTimer(var Message: TMessage); message WM_TIMER;
  214.     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  215.   protected
  216.     procedure CreateParams(var Params: TCreateParams); override;
  217.     procedure CreateWnd; override;
  218.     procedure KeyValueChanged; override;
  219.     procedure DisplayValueChanged; override;
  220.     procedure ListLinkActiveChanged; override;
  221.     procedure ListLinkDataChanged; override;
  222.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  223.     procedure KeyPress(var Key: Char); override;
  224.     procedure Loaded; override;
  225.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  226.       X, Y: Integer); override;
  227.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  228.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  229.       X, Y: Integer); override;
  230.     procedure Paint; override;
  231.     procedure UpdateDisplayEmpty(const Value: string); override;
  232. {$IFDEF RX_D4}
  233.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  234.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  235. {$ENDIF}
  236.   public
  237.     constructor Create(AOwner: TComponent); override;
  238.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  239.     procedure DrawItemText(Canvas: TCanvas; Rect: TRect;
  240.       Selected, IsEmpty: Boolean); virtual;
  241.     property RowCount: Integer read FRowCount write SetRowCount stored False;
  242.     property DisplayValue;
  243.     property Value;
  244. {$IFDEF WIN32}
  245.     property KeyValue;
  246. {$ENDIF}
  247.   published
  248.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  249.     property Align;
  250.     property Color;
  251.     property Ctl3D;
  252.     property DataField;
  253.     property DataSource;
  254.     property DisplayEmpty;
  255.     property DragCursor;
  256.     property DragMode;
  257.     property EmptyItemColor;
  258.     property EmptyValue;
  259.     property Enabled;
  260.     property FieldsDelimiter;
  261.     property Font;
  262.     property IgnoreCase;
  263. {$IFDEF RX_D4}
  264.     property Anchors;
  265.     property BiDiMode;
  266.     property Constraints;
  267.     property DragKind;
  268.     property ParentBiDiMode;
  269. {$ENDIF}
  270. {$IFDEF WIN32}
  271.   {$IFNDEF VER90}
  272.     property ImeMode;
  273.     property ImeName;
  274.   {$ENDIF}
  275. {$ENDIF}
  276.     property IndexSwitch;
  277.     property ItemHeight;
  278.     property ListStyle;
  279.     property LookupField;
  280.     property LookupDisplay;
  281.     property LookupDisplayIndex;
  282.     property LookupSource;
  283.     property ParentColor;
  284.     property ParentCtl3D;
  285.     property ParentFont;
  286.     property ParentShowHint;
  287.     property PopupMenu;
  288.     property ReadOnly;
  289.     property ShowHint;
  290.     property TabOrder;
  291.     property TabStop;
  292.     property Visible;
  293.     property OnClick;
  294.     property OnDblClick;
  295.     property OnDragDrop;
  296.     property OnDragOver;
  297.     property OnEndDrag;
  298.     property OnEnter;
  299.     property OnExit;
  300.     property OnGetImage;
  301.     property OnKeyDown;
  302.     property OnKeyPress;
  303.     property OnKeyUp;
  304.     property OnMouseDown;
  305.     property OnMouseMove;
  306.     property OnMouseUp;
  307. {$IFDEF WIN32}
  308.     property OnStartDrag;
  309. {$ENDIF}
  310. {$IFDEF RX_D5}
  311.     property OnContextPopup;
  312. {$ENDIF}
  313. {$IFDEF RX_D4}
  314.     property OnMouseWheelDown;
  315.     property OnMouseWheelUp;
  316.     property OnEndDock;
  317.     property OnStartDock;
  318. {$ENDIF}
  319.   end;
  320.  
  321. { TRxDBLookupCombo }
  322.  
  323.   TRxPopupDataList = class(TRxDBLookupList)
  324.   private
  325.     FCombo: TRxLookupControl;
  326.     procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
  327.   protected
  328.     procedure Click; override;
  329.     procedure CreateParams(var Params: TCreateParams); override;
  330. {$IFNDEF WIN32}
  331.     procedure CreateWnd; override;
  332. {$ENDIF}
  333.     procedure KeyPress(var Key: Char); override;
  334.   public
  335.     constructor Create(AOwner: TComponent); override;
  336.   end;
  337.  
  338. {$IFNDEF WIN32}
  339.   TDropDownAlign = (daLeft, daRight, daCenter);
  340. {$ENDIF}
  341.  
  342.   TRxDBLookupCombo = class(TRxLookupControl)
  343.   private
  344.     FDataList: TRxPopupDataList;
  345.     FButtonWidth: Integer;
  346.     FDropDownCount: Integer;
  347.     FDropDownWidth: Integer;
  348.     FDropDownAlign: TDropDownAlign;
  349.     FEscapeClear: Boolean;
  350.     FListVisible: Boolean;
  351.     FPressed: Boolean;
  352.     FTracking: Boolean;
  353.     FAlignment: TAlignment;
  354.     FSelImage: TPicture;
  355.     FSelMargin: Integer;
  356.     FDisplayValues: TStrings;
  357.     FDisplayAll: Boolean;
  358. {$IFNDEF WIN32}
  359.     FBtnGlyph: TBitmap;
  360.     FBtnDisabled: TBitmap;
  361. {$ENDIF}
  362.     FOnDropDown: TNotifyEvent;
  363.     FOnCloseUp: TNotifyEvent;
  364.     procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
  365.       Shift: TShiftState; X, Y: Integer);
  366.     procedure StopTracking;
  367.     procedure TrackButton(X, Y: Integer);
  368.     function GetMinHeight: Integer;
  369.     function GetText: string;
  370.     procedure InvalidateText;
  371.     procedure UpdateCurrentImage;
  372.     procedure PaintDisplayValues(Canvas: TCanvas; R: TRect; ALeft: Integer);
  373.     procedure SetFieldsDelim(Value: Char); override;
  374.     procedure SetListStyle(Value: TLookupListStyle); override;
  375.     function GetDisplayAll: Boolean;
  376.     procedure SetDisplayAll(Value: Boolean);
  377.     function GetDisplayValues(Index: Integer): string; 
  378.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  379. {$IFDEF WIN32}
  380.     procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
  381.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  382.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  383. {$ENDIF}
  384.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  385.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  386.     procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
  387.     procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
  388.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  389.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  390.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  391. {$IFDEF RX_D4}
  392.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  393. {$ENDIF}
  394.   protected
  395.     procedure Click; override;
  396.     procedure CreateParams(var Params: TCreateParams); override;
  397.     function GetPicture(Current, Empty: Boolean; var TextMargin: Integer): TGraphic; override;
  398.     procedure UpdateFieldText;
  399.     procedure KeyValueChanged; override;
  400.     procedure DisplayValueChanged; override;
  401.     procedure ListLinkActiveChanged; override;
  402.     procedure ListLinkDataChanged; override;
  403.     procedure Paint; override;
  404.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  405.     procedure KeyPress(var Key: Char); override;
  406.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  407.       X, Y: Integer); override;
  408.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  409.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  410.       X, Y: Integer); override;
  411.     procedure UpdateDisplayEmpty(const Value: string); override;
  412.   public
  413.     constructor Create(AOwner: TComponent); override;
  414.     destructor Destroy; override;
  415.     procedure CloseUp(Accept: Boolean); dynamic;
  416.     procedure DropDown; virtual;
  417.     procedure ResetField; override;
  418.     property IsDropDown: Boolean read FListVisible;
  419.     property ListVisible: Boolean read FListVisible;
  420.     property Text: string read GetText;
  421.     property DisplayValue;
  422.     property DisplayValues[Index: Integer]: string read GetDisplayValues;
  423.     property Value;
  424. {$IFDEF WIN32}
  425.     property KeyValue;
  426. {$ENDIF}
  427.   published
  428.     property DropDownAlign: TDropDownAlign read FDropDownAlign write FDropDownAlign default daLeft;
  429.     property DropDownCount: Integer read FDropDownCount write FDropDownCount default 7;
  430.     property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
  431.     property EscapeClear: Boolean read FEscapeClear write FEscapeClear default True;
  432.     property DisplayAllFields: Boolean read GetDisplayAll write SetDisplayAll default False;
  433.     property Color;
  434.     property Ctl3D;
  435.     property DataField;
  436.     property DataSource;
  437.     property DisplayEmpty;
  438.     property DragCursor;
  439.     property DragMode;
  440.     property EmptyValue;
  441.     property EmptyItemColor;
  442.     property Enabled;
  443.     property FieldsDelimiter;
  444.     property Font;
  445.     property IgnoreCase;
  446. {$IFDEF RX_D4}
  447.     property Anchors;
  448.     property BiDiMode;
  449.     property Constraints;
  450.     property DragKind;
  451.     property ParentBiDiMode;
  452. {$ENDIF}
  453. {$IFDEF WIN32}
  454.   {$IFNDEF VER90}
  455.     property ImeMode;
  456.     property ImeName;
  457.   {$ENDIF}
  458. {$ENDIF}
  459.     property IndexSwitch;
  460.     property ItemHeight;
  461.     property ListStyle;
  462.     property LookupField;
  463.     property LookupDisplay;
  464.     property LookupDisplayIndex;
  465.     property LookupSource;
  466.     property ParentColor;
  467.     property ParentCtl3D;
  468.     property ParentFont;
  469.     property ParentShowHint;
  470.     property PopupMenu;
  471.     property ReadOnly;
  472.     property ShowHint;
  473.     property TabOrder;
  474.     property TabStop;
  475.     property Visible;
  476.     property OnChange;
  477.     property OnClick;
  478.     property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  479.     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
  480.     property OnDragDrop;
  481.     property OnDragOver;
  482.     property OnEndDrag;
  483.     property OnEnter;
  484.     property OnExit;
  485.     property OnGetImage;
  486.     property OnKeyDown;
  487.     property OnKeyPress;
  488.     property OnKeyUp;
  489.     property OnMouseDown;
  490.     property OnMouseMove;
  491.     property OnMouseUp;
  492. {$IFDEF WIN32}
  493.     property OnStartDrag;
  494. {$ENDIF}
  495. {$IFDEF RX_D5}
  496.     property OnContextPopup;
  497. {$ENDIF}
  498. {$IFDEF RX_D4}
  499.     property OnEndDock;
  500.     property OnStartDock;
  501. {$ENDIF}
  502. end;
  503.  
  504. { TPopupDataWindow }
  505.  
  506.   TPopupDataWindow = class(TRxPopupDataList)
  507.   private
  508.     FEditor: TWinControl;
  509.     FCloseUp: TCloseUpEvent;
  510.   protected
  511.     procedure InvalidateEditor;
  512.     procedure Click; override;
  513.     procedure DisplayValueChanged; override;
  514.     function GetPicture(Current, Empty: Boolean; var TextMargin: Integer): TGraphic; override;
  515.     procedure KeyPress(var Key: Char); override;
  516.     procedure PopupMouseUp(Sender: TObject; Button: TMouseButton;
  517.       Shift: TShiftState; X, Y: Integer);
  518.     procedure CloseUp(Accept: Boolean); virtual;
  519.   public
  520.     constructor Create(AOwner: TComponent); override;
  521.     procedure Hide;
  522.     procedure Show(Origin: TPoint);
  523.     property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
  524.   end;
  525.  
  526. { TRxLookupEdit }
  527.  
  528.   TRxLookupEdit = class(TCustomComboEdit)
  529.   private
  530.     FChanging: Boolean;
  531.     FIgnoreChange: Boolean;
  532.     FDropDownCount: Integer;
  533.     FDropDownWidth: Integer;
  534.     FPopupOnlyLocate: Boolean;
  535.     FOnCloseUp: TNotifyEvent;
  536.     FOnDropDown: TNotifyEvent;
  537.     function GetListStyle: TLookupListStyle;
  538.     procedure SetListStyle(Value: TLookupListStyle);
  539.     function GetFieldsDelim: Char;
  540.     procedure SetFieldsDelim(Value: Char);
  541.     function GetLookupDisplay: string;
  542.     procedure SetLookupDisplay(const Value: string);
  543.     function GetDisplayIndex: Integer;
  544.     procedure SetDisplayIndex(Value: Integer);
  545.     function GetLookupField: string;
  546.     procedure SetLookupField(const Value: string);
  547.     function GetLookupSource: TDataSource;
  548.     procedure SetLookupSource(Value: TDataSource);
  549.     procedure SetDropDownCount(Value: Integer);
  550.     function GetLookupValue: string;
  551.     procedure SetLookupValue(const Value: string);
  552.     function GetOnGetImage: TGetImageEvent;
  553.     procedure SetOnGetImage(Value: TGetImageEvent);
  554.   protected
  555.     procedure Change; override;
  556.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  557.     procedure KeyPress(var Key: Char); override;
  558.     procedure ShowPopup(Origin: TPoint); override;
  559.     procedure HidePopup; override;
  560.     procedure PopupChange; override;
  561.     procedure PopupDropDown(DisableEdit: Boolean); override;
  562. {$IFDEF WIN32}
  563.     function AcceptPopup(var Value: Variant): Boolean; override;
  564.     procedure SetPopupValue(const Value: Variant); override;
  565.     function GetPopupValue: Variant; override;
  566. {$ELSE}
  567.     function AcceptPopup(var Value: string): Boolean; override;
  568.     procedure SetPopupValue(const Value: string); override;
  569.     function GetPopupValue: string; override;
  570. {$ENDIF}
  571.   public
  572.     constructor Create(AOwner: TComponent); override;
  573.     destructor Destroy; override;
  574.     property LookupValue: string read GetLookupValue write SetLookupValue;
  575.   published
  576.     property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
  577.     property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
  578.     property ListStyle: TLookupListStyle read GetListStyle write SetListStyle default lsFixed;
  579.     property FieldsDelimiter: Char read GetFieldsDelim write SetFieldsDelim default DefFieldsDelim;
  580.     property LookupDisplay: string read GetLookupDisplay write SetLookupDisplay;
  581.     property LookupDisplayIndex: Integer read GetDisplayIndex write SetDisplayIndex default 0;
  582.     property LookupField: string read GetLookupField write SetLookupField;
  583.     property LookupSource: TDataSource read GetLookupSource write SetLookupSource;
  584.     property PopupOnlyLocate: Boolean read FPopupOnlyLocate write FPopupOnlyLocate default True;
  585.     property Alignment;
  586.     property AutoSelect;
  587.     property BorderStyle;
  588.     property ButtonHint;
  589.     property CharCase;
  590.     property ClickKey;
  591.     property Color;
  592.     property Ctl3D;
  593.     property DirectInput;
  594.     property DragCursor;
  595.     property DragMode;
  596.     property EditMask;
  597.     property Enabled;
  598.     property Font;
  599.     property HideSelection;
  600. {$IFDEF RX_D4}
  601.     property Anchors;
  602.     property BiDiMode;
  603.     property Constraints;
  604.     property DragKind;
  605.     property ParentBiDiMode;
  606. {$ENDIF}
  607. {$IFDEF WIN32}
  608.   {$IFNDEF VER90}
  609.     property ImeMode;
  610.     property ImeName;
  611.   {$ENDIF}
  612. {$ENDIF}
  613.     property MaxLength;
  614.     property OEMConvert;
  615.     property ParentColor;
  616.     property ParentCtl3D;
  617.     property ParentFont;
  618.     property ParentShowHint;
  619.     property PopupAlign;
  620.     property PopupMenu;
  621.     property ReadOnly;
  622.     property ShowHint;
  623.     property TabOrder;
  624.     property TabStop;
  625.     property Text;
  626.     property Visible;
  627.     property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  628.     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
  629.     property OnGetImage: TGetImageEvent read GetOnGetImage write SetOnGetImage;
  630.     property OnButtonClick;
  631.     property OnChange;
  632.     property OnClick;
  633.     property OnDblClick;
  634.     property OnDragDrop;
  635.     property OnDragOver;
  636.     property OnEndDrag;
  637.     property OnEnter;
  638.     property OnExit;
  639.     property OnKeyDown;
  640.     property OnKeyPress;
  641.     property OnKeyUp;
  642.     property OnMouseDown;
  643.     property OnMouseMove;
  644.     property OnMouseUp;
  645. {$IFDEF WIN32}
  646.     property OnStartDrag;
  647. {$ENDIF}
  648. {$IFDEF RX_D5}
  649.     property OnContextPopup;
  650. {$ENDIF}
  651. {$IFDEF RX_D4}
  652.     property OnEndDock;
  653.     property OnStartDock;
  654. {$ENDIF}
  655.   end;
  656.  
  657. implementation
  658.  
  659. uses DBConsts, Dialogs, {$IFNDEF WIN32} Str16, {$ENDIF} VCLUtils, rxStrUtils,
  660.   {$IFNDEF RX_D3} BdeUtils, {$ENDIF} MaxMin, ClipIcon;
  661.  
  662. { TDataSourceLink }
  663.  
  664. procedure TDataSourceLink.ActiveChanged;
  665. begin
  666.   if FDataControl <> nil then FDataControl.DataLinkActiveChanged;
  667. end;
  668.  
  669. procedure TDataSourceLink.LayoutChanged;
  670. begin
  671.   if FDataControl <> nil then FDataControl.CheckDataLinkActiveChanged;
  672. end;
  673.  
  674. procedure TDataSourceLink.RecordChanged(Field: TField);
  675. begin
  676.   if FDataControl <> nil then FDataControl.DataLinkRecordChanged(Field);
  677. end;
  678.  
  679. procedure TDataSourceLink.FocusControl(Field: TFieldRef);
  680. begin
  681.   if (Field^ <> nil) and (FDataControl <> nil) and
  682.     (Field^ = FDataControl.FDataField) and FDataControl.CanFocus then
  683.   begin
  684.     Field^ := nil;
  685.     FDataControl.SetFocus;
  686.   end;
  687. end;
  688.  
  689. { TLookupSourceLink }
  690.  
  691. procedure TLookupSourceLink.ActiveChanged;
  692. begin
  693.   if FDataControl <> nil then FDataControl.ListLinkActiveChanged;
  694. end;
  695.  
  696. procedure TLookupSourceLink.LayoutChanged;
  697. begin
  698.   if FDataControl <> nil then FDataControl.ListLinkActiveChanged;
  699. end;
  700.  
  701. procedure TLookupSourceLink.DataSetChanged;
  702. begin
  703.   if FDataControl <> nil then FDataControl.ListLinkDataChanged;
  704. end;
  705.  
  706. { TRxLookupControl }
  707.  
  708. const
  709.   SearchTickCount: Longint = 0;
  710.  
  711. {$IFNDEF WIN32}
  712. procedure GetFieldList(DataSet: TDataSet; List: TList;
  713.   const FieldNames: string);
  714. var
  715.   Pos: Integer;
  716. begin
  717.   Pos := 1;
  718.   while Pos <= Length(FieldNames) do
  719.     List.Add(DataSet.FieldByName(ExtractFieldName(FieldNames, Pos)));
  720. end;
  721. {$ENDIF}
  722.  
  723. constructor TRxLookupControl.Create(AOwner: TComponent);
  724. begin
  725.   inherited Create(AOwner);
  726.   if NewStyleControls then ControlStyle := [csOpaque]
  727.   else ControlStyle := [csOpaque, csFramed];
  728.   ParentColor := False;
  729.   TabStop := True;
  730.   FFieldsDelim := DefFieldsDelim;
  731.   FLookupSource := TDataSource.Create(Self);
  732.   FDataLink := TDataSourceLink.Create;
  733.   FDataLink.FDataControl := Self;
  734.   FLookupLink := TLookupSourceLink.Create;
  735.   FLookupLink.FDataControl := Self;
  736.   FListFields := TList.Create;
  737.   FEmptyValue := EmptyStr;
  738.   FEmptyItemColor := clWindow;
  739.   FValue := FEmptyValue;
  740. {$IFDEF RX_D3}
  741.   FLocate := CreateLocate(nil);
  742. {$ELSE}
  743.   FLocate := TDBLocate.Create;
  744. {$ENDIF}
  745.   FIndexSwitch := True;
  746.   FIgnoreCase := True;
  747. end;
  748.  
  749. destructor TRxLookupControl.Destroy;
  750. begin
  751.   FListFields.Free;
  752.   FListFields := nil;
  753.   FLookupLink.FDataControl := nil;
  754.   FLookupLink.Free;
  755.   FLookupLink := nil;
  756.   FDataLink.FDataControl := nil;
  757.   FDataLink.Free;
  758.   FDataLink := nil;
  759.   FLocate.Free;
  760.   FLocate := nil;
  761.   inherited Destroy;
  762. end;
  763.  
  764. function TRxLookupControl.CanModify: Boolean;
  765. begin
  766.   Result := FListActive and not ReadOnly and ((FDataLink.DataSource = nil) or
  767.     (FMasterField <> nil) and FMasterField.CanModify);
  768. end;
  769.  
  770. procedure TRxLookupControl.Change;
  771. begin
  772.   if Assigned(FOnChange) then FOnChange(Self);
  773. end;
  774.  
  775. function TRxLookupControl.ValueIsEmpty(const S: string): Boolean;
  776. begin
  777.   Result := (S = FEmptyValue);
  778. end;
  779.  
  780. function TRxLookupControl.StoreEmpty: Boolean;
  781. begin
  782.   Result := (FEmptyValue <> EmptyStr);
  783. end;
  784.  
  785. {$IFDEF WIN32}
  786. procedure TRxLookupControl.CheckNotFixed;
  787. begin
  788.   if FLookupMode then _DBError(SPropDefByLookup);
  789.   if FDataLink.DataSourceFixed then _DBError(SDataSourceFixed);
  790. end;
  791.  
  792. procedure TRxLookupControl.SetLookupMode(Value: Boolean);
  793. begin
  794.   if FLookupMode <> Value then
  795.     if Value then begin
  796.       FMasterField := FDataField.DataSet.FieldByName(FDataField.KeyFields);
  797.       FLookupSource.DataSet := FDataField.LookupDataSet;
  798.       FLookupFieldName := FDataField.LookupKeyFields;
  799.       FLookupMode := True;
  800.       FLookupLink.DataSource := FLookupSource;
  801.     end else
  802.     begin
  803.       FLookupLink.DataSource := nil;
  804.       FLookupMode := False;
  805.       FLookupFieldName := '';
  806.       FLookupSource.DataSet := nil;
  807.       FMasterField := FDataField;
  808.     end;
  809. end;
  810.  
  811. function TRxLookupControl.GetKeyValue: Variant;
  812. begin
  813.   if ValueIsEmpty(Value) then Result := NULL
  814.   else Result := Value;
  815. end;
  816.  
  817. procedure TRxLookupControl.SetKeyValue(const Value: Variant);
  818. begin
  819.   Self.Value := Value;
  820. end;
  821. {$ENDIF}
  822.  
  823. procedure TRxLookupControl.CheckNotCircular;
  824. begin
  825.   {
  826.   if FDataLink.Active and FDataLink.DataSet.IsLinkedTo(LookupSource) then
  827.     _DBError(SCircularDataLink);
  828.   }
  829.   if FDataLink.Active and ((DataSource = LookupSource) or
  830.     (FDataLink.DataSet = FLookupLink.DataSet)) then
  831.     _DBError(SCircularDataLink);
  832. end;
  833.  
  834. procedure TRxLookupControl.CheckDataLinkActiveChanged;
  835. var
  836.   TestField: TField;
  837. begin
  838.   if FDataLink.Active and (FDataFieldName <> '') then begin
  839.     TestField := FDataLink.DataSet.FieldByName(FDataFieldName);
  840.     if Pointer(FDataField) <> Pointer(TestField) then begin
  841.       FDataField := nil;
  842.       FMasterField := nil;
  843.       CheckNotCircular;
  844.       FDataField := TestField;
  845.       FMasterField := FDataField;
  846.       DataLinkRecordChanged(nil);
  847.     end;
  848.   end;
  849. end;
  850.  
  851. procedure TRxLookupControl.DataLinkActiveChanged;
  852. begin
  853.   FDataField := nil;
  854.   FMasterField := nil;
  855.   if FDataLink.Active and (FDataFieldName <> '') then begin
  856.     CheckNotCircular;
  857.     FDataField := FDataLink.DataSet.FieldByName(FDataFieldName);
  858.     FMasterField := FDataField;
  859.   end;
  860. {$IFDEF WIN32}
  861.   SetLookupMode((FDataField <> nil) and FDataField.Lookup);
  862. {$ENDIF}
  863.   DataLinkRecordChanged(nil);
  864. end;
  865.  
  866. procedure TRxLookupControl.DataLinkRecordChanged(Field: TField);
  867. begin
  868.   if (Field = nil) or (Field = FMasterField) then begin
  869.     if FMasterField <> nil then begin
  870.       SetValueKey(FMasterField.AsString);
  871.     end else SetValueKey(FEmptyValue);
  872.   end;
  873. end;
  874.  
  875. {$IFDEF RX_D4}
  876. function TRxLookupControl.ExecuteAction(Action: TBasicAction): Boolean;
  877. begin
  878.   Result := inherited ExecuteAction(Action) or ((FDataLink <> nil) and
  879.     FDataLink.ExecuteAction(Action));
  880. end;
  881.  
  882. function TRxLookupControl.UpdateAction(Action: TBasicAction): Boolean;
  883. begin
  884.   Result := inherited UpdateAction(Action) or ((FDataLink <> nil) and
  885.     FDataLink.UpdateAction(Action));
  886. end;
  887.  
  888. function TRxLookupControl.UseRightToLeftAlignment: Boolean;
  889. begin
  890.   Result := DBUseRightToLeftAlignment(Self, Field);
  891. end;
  892. {$ENDIF}
  893.  
  894. function TRxLookupControl.GetBorderSize: Integer;
  895. var
  896.   Params: TCreateParams;
  897.   R: TRect;
  898. begin
  899.   CreateParams(Params);
  900.   SetRect(R, 0, 0, 0, 0);
  901. {$IFDEF WIN32}
  902.   AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
  903. {$ELSE}
  904.   AdjustWindowRect(R, Params.Style, False);
  905.   if (csFramed in ControlStyle) and Ctl3D and 
  906.     (Params.Style and WS_BORDER <> 0) then Inc(R.Bottom, 2);
  907. {$ENDIF}
  908.   Result := R.Bottom - R.Top;
  909. end;
  910.  
  911. function TRxLookupControl.GetDataSource: TDataSource;
  912. begin
  913.   Result := FDataLink.DataSource;
  914. end;
  915.  
  916. function TRxLookupControl.GetLookupField: string;
  917. begin
  918. {$IFDEF WIN32}
  919.   if FLookupMode then Result := '' else
  920. {$ENDIF}
  921.   Result := FLookupFieldName;
  922. end;
  923.  
  924. function TRxLookupControl.GetLookupSource: TDataSource;
  925. begin
  926. {$IFDEF WIN32}
  927.   if FLookupMode then Result := nil else
  928. {$ENDIF}
  929.   Result := FLookupLink.DataSource;
  930. end;
  931.  
  932. function TRxLookupControl.GetReadOnly: Boolean;
  933. begin
  934.   Result := FDataLink.ReadOnly;
  935. end;
  936.  
  937. function TRxLookupControl.GetField: TField;
  938. begin
  939.   if Assigned(FDataLink) then Result := FDataField
  940.   else Result := nil;
  941. end;
  942.  
  943. function TRxLookupControl.DefaultTextHeight: Integer;
  944. var
  945.   DC: HDC;
  946.   SaveFont: HFont;
  947.   Metrics: TTextMetric;
  948. begin
  949.   DC := GetDC(0);
  950.   SaveFont := SelectObject(DC, Font.Handle);
  951.   GetTextMetrics(DC, Metrics);
  952.   SelectObject(DC, SaveFont);
  953.   ReleaseDC(0, DC);
  954.   Result := Metrics.tmHeight;
  955. end;
  956.  
  957. function TRxLookupControl.GetTextHeight: Integer;
  958. begin
  959.   Result := Max(DefaultTextHeight, FItemHeight);
  960. end;
  961.  
  962. procedure TRxLookupControl.KeyValueChanged;
  963. begin
  964. end;
  965.  
  966. procedure TRxLookupControl.DisplayValueChanged;
  967. begin
  968. end;
  969.  
  970. procedure TRxLookupControl.ListLinkActiveChanged;
  971. var
  972.   DataSet: TDataSet;
  973. {$IFDEF WIN32}
  974.   ResultField: TField;
  975. {$ENDIF}
  976. begin
  977.   FListActive := False;
  978.   FKeyField := nil;
  979.   FDisplayField := nil;
  980.   FListFields.Clear;
  981.   if FLookupLink.Active and (FLookupFieldName <> '') then begin
  982.     CheckNotCircular;
  983.     DataSet := FLookupLink.DataSet;
  984.     FKeyField := DataSet.FieldByName(FLookupFieldName);
  985. {$IFDEF WIN32}
  986.     DataSet.GetFieldList(FListFields, FLookupDisplay);
  987. {$ELSE}
  988.     GetFieldList(DataSet, FListFields, FLookupDisplay);
  989. {$ENDIF}
  990. {$IFDEF WIN32}
  991.     if FLookupMode then begin
  992.       ResultField := DataSet.FieldByName(FDataField.LookupResultField);
  993.       if FListFields.IndexOf(ResultField) < 0 then
  994.         FListFields.Insert(0, ResultField);
  995.       FDisplayField := ResultField;
  996.     end
  997.     else begin
  998.       if FListFields.Count = 0 then FListFields.Add(FKeyField);
  999.       if (FDisplayIndex >= 0) and (FDisplayIndex < FListFields.Count) then
  1000.         FDisplayField := FListFields[FDisplayIndex]
  1001.       else FDisplayField := FListFields[0];
  1002.     end;
  1003. {$ELSE}
  1004.     if FListFields.Count = 0 then FListFields.Add(FKeyField);
  1005.     if (FDisplayIndex >= 0) and (FDisplayIndex < FListFields.Count) then
  1006.       FDisplayField := FListFields[FDisplayIndex]
  1007.     else FDisplayField := FListFields[0];
  1008. {$ENDIF}
  1009.     FListActive := True;
  1010.   end;
  1011.   FLocate.DataSet := FLookupLink.DataSet;
  1012. end;
  1013.  
  1014. procedure TRxLookupControl.ListLinkDataChanged;
  1015. begin
  1016. end;
  1017.  
  1018. function TRxLookupControl.LocateDisplay: Boolean;
  1019. begin
  1020.   Result := False;
  1021.   try
  1022.     Result := Locate(FDisplayField, FDisplayValue, True);
  1023.   except
  1024.   end;
  1025. end;
  1026.  
  1027. function TRxLookupControl.LocateKey: Boolean;
  1028. begin
  1029.   Result := False;
  1030.   try
  1031.     Result := not ValueIsEmpty(FValue) and Locate(FKeyField, FValue, True);
  1032.   except
  1033.   end;
  1034. end;
  1035.  
  1036. procedure TRxLookupControl.Notification(AComponent: TComponent;
  1037.   Operation: TOperation);
  1038. begin
  1039.   inherited Notification(AComponent, Operation);
  1040.   if Operation = opRemove then begin
  1041.     if (FDataLink <> nil) and (AComponent = DataSource) then
  1042.       DataSource := nil;
  1043.     if (FLookupLink <> nil) and (AComponent = LookupSource) then
  1044.       LookupSource := nil;
  1045.   end;
  1046. end;
  1047.  
  1048. function TRxLookupControl.SearchText(var AValue: string): Boolean;
  1049. begin
  1050.   Result := False;
  1051.   if (FDisplayField <> nil) then
  1052.     if (AValue <> '') and Locate(FDisplayField, AValue, False) then begin
  1053.       SelectKeyValue(FKeyField.AsString);
  1054.       AValue := Copy(FDisplayField.AsString, 1, Length(AValue));
  1055.       Result := True;
  1056.     end
  1057.     else if AValue = '' then begin
  1058.       FLookupLink.DataSet.First;
  1059.       SelectKeyValue(FKeyField.AsString);
  1060.       AValue := '';
  1061.     end;
  1062. end;
  1063.  
  1064. procedure TRxLookupControl.ProcessSearchKey(Key: Char);
  1065. var
  1066.   TickCount: Longint;
  1067.   S: string;
  1068. begin
  1069.   S := '';
  1070.   if (FDisplayField <> nil) {and (FDisplayField.DataType = ftString)} then
  1071.     case Key of
  1072.       #9, #27: FSearchText := '';
  1073.       Char(VK_BACK), #32..#255:
  1074.         if CanModify then begin
  1075.           if not FPopup then begin
  1076.             TickCount := GetTickCount;
  1077.             if TickCount - SearchTickCount > 2000 then FSearchText := '';
  1078.             SearchTickCount := TickCount;
  1079.           end;
  1080.           if (Key = Char(VK_BACK)) then
  1081.             S := Copy(FSearchText, 1, Length(FSearchText) - 1)
  1082.           else if Length(FSearchText) < 32 then
  1083.             S := FSearchText + Key;
  1084.           if SearchText(S) or (S = '') then FSearchText := S;
  1085.         end;
  1086.     end;
  1087. end;
  1088.  
  1089. procedure TRxLookupControl.ResetField;
  1090. begin
  1091.   if (FDataLink.DataSource = nil) or
  1092.     ((FDataLink.DataSource <> nil) and CanModify) then
  1093.   begin
  1094.     if (FDataLink.DataSource <> nil) and (FMasterField <> nil) and
  1095.       FDataLink.Edit then
  1096.     begin
  1097.       if FEmptyValue = EmptyStr then FMasterField.Clear
  1098.       else FMasterField.AsString := FEmptyValue;
  1099.     end;
  1100.     FValue := FEmptyValue;
  1101.     FDisplayValue := EmptyStr;
  1102.     inherited Text := DisplayEmpty;
  1103.     Invalidate;
  1104.     Click;
  1105.   end;
  1106. end;
  1107.  
  1108. procedure TRxLookupControl.ClearValue;
  1109. begin
  1110.   SetValueKey(FEmptyValue);
  1111. end;
  1112.  
  1113. procedure TRxLookupControl.SelectKeyValue(const Value: string);
  1114. begin
  1115.   if FMasterField <> nil then begin
  1116.     if CanModify and FDataLink.Edit then begin
  1117.       if FDataField = FMasterField then FDataField.DataSet.Edit;
  1118.       FMasterField.AsString := Value;
  1119.     end
  1120.     else Exit;
  1121.   end
  1122.   else SetValueKey(Value);
  1123.   UpdateDisplayValue;
  1124.   Repaint;
  1125.   Click;
  1126. end;
  1127.  
  1128. procedure TRxLookupControl.SetDataFieldName(const Value: string);
  1129. begin
  1130.   if FDataFieldName <> Value then begin
  1131.     FDataFieldName := Value;
  1132.     DataLinkActiveChanged;
  1133.   end;
  1134. end;
  1135.  
  1136. procedure TRxLookupControl.SetDataSource(Value: TDataSource);
  1137. begin
  1138.   FDataLink.DataSource := Value;
  1139. {$IFDEF WIN32}
  1140.   if Value <> nil then Value.FreeNotification(Self);
  1141. {$ENDIF}
  1142. end;
  1143.  
  1144. procedure TRxLookupControl.SetListStyle(Value: TLookupListStyle);
  1145. begin
  1146.   if FListStyle <> Value then begin
  1147.     FListStyle := Value;
  1148.     Invalidate;
  1149.   end;
  1150. end;
  1151.  
  1152. procedure TRxLookupControl.SetFieldsDelim(Value: Char);
  1153. begin
  1154.   if FFieldsDelim <> Value then begin
  1155.     FFieldsDelim := Value;
  1156.     if ListStyle = lsDelimited then Invalidate;
  1157.   end;
  1158. end;
  1159.  
  1160. procedure TRxLookupControl.SetLookupField(const Value: string);
  1161. begin
  1162. {$IFDEF WIN32}
  1163.   CheckNotFixed;
  1164. {$ENDIF}
  1165.   if FLookupFieldName <> Value then begin
  1166.     FLookupFieldName := Value;
  1167.     ListLinkActiveChanged;
  1168.     if FListActive then DataLinkRecordChanged(nil);
  1169.   end;
  1170. end;
  1171.  
  1172. procedure TRxLookupControl.SetDisplayEmpty(const Value: string);
  1173. begin
  1174.   if FDisplayEmpty <> Value then begin
  1175.     UpdateDisplayEmpty(Value);
  1176.     FDisplayEmpty := Value;
  1177.     if not (csReading in ComponentState) then Invalidate;
  1178.   end;
  1179. end;
  1180.  
  1181. procedure TRxLookupControl.SetEmptyValue(const Value: string);
  1182. begin
  1183.   if FEmptyValue <> Value then begin
  1184.     if ValueIsEmpty(FValue) then FValue := Value;
  1185.     FEmptyValue := Value;
  1186.   end;
  1187. end;
  1188.  
  1189. procedure TRxLookupControl.SetEmptyItemColor(Value: TColor);
  1190. begin
  1191.   if FEmptyItemColor <> Value then begin
  1192.     FEmptyItemColor := Value;
  1193.     if not (csReading in ComponentState) and (DisplayEmpty <> '') then
  1194.       Invalidate;
  1195.   end;
  1196. end;
  1197.  
  1198. procedure TRxLookupControl.UpdateDisplayEmpty(const Value: string);
  1199. begin
  1200. end;
  1201.  
  1202. procedure TRxLookupControl.SetDisplayValue(const Value: string);
  1203. var
  1204.   S: string;
  1205. begin
  1206.   if (FDisplayValue <> Value) and CanModify and (FDataLink.DataSource <> nil) and
  1207.     Locate(FDisplayField, Value, True) then
  1208.   begin
  1209.     S := FValue;
  1210.     if FDataLink.Edit then begin
  1211.       if FMasterField <> nil then FMasterField.AsString := S
  1212.       else FDataField.AsString := S;
  1213.     end;
  1214.   end
  1215.   else if (FDisplayValue <> Value) then begin
  1216.     FDisplayValue := Value;
  1217.     DisplayValueChanged;
  1218.     Change;
  1219.   end;
  1220. end;
  1221.  
  1222. procedure TRxLookupControl.UpdateKeyValue;
  1223. begin
  1224.   if FMasterField <> nil then FValue := FMasterField.AsString
  1225.   else FValue := FEmptyValue;
  1226.   KeyValueChanged;
  1227. end;
  1228.  
  1229. procedure TRxLookupControl.SetValueKey(const Value: string);
  1230. begin
  1231.   if FValue <> Value then begin
  1232.     FValue := Value;
  1233.     KeyValueChanged;
  1234.   end;
  1235. end;
  1236.  
  1237. procedure TRxLookupControl.SetValue(const Value: string);
  1238. begin
  1239.   if (Value <> FValue) then
  1240.     if CanModify and (FDataLink.DataSource <> nil) and FDataLink.Edit then
  1241.     begin
  1242.       if FMasterField <> nil then FMasterField.AsString := Value
  1243.       else FDataField.AsString := Value;
  1244.     end
  1245.     else begin
  1246.       SetValueKey(Value);
  1247.       Change;
  1248.     end;
  1249. end;
  1250.  
  1251. procedure TRxLookupControl.SetLookupDisplay(const Value: string);
  1252. begin
  1253.   if FLookupDisplay <> Value then begin
  1254.     FLookupDisplay := Value;
  1255.     ListLinkActiveChanged;
  1256.     if FListActive then DataLinkRecordChanged(nil);
  1257.   end;
  1258. end;
  1259.  
  1260. procedure TRxLookupControl.SetLookupSource(Value: TDataSource);
  1261. begin
  1262. {$IFDEF WIN32}
  1263.   CheckNotFixed;
  1264. {$ENDIF}
  1265.   FLookupLink.DataSource := Value;
  1266. {$IFDEF WIN32}
  1267.   if Value <> nil then Value.FreeNotification(Self);
  1268. {$ENDIF}
  1269.   if Value <> nil then FLocate.DataSet := Value.DataSet
  1270.   else FLocate.DataSet := nil;
  1271.   if FListActive then DataLinkRecordChanged(nil);
  1272. end;
  1273.  
  1274. procedure TRxLookupControl.SetReadOnly(Value: Boolean);
  1275. begin
  1276.   FDataLink.ReadOnly := Value;
  1277. end;
  1278.  
  1279. function TRxLookupControl.GetItemHeight: Integer;
  1280. begin
  1281.   Result := {Max(GetTextHeight, FItemHeight);}GetTextHeight;
  1282. end;
  1283.  
  1284. procedure TRxLookupControl.SetItemHeight(Value: Integer);
  1285. begin
  1286.   if not (csReading in ComponentState) then
  1287.     FItemHeight := Max(DefaultTextHeight, Value)
  1288.   else FItemHeight := Value;
  1289.   Perform(CM_FONTCHANGED, 0, 0);
  1290. end;
  1291.  
  1292. function TRxLookupControl.ItemHeightStored: Boolean;
  1293. begin
  1294.   Result := FItemHeight > DefaultTextHeight;
  1295. end;
  1296.  
  1297. procedure TRxLookupControl.DrawPicture(Canvas: TCanvas; Rect: TRect;
  1298.   Image: TGraphic);
  1299. var
  1300.   X, Y, SaveIndex: Integer;
  1301. {$IFDEF WIN32}
  1302.   Ico: HIcon;
  1303.   W, H: Integer;
  1304. {$ENDIF}
  1305. begin
  1306.   if Image <> nil then begin
  1307.     X := (Rect.Right + Rect.Left - Image.Width) div 2;
  1308.     Y := (Rect.Top + Rect.Bottom - Image.Height) div 2;
  1309.     SaveIndex := SaveDC(Canvas.Handle);
  1310.     try
  1311.       IntersectClipRect(Canvas.Handle, Rect.Left, Rect.Top, Rect.Right,
  1312.         Rect.Bottom);
  1313.       if Image is TBitmap then
  1314.         DrawBitmapTransparent(Canvas, X, Y, TBitmap(Image),
  1315.           TBitmap(Image).TransparentColor)
  1316. {$IFDEF WIN32}
  1317.       else if Image is TIcon then begin
  1318.         Ico := CreateRealSizeIcon(TIcon(Image));
  1319.         try
  1320.           GetIconSize(Ico, W, H);
  1321.           DrawIconEx(Canvas.Handle, (Rect.Right + Rect.Left - W) div 2,
  1322.             (Rect.Top + Rect.Bottom - H) div 2, Ico, W, H, 0, 0, DI_NORMAL);
  1323.         finally
  1324.           DestroyIcon(Ico);
  1325.         end;
  1326.       end
  1327. {$ENDIF}
  1328.       else Canvas.Draw(X, Y, Image);
  1329.     finally
  1330.       RestoreDC(Canvas.Handle, SaveIndex);
  1331.     end;
  1332.   end;
  1333. end;
  1334.  
  1335. function TRxLookupControl.GetPicture(Current, Empty: Boolean;
  1336.   var TextMargin: Integer): TGraphic;
  1337. begin
  1338.   TextMargin := 0;
  1339.   Result := nil;
  1340.   if Assigned(FOnGetImage) then FOnGetImage(Self, Empty, Result, TextMargin);
  1341. end;
  1342.  
  1343. procedure TRxLookupControl.WMGetDlgCode(var Message: TMessage);
  1344. begin
  1345.   Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
  1346. end;
  1347.  
  1348. procedure TRxLookupControl.WMKillFocus(var Message: TMessage);
  1349. begin
  1350.   FFocused := False;
  1351.   Invalidate;
  1352. end;
  1353.  
  1354. procedure TRxLookupControl.WMSetFocus(var Message: TMessage);
  1355. begin
  1356.   FFocused := True;
  1357.   Invalidate;
  1358. end;
  1359.  
  1360. function TRxLookupControl.Locate(const SearchField: TField;
  1361.   const AValue: string; Exact: Boolean): Boolean;
  1362. begin
  1363.   FLocate.IndexSwitch := FIndexSwitch;
  1364.   Result := False;
  1365.   try
  1366.     if not ValueIsEmpty(AValue) and (SearchField <> nil) then begin
  1367.       Result := FLocate.Locate(SearchField.FieldName, AValue, Exact,
  1368.         not IgnoreCase);
  1369.       if Result then begin
  1370.         if SearchField = FDisplayField then FValue := FKeyField.AsString;
  1371.         UpdateDisplayValue;
  1372.       end;
  1373.     end;
  1374.   except
  1375.   end;
  1376. end;
  1377.  
  1378. function TRxLookupControl.EmptyRowVisible: Boolean;
  1379. begin
  1380.   Result := DisplayEmpty <> EmptyStr;
  1381. end;
  1382.  
  1383. procedure TRxLookupControl.UpdateDisplayValue;
  1384. begin
  1385.   if not ValueIsEmpty(FValue) then begin
  1386.     if FDisplayField <> nil then
  1387.       FDisplayValue := FDisplayField.AsString
  1388.     else FDisplayValue := '';
  1389.   end
  1390.   else FDisplayValue := '';
  1391. end;
  1392.  
  1393. function TRxLookupControl.GetWindowWidth: Integer;
  1394. var
  1395.   I: Integer;
  1396. begin
  1397.   Result := 0;
  1398.   for I := 0 to FListFields.Count - 1 do
  1399.     Inc(Result, TField(FListFields[I]).DisplayWidth);
  1400.   Canvas.Font := Font;
  1401.   Result := Min(Result * Canvas.TextWidth('M') + FListFields.Count * 4 +
  1402.     GetSystemMetrics(SM_CXVSCROLL), Screen.Width);
  1403. end;
  1404.  
  1405. { TRxDBLookupList }
  1406.  
  1407. constructor TRxDBLookupList.Create(AOwner: TComponent);
  1408. begin
  1409.   inherited Create(AOwner);
  1410.   Width := 121;
  1411.   Ctl3D := True;
  1412.   FBorderStyle := bsSingle;
  1413. {$IFDEF WIN32}
  1414.   ControlStyle := [csOpaque, csDoubleClicks];
  1415. {$ELSE}
  1416.   ControlStyle := [csFramed, csOpaque, csDoubleClicks];
  1417. {$ENDIF}
  1418.   RowCount := 7;
  1419. end;
  1420.  
  1421. procedure TRxDBLookupList.CreateParams(var Params: TCreateParams);
  1422. begin
  1423.   inherited CreateParams(Params);
  1424.   with Params do begin
  1425.     Style := Style or WS_VSCROLL;
  1426.     if FBorderStyle = bsSingle then
  1427. {$IFDEF WIN32}
  1428.       if NewStyleControls and Ctl3D then ExStyle := ExStyle or WS_EX_CLIENTEDGE
  1429.       else Style := Style or WS_BORDER;
  1430. {$ELSE}
  1431.       Style := Style or WS_BORDER;
  1432. {$ENDIF}
  1433.   end;
  1434. end;
  1435.  
  1436. procedure TRxDBLookupList.CreateWnd;
  1437. begin
  1438.   inherited CreateWnd;
  1439.   UpdateScrollBar;
  1440. end;
  1441.  
  1442. procedure TRxDBLookupList.Loaded;
  1443. begin
  1444.   inherited Loaded;
  1445.   Height := Height;
  1446. end;
  1447.  
  1448. function TRxDBLookupList.GetKeyIndex: Integer;
  1449. var
  1450.   FieldValue: string;
  1451. begin
  1452.   if not ValueIsEmpty(FValue) then
  1453.     for Result := 0 to FRecordCount - 1 do begin
  1454.       FLookupLink.ActiveRecord := Result;
  1455.       FieldValue := FKeyField.AsString;
  1456.       FLookupLink.ActiveRecord := FRecordIndex;
  1457.       if FieldValue = FValue then Exit;
  1458.     end;
  1459.   Result := -1;
  1460. end;
  1461.  
  1462. procedure TRxDBLookupList.KeyDown(var Key: Word; Shift: TShiftState);
  1463. var
  1464.   Delta, KeyIndex, EmptyRow: Integer;
  1465. begin
  1466.   inherited KeyDown(Key, Shift);
  1467.   FSelectEmpty := False;
  1468.   EmptyRow := Ord(EmptyRowVisible);
  1469.   if CanModify then begin
  1470.     Delta := 0;
  1471.     case Key of
  1472.       VK_UP, VK_LEFT: Delta := -1;
  1473.       VK_DOWN, VK_RIGHT: Delta := 1;
  1474.       VK_PRIOR: Delta := 1 - (FRowCount - EmptyRow);
  1475.       VK_NEXT: Delta := (FRowCount - EmptyRow) - 1;
  1476.       VK_HOME: Delta := -Maxint;
  1477.       VK_END: Delta := Maxint;
  1478.     end;
  1479.     if Delta <> 0 then begin
  1480.       if ValueIsEmpty(Value) and (EmptyRow > 0) and (Delta < 0) then
  1481.         FSelectEmpty := True;
  1482.       FSearchText := '';
  1483.       if Delta = -Maxint then FLookupLink.DataSet.First
  1484.       else if Delta = Maxint then FLookupLink.DataSet.Last
  1485.       else begin
  1486.         KeyIndex := GetKeyIndex;
  1487.         if KeyIndex >= 0 then begin
  1488.           FLookupLink.DataSet.MoveBy(KeyIndex - FRecordIndex);
  1489.         end
  1490.         else begin
  1491.           KeyValueChanged;
  1492.           Delta := 0;
  1493.         end;
  1494.         FLookupLink.DataSet.MoveBy(Delta);
  1495.         if FLookupLink.DataSet.BOF and (Delta < 0) and (EmptyRow > 0) then
  1496.           FSelectEmpty := True;
  1497.       end;
  1498.       SelectCurrent;
  1499.     end;
  1500.   end;
  1501. end;
  1502.  
  1503. procedure TRxDBLookupList.KeyPress(var Key: Char);
  1504. begin
  1505.   inherited KeyPress(Key);
  1506.   ProcessSearchKey(Key);
  1507. end;
  1508.  
  1509. procedure TRxDBLookupList.KeyValueChanged;
  1510. begin
  1511.   if FListActive and not FLockPosition then
  1512.     if not LocateKey then FLookupLink.DataSet.First;
  1513. end;
  1514.  
  1515. procedure TRxDBLookupList.DisplayValueChanged;
  1516. begin
  1517.   if FListActive and not FLockPosition then
  1518.     if not LocateDisplay then FLookupLink.DataSet.First;
  1519. end;
  1520.  
  1521. procedure TRxDBLookupList.ListLinkActiveChanged;
  1522. begin
  1523.   try
  1524.     inherited ListLinkActiveChanged;
  1525.   finally
  1526.     if FListActive and not FLockPosition then begin
  1527.       if Assigned(FMasterField) then UpdateKeyValue
  1528.       else KeyValueChanged;
  1529.     end
  1530.     else ListDataChanged;
  1531.   end;
  1532. end;
  1533.  
  1534. procedure TRxDBLookupList.ListDataChanged;
  1535. begin
  1536.   if FListActive then begin
  1537.     FRecordIndex := FLookupLink.ActiveRecord;
  1538.     FRecordCount := FLookupLink.RecordCount;
  1539.     FKeySelected := not ValueIsEmpty(FValue) or not FLookupLink.DataSet.BOF;
  1540.   end
  1541.   else begin
  1542.     FRecordIndex := 0;
  1543.     FRecordCount := 0;
  1544.     FKeySelected := False;
  1545.   end;
  1546.   if HandleAllocated then begin
  1547.     UpdateScrollBar;
  1548.     Invalidate;
  1549.   end;
  1550. end;
  1551.  
  1552. procedure TRxDBLookupList.ListLinkDataChanged;
  1553. begin
  1554.   ListDataChanged;
  1555. end;
  1556.  
  1557. procedure TRxDBLookupList.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1558.   X, Y: Integer);
  1559. begin
  1560.   if Button = mbLeft then begin
  1561.     FSearchText := '';
  1562.     if not FPopup then begin
  1563.       if CanFocus then SetFocus;
  1564.       if not FFocused then Exit;
  1565.     end;
  1566.     if CanModify then
  1567.       if ssDouble in Shift then begin
  1568.         if FRecordIndex = Y div GetTextHeight then DblClick;
  1569.       end
  1570.       else begin
  1571.         MouseCapture := True;
  1572.         FTracking := True;
  1573.         SelectItemAt(X, Y);
  1574.       end;
  1575.   end;
  1576.   inherited MouseDown(Button, Shift, X, Y);
  1577. end;
  1578.  
  1579. procedure TRxDBLookupList.MouseMove(Shift: TShiftState; X, Y: Integer);
  1580. begin
  1581.   if FTracking then begin
  1582.     SelectItemAt(X, Y);
  1583.     FMousePos := Y;
  1584.     TimerScroll;
  1585.   end;
  1586.   inherited MouseMove(Shift, X, Y);
  1587. end;
  1588.  
  1589. procedure TRxDBLookupList.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1590.   X, Y: Integer);
  1591. begin
  1592.   if FTracking then begin
  1593.     StopTracking;
  1594.     SelectItemAt(X, Y);
  1595.   end;
  1596.   inherited MouseUp(Button, Shift, X, Y);
  1597. end;
  1598.  
  1599. procedure TRxDBLookupList.DrawItemText(Canvas: TCanvas; Rect: TRect;
  1600.   Selected, IsEmpty: Boolean);
  1601. var
  1602.   J, W, X, ATop, TextWidth, LastFieldIndex: Integer;
  1603.   S: string;
  1604.   Field: TField;
  1605.   R: TRect;
  1606.   AAlignment: TAlignment;
  1607. begin
  1608.   TextWidth := Canvas.TextWidth('M');
  1609.   LastFieldIndex := FListFields.Count - 1;
  1610.   R := Rect;
  1611.   R.Right := R.Left;
  1612.   S := '';
  1613.   ATop := (R.Bottom + R.Top - Canvas.TextHeight('Xy')) div 2;
  1614.   for J := 0 to LastFieldIndex do begin
  1615.     Field := FListFields[J];
  1616.     if FListStyle = lsFixed then begin
  1617.       if J < LastFieldIndex then W := Field.DisplayWidth * TextWidth + 4
  1618.       else W := ClientWidth - R.Right;
  1619.       if IsEmpty then begin
  1620.         if J = 0 then begin
  1621.           S := DisplayEmpty;
  1622.         end
  1623.         else S := '';
  1624.       end
  1625.       else S := Field.DisplayText;
  1626.       X := 2;
  1627.       AAlignment := Field.Alignment;
  1628. {$IFDEF RX_D4}
  1629.       if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  1630. {$ENDIF}
  1631.       case AAlignment of
  1632.         taRightJustify: X := W - Canvas.TextWidth(S) - 3;
  1633.         taCenter: X := (W - Canvas.TextWidth(S)) div 2;
  1634.       end;
  1635.       R.Left := R.Right;
  1636.       R.Right := R.Right + W;
  1637. {$IFDEF RX_D4}
  1638.       if SysLocale.MiddleEast and UseRightToLeftReading then
  1639.         Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
  1640.       else
  1641.         Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
  1642. {$ENDIF}
  1643.       Canvas.TextRect(R, R.Left + X, ATop, S);
  1644.       if J < LastFieldIndex then begin
  1645.         Canvas.MoveTo(R.Right, R.Top);
  1646.         Canvas.LineTo(R.Right, R.Bottom);
  1647.         Inc(R.Right);
  1648.         if R.Right >= ClientWidth then Break;
  1649.       end;
  1650.     end
  1651.     else {if FListStyle = lsDelimited then} if not IsEmpty then begin
  1652.       S := S + Field.DisplayText;
  1653.       if J < LastFieldIndex then S := S + FFieldsDelim + ' ';
  1654.     end;
  1655.   end;
  1656.   if (FListStyle = lsDelimited) then begin
  1657.     if IsEmpty then
  1658.       S := DisplayEmpty;
  1659.     R.Left := Rect.Left;
  1660.     R.Right := Rect.Right;
  1661. {$IFDEF RX_D4}
  1662.     if SysLocale.MiddleEast and UseRightToLeftReading then
  1663.       Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
  1664.     else
  1665.       Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
  1666. {$ENDIF}
  1667.     Canvas.TextRect(R, R.Left + 2, ATop, S);
  1668.   end;
  1669. end;
  1670.  
  1671. procedure TRxDBLookupList.Paint;
  1672. var
  1673.   I, J, TextHeight, TextMargin: Integer;
  1674.   Image: TGraphic;
  1675.   Bmp: TBitmap;
  1676.   R, ImageRect: TRect;
  1677.   Selected: Boolean;
  1678. begin
  1679.   Bmp := TBitmap.Create;
  1680.   try
  1681.     Canvas.Font := Font;
  1682.     TextHeight := GetTextHeight;
  1683.     if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
  1684.       Canvas.Pen.Color := clBtnFace
  1685.     else Canvas.Pen.Color := clBtnShadow;
  1686.     for I := 0 to FRowCount - 1 do begin
  1687.       J := I - Ord(EmptyRowVisible);
  1688.       Canvas.Font.Color := Font.Color;
  1689.       Canvas.Brush.Color := Color;
  1690.       Selected := not FKeySelected and (I = 0) and not EmptyRowVisible;
  1691.       R.Top := I * TextHeight;
  1692.       R.Bottom := R.Top + TextHeight;
  1693.       if I  < FRecordCount + Ord(EmptyRowVisible) then begin
  1694.         if (I = 0) and (J = -1) then begin
  1695.           if ValueIsEmpty(FValue) then begin
  1696.             Canvas.Font.Color := clHighlightText;
  1697.             Canvas.Brush.Color := clHighlight;
  1698.             Selected := True;
  1699.           end
  1700.           else Canvas.Brush.Color := EmptyItemColor;
  1701.           R.Left := 0; R.Right := ClientWidth;
  1702.           Image := GetPicture(False, True, TextMargin);
  1703.           if TextMargin > 0 then begin
  1704.             with Bmp do begin
  1705.               Canvas.Font := Self.Canvas.Font;
  1706.               Canvas.Brush := Self.Canvas.Brush;
  1707.               Canvas.Pen := Self.Canvas.Pen;
  1708.               Width := WidthOf(R);
  1709.               Height := HeightOf(R);
  1710.             end;
  1711.             ImageRect := Bounds(0, 0, TextMargin, HeightOf(R));
  1712.             Bmp.Canvas.FillRect(ImageRect);
  1713.             if Image <> nil then DrawPicture(Bmp.Canvas, ImageRect, Image);
  1714.             DrawItemText(Bmp.Canvas, Bounds(TextMargin, 0, WidthOf(R) - TextMargin,
  1715.               HeightOf(R)), Selected, True);
  1716.             Canvas.Draw(R.Left, R.Top, Bmp);
  1717.           end
  1718.           else DrawItemText(Canvas, R, Selected, True);
  1719.         end
  1720.         else begin
  1721.           FLookupLink.ActiveRecord := J;
  1722.           if not ValueIsEmpty(FValue) and (FKeyField.AsString = FValue) then
  1723.           begin
  1724.             Canvas.Font.Color := clHighlightText;
  1725.             Canvas.Brush.Color := clHighlight;
  1726.             Selected := True;
  1727.           end;
  1728.           R.Left := 0; R.Right := ClientWidth;
  1729.           Image := GetPicture(False, False, TextMargin);
  1730.           if TextMargin > 0 then begin
  1731.             with Bmp do begin
  1732.               Canvas.Font := Self.Canvas.Font;
  1733.               Canvas.Brush := Self.Canvas.Brush;
  1734.               Canvas.Pen := Self.Canvas.Pen;
  1735.               Width := WidthOf(R);
  1736.               Height := HeightOf(R);
  1737.             end;
  1738.             ImageRect := Bounds(0, 0, TextMargin, HeightOf(R));
  1739.             Bmp.Canvas.FillRect(ImageRect);
  1740.             if Image <> nil then DrawPicture(Bmp.Canvas, ImageRect, Image);
  1741.             DrawItemText(Bmp.Canvas, Bounds(TextMargin, 0, WidthOf(R) - TextMargin,
  1742.               HeightOf(R)), Selected, False);
  1743.             Canvas.Draw(R.Left, R.Top, Bmp);
  1744.           end
  1745.           else DrawItemText(Canvas, R, Selected, False);
  1746.         end;
  1747.       end;
  1748.       R.Left := 0;
  1749.       R.Right := ClientWidth;
  1750.       if J >= FRecordCount then Canvas.FillRect(R);
  1751.       if Selected and (FFocused or FPopup) then Canvas.DrawFocusRect(R);
  1752.     end;
  1753.   finally
  1754.     Bmp.Free;
  1755.   end;
  1756.   if FRecordCount <> 0 then FLookupLink.ActiveRecord := FRecordIndex;
  1757. end;
  1758.  
  1759. procedure TRxDBLookupList.SelectCurrent;
  1760. begin
  1761.   FLockPosition := True;
  1762.   try
  1763.     if FSelectEmpty then begin
  1764.       ResetField;
  1765.     end
  1766.     else SelectKeyValue(FKeyField.AsString);
  1767.   finally
  1768.     FSelectEmpty := False;
  1769.     FLockPosition := False;
  1770.   end;
  1771. end;
  1772.  
  1773. procedure TRxDBLookupList.SelectItemAt(X, Y: Integer);
  1774. var
  1775.   Delta: Integer;
  1776. begin
  1777.   if Y < 0 then Y := 0;
  1778.   if Y >= ClientHeight then Y := ClientHeight - 1;
  1779.   Delta := Y div GetTextHeight;
  1780.   if (Delta = 0) and EmptyRowVisible then begin
  1781.     FSelectEmpty := True;
  1782.   end
  1783.   else begin
  1784.     Delta := Delta - FRecordIndex;
  1785.     if EmptyRowVisible then Dec(Delta);
  1786.     FLookupLink.DataSet.MoveBy(Delta);
  1787.   end;
  1788.   SelectCurrent;
  1789. end;
  1790.  
  1791. procedure TRxDBLookupList.SetBorderStyle(Value: TBorderStyle);
  1792. begin
  1793.   if FBorderStyle <> Value then begin
  1794.     FBorderStyle := Value;
  1795.     RecreateWnd;
  1796.     if not (csReading in ComponentState) then begin
  1797.       Height := Height;
  1798.       RowCount := RowCount;
  1799.     end;
  1800.   end;
  1801. end;
  1802.  
  1803. procedure TRxDBLookupList.UpdateDisplayEmpty(const Value: string);
  1804. begin
  1805.   UpdateBufferCount(RowCount - Ord(Value <> EmptyStr));
  1806. end;
  1807.  
  1808. procedure TRxDBLookupList.UpdateBufferCount(Rows: Integer);
  1809. begin
  1810.   if FLookupLink.BufferCount <> Rows then begin
  1811.     FLookupLink.BufferCount := Rows;
  1812.     ListLinkDataChanged;
  1813.   end;
  1814. end;
  1815.  
  1816. procedure TRxDBLookupList.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  1817. var
  1818.   BorderSize, TextHeight, Rows: Integer;
  1819. begin
  1820.   BorderSize := GetBorderSize;
  1821.   TextHeight := GetTextHeight;
  1822.   Rows := (AHeight - BorderSize) div TextHeight;
  1823.   if Rows < 1 then Rows := 1;
  1824.   FRowCount := Rows;
  1825.   UpdateBufferCount(Rows - Ord(EmptyRowVisible));
  1826.   if not (csReading in ComponentState) then
  1827.     AHeight := Rows * TextHeight + BorderSize;
  1828.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  1829. end;
  1830.  
  1831. procedure TRxDBLookupList.SetRowCount(Value: Integer);
  1832. begin
  1833.   if Value < 1 then Value := 1;
  1834.   if Value > 50 then Value := 50;
  1835.   Height := Value * GetTextHeight + GetBorderSize;
  1836. end;
  1837.  
  1838. procedure TRxDBLookupList.StopTimer;
  1839. begin
  1840.   if FTimerActive then begin
  1841.     KillTimer(Handle, 1);
  1842.     FTimerActive := False;
  1843.   end;
  1844. end;
  1845.  
  1846. procedure TRxDBLookupList.StopTracking;
  1847. begin
  1848.   if FTracking then begin
  1849.     StopTimer;
  1850.     FTracking := False;
  1851.     MouseCapture := False;
  1852.   end;
  1853. end;
  1854.  
  1855. procedure TRxDBLookupList.TimerScroll;
  1856. var
  1857.   Delta, Distance, Interval: Integer;
  1858. begin
  1859.   Delta := 0;
  1860.   Distance := 0;
  1861.   if FMousePos < 0 then begin
  1862.     Delta := -1;
  1863.     Distance := -FMousePos;
  1864.   end;
  1865.   if FMousePos >= ClientHeight then begin
  1866.     Delta := 1;
  1867.     Distance := FMousePos - ClientHeight + 1;
  1868.   end;
  1869.   if Delta = 0 then StopTimer
  1870.   else begin
  1871.     FLookupLink.DataSet.MoveBy(Delta);
  1872.     SelectCurrent;
  1873.     Interval := 200 - Distance * 15;
  1874.     if Interval < 0 then Interval := 0;
  1875.     SetTimer(Handle, 1, Interval, nil);
  1876.     FTimerActive := True;
  1877.   end;
  1878. end;
  1879.  
  1880. procedure TRxDBLookupList.UpdateScrollBar;
  1881. (*
  1882. {$IFDEF RX_D3}
  1883. var
  1884.   SIOld, SINew: TScrollInfo;
  1885. begin
  1886.   if FLookuplink.Active and HandleAllocated then begin
  1887.     with FLookuplink.DataSet do begin
  1888.       SIOld.cbSize := sizeof(SIOld);
  1889.       SIOld.fMask := SIF_ALL;
  1890.       GetScrollInfo(Self.Handle, SB_VERT, SIOld);
  1891.       SINew := SIOld;
  1892.       if IsSequenced then begin
  1893.         SINew.nMin := 1;
  1894.         SINew.nPage := Self.FRowCount - Ord(EmptyRowVisible);
  1895.         SINew.nMax := RecordCount + SINew.nPage - 1;
  1896.         if State in [dsInactive, dsBrowse, dsEdit] then
  1897.           SINew.nPos := RecNo;
  1898.       end
  1899.       else begin
  1900.         SINew.nMin := 0;
  1901.         SINew.nPage := 0;
  1902.         if Self.FRecordCount = (FRowCount - Ord(EmptyRowVisible)) then begin
  1903.           SINew.nMax := 4;
  1904.           if BOF then SINew.nPos := 0
  1905.           else if EOF then SINew.nPos := 4
  1906.           else SINew.nPos := 2;
  1907.         end
  1908.         else begin
  1909.           SINew.nMax := 0;
  1910.           SINew.nPos := 0;
  1911.         end;
  1912.       end;
  1913.       if (SINew.nMin <> SIOld.nMin) or (SINew.nMax <> SIOld.nMax) or
  1914.         (SINew.nPage <> SIOld.nPage) or (SINew.nPos <> SIOld.nPos) then
  1915.         SetScrollInfo(Self.Handle, SB_VERT, SINew, True);
  1916.     end;
  1917.   end
  1918.   else begin
  1919.     SetScrollRange(Handle, SB_VERT, 0, 0, False);
  1920.     SetScrollPos(Handle, SB_VERT, 0, True);
  1921.   end;
  1922. end;
  1923. {$ELSE}
  1924. *)
  1925. var
  1926.   Pos, Max: Integer;
  1927.   CurPos, MaxPos: Integer;
  1928. begin
  1929.   if FLookupLink.Active then begin
  1930.     Pos := 0;
  1931.     Max := 0;
  1932.     if FRecordCount = (FRowCount - Ord(EmptyRowVisible)) then begin
  1933.       Max := 4;
  1934.       if not FLookupLink.DataSet.BOF then
  1935.         if not FLookupLink.DataSet.EOF then Pos := 2 else Pos := 4;
  1936.     end;
  1937.     GetScrollRange(Handle, SB_VERT, CurPos, MaxPos);
  1938.     if MaxPos = 0 then MaxPos := FRecordCount;
  1939.     CurPos := GetScrollPos(Handle, SB_VERT);
  1940.     if Max <> MaxPos then SetScrollRange(Handle, SB_VERT, 0, Max, False);
  1941.     if CurPos <> Pos then SetScrollPos(Handle, SB_VERT, Pos, True);
  1942.   end
  1943.   else begin
  1944.     SetScrollRange(Handle, SB_VERT, 0, 0, False);
  1945.     SetScrollPos(Handle, SB_VERT, 0, True);
  1946.   end;
  1947. end;
  1948.  
  1949. procedure TRxDBLookupList.CMCtl3DChanged(var Message: TMessage);
  1950. begin
  1951. {$IFDEF WIN32}
  1952.   if NewStyleControls and (FBorderStyle = bsSingle) then begin
  1953.     RecreateWnd;
  1954.     if not (csReading in ComponentState) then RowCount := RowCount;
  1955.   end;
  1956.   inherited;
  1957. {$ELSE}
  1958.   inherited;
  1959.   Invalidate;
  1960.   if not (csReading in ComponentState) then RowCount := RowCount;
  1961. {$ENDIF}
  1962. end;
  1963.  
  1964. procedure TRxDBLookupList.CMFontChanged(var Message: TMessage);
  1965. begin
  1966.   inherited;
  1967.   if not (csReading in ComponentState) then Height := Height;
  1968. end;
  1969.  
  1970. procedure TRxDBLookupList.WMCancelMode(var Message: TMessage);
  1971. begin
  1972.   StopTracking;
  1973.   inherited;
  1974. end;
  1975.  
  1976. procedure TRxDBLookupList.WMTimer(var Message: TMessage);
  1977. begin
  1978.   TimerScroll;
  1979. end;
  1980.  
  1981. procedure TRxDBLookupList.WMNCHitTest(var Msg: TWMNCHitTest);
  1982. begin
  1983.   if csDesigning in ComponentState then begin
  1984.     if FLookupLink.Active then DefaultHandler(Msg)
  1985.     else inherited;
  1986.   end
  1987.   else inherited;
  1988. end;
  1989.  
  1990. {$IFDEF RX_D4}
  1991. function TRxDBLookupList.DoMouseWheelDown(Shift: TShiftState;
  1992.   MousePos: TPoint): Boolean;
  1993. begin
  1994.   Result := inherited DoMouseWheelDown(Shift, MousePos);
  1995.   if not Result then begin
  1996.     with FLookupLink.DataSet do
  1997.       Result := MoveBy(FRecordCount - FRecordIndex) <> 0;
  1998.   end;
  1999. end;
  2000.  
  2001. function TRxDBLookupList.DoMouseWheelUp(Shift: TShiftState;
  2002.   MousePos: TPoint): Boolean;
  2003. begin
  2004.   Result := inherited DoMouseWheelUp(Shift, MousePos);
  2005.   if not Result then begin
  2006.     with FLookupLink.DataSet do
  2007.       Result := MoveBy(-FRecordIndex - 1) <> 0;
  2008.   end;
  2009. end;
  2010. {$ENDIF RX_D4}
  2011.  
  2012. procedure TRxDBLookupList.WMVScroll(var Message: TWMVScroll);
  2013. begin
  2014.   FSearchText := '';
  2015.   with Message, FLookupLink.DataSet do
  2016.     case ScrollCode of
  2017.       SB_LINEUP: MoveBy(-FRecordIndex - 1);
  2018.       SB_LINEDOWN: MoveBy(FRecordCount - FRecordIndex);
  2019.       SB_PAGEUP: MoveBy(-FRecordIndex - FRecordCount + 1);
  2020.       SB_PAGEDOWN: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
  2021.       SB_THUMBPOSITION:
  2022.         begin
  2023.           case Pos of
  2024.             0: First;
  2025.             1: MoveBy(-FRecordIndex - FRecordCount + 1);
  2026.             2: Exit;
  2027.             3: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
  2028.             4: Last;
  2029.           end;
  2030.         end;
  2031.       SB_BOTTOM: Last;
  2032.       SB_TOP: First;
  2033.     end;
  2034. end;
  2035.  
  2036. { TRxPopupDataList }
  2037.  
  2038. constructor TRxPopupDataList.Create(AOwner: TComponent);
  2039. begin
  2040.   inherited Create(AOwner);
  2041.   if AOwner is TRxLookupControl then FCombo := TRxLookupControl(AOwner);
  2042. {$IFDEF WIN32}
  2043.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
  2044. {$ELSE}
  2045.   ControlStyle := [csOpaque];
  2046. {$ENDIF}
  2047.   FPopup := True;
  2048.   TabStop := False;
  2049.   ParentCtl3D := False;
  2050.   Ctl3D := False;
  2051. end;
  2052.  
  2053. procedure TRxPopupDataList.CreateParams(var Params: TCreateParams);
  2054. begin
  2055.   inherited CreateParams(Params);
  2056.   with Params do begin
  2057.     Style := WS_POPUP or WS_BORDER;
  2058. {$IFDEF WIN32}
  2059.     ExStyle := WS_EX_TOOLWINDOW;
  2060. {$ENDIF}
  2061. {$IFDEF RX_D4}
  2062.     AddBiDiModeExStyle(ExStyle);
  2063. {$ENDIF}
  2064.     WindowClass.Style := CS_SAVEBITS;
  2065.   end;
  2066. end;
  2067.  
  2068. {$IFNDEF WIN32}
  2069. procedure TRxPopupDataList.CreateWnd;
  2070. begin
  2071.   inherited CreateWnd;
  2072.   if (csDesigning in ComponentState) then SetParent(nil);
  2073. end;
  2074. {$ENDIF}
  2075.  
  2076. procedure TRxPopupDataList.WMMouseActivate(var Message: TMessage);
  2077. begin
  2078.   Message.Result := MA_NOACTIVATE;
  2079. end;
  2080.  
  2081. procedure TRxPopupDataList.Click;
  2082. begin
  2083.   inherited Click;
  2084.   if Assigned(FCombo) and TRxDBLookupCombo(FCombo).FListVisible then
  2085.     TRxDBLookupCombo(FCombo).InvalidateText;
  2086. end;
  2087.  
  2088. procedure TRxPopupDataList.KeyPress(var Key: Char);
  2089. begin
  2090.   inherited KeyPress(Key);
  2091.   if Assigned(FCombo) and TRxDBLookupCombo(FCombo).FListVisible then
  2092.     TRxDBLookupCombo(FCombo).InvalidateText;
  2093. end;
  2094.  
  2095. { TRxDBLookupCombo }
  2096.  
  2097. constructor TRxDBLookupCombo.Create(AOwner: TComponent);
  2098. begin
  2099.   inherited Create(AOwner);
  2100. {$IFDEF WIN32}
  2101.   ControlStyle := ControlStyle + [csReplicatable] - [csSetCaption];
  2102. {$ELSE}
  2103.   ControlStyle := [csFramed, csOpaque];
  2104. {$ENDIF}
  2105.   Width := 145;
  2106.   Height := 0;
  2107.   FDataList := TRxPopupDataList.Create(Self);
  2108.   FDataList.Visible := False;
  2109.   FDataList.Parent := Self;
  2110.   FDataList.OnMouseUp := ListMouseUp;
  2111.   FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  2112.   FDropDownCount := 8;
  2113.   FDisplayValues := TStringList.Create;
  2114.   FSelImage := TPicture.Create;
  2115. {$IFNDEF WIN32}
  2116.   FBtnGlyph := TBitmap.Create;
  2117.   { Load ComboBox button glyph }
  2118.   FBtnGlyph.Handle := LoadBitmap(0, PChar(32738));
  2119.   FBtnDisabled := CreateDisabledBitmap(FBtnGlyph, clBlack);
  2120. {$ENDIF}
  2121.   Height := {GetMinHeight}21;
  2122.   FIgnoreCase := True;
  2123.   FEscapeClear := True;
  2124. end;
  2125.  
  2126. destructor TRxDBLookupCombo.Destroy;
  2127. begin
  2128. {$IFNDEF WIN32}
  2129.   FBtnDisabled.Free;
  2130.   FBtnGlyph.Free;
  2131. {$ENDIF}
  2132.   FSelImage.Free;
  2133.   FSelImage := nil;
  2134.   FDisplayValues.Free;
  2135.   FDisplayValues := nil;
  2136.   inherited Destroy;
  2137. end;
  2138.  
  2139. procedure TRxDBLookupCombo.CreateParams(var Params: TCreateParams);
  2140. begin
  2141.   inherited CreateParams(Params);
  2142.   with Params do
  2143. {$IFDEF WIN32}
  2144.     if NewStyleControls and Ctl3D then ExStyle := ExStyle or WS_EX_CLIENTEDGE
  2145.     else Style := Style or WS_BORDER;
  2146. {$ELSE}
  2147.     Style := Style or WS_BORDER;
  2148. {$ENDIF}
  2149. end;
  2150.  
  2151. procedure TRxDBLookupCombo.CloseUp(Accept: Boolean);
  2152. var
  2153.   ListValue: string;
  2154. begin
  2155.   if FListVisible then begin
  2156.     if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  2157.     ListValue := FDataList.Value;
  2158.     SetWindowPos(FDataList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
  2159.       SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  2160.     FListVisible := False;
  2161.     FDataList.LookupSource := nil;
  2162.     Invalidate;
  2163.     FSearchText := '';
  2164.     FDataList.FSearchText := '';
  2165.     if Accept and CanModify and (Value <> ListValue) then
  2166.       SelectKeyValue(ListValue);
  2167.     if CanFocus then SetFocus;
  2168.     if Assigned(FOnCloseUp) then FOnCloseUp(Self);
  2169.   end;
  2170. end;
  2171.  
  2172. procedure TRxDBLookupCombo.DropDown;
  2173. var
  2174.   P: TPoint;
  2175.   I, Y: Integer;
  2176.   S: string;
  2177. begin
  2178.   if not FListVisible and {FListActive} CanModify then begin
  2179.     if Assigned(FOnDropDown) then FOnDropDown(Self);
  2180.     FDataList.Color := Color;
  2181.     FDataList.Font := Font;
  2182.     FDataList.ItemHeight := ItemHeight;
  2183.     FDataList.ReadOnly := not CanModify;
  2184.     FDataList.EmptyValue := EmptyValue;
  2185.     FDataList.DisplayEmpty := DisplayEmpty;
  2186.     FDataList.EmptyItemColor := EmptyItemColor;
  2187.     FDataList.RowCount := FDropDownCount;
  2188.     FDataList.LookupField := FLookupFieldName;
  2189.     FDataList.ListStyle := FListStyle;
  2190.     FDataList.FieldsDelimiter := FFieldsDelim;
  2191.     FDataList.IgnoreCase := FIgnoreCase;
  2192.     FDataList.IndexSwitch := FIndexSwitch;
  2193.     FDataList.OnGetImage := OnGetImage;
  2194.     if FDisplayField <> nil then FAlignment := FDisplayField.Alignment;
  2195.     S := '';
  2196.     for I := 0 to FListFields.Count - 1 do
  2197.       S := S + TField(FListFields[I]).FieldName + ';';
  2198.     FDataList.LookupDisplay := S;
  2199.     FDataList.LookupDisplayIndex := FListFields.IndexOf(FDisplayField);
  2200.     {FDataList.FLockPosition := True;}
  2201.     try
  2202.       FDataList.LookupSource := FLookupLink.DataSource;
  2203.     finally
  2204.       {FDataList.FLockPosition := False;}
  2205.     end;
  2206.     FDataList.SetValueKey(Value);
  2207.     {FDataList.KeyValueChanged;}
  2208.     if FDropDownWidth > 0 then
  2209.       FDataList.Width := FDropDownWidth
  2210.     else if FDropDownWidth < 0 then
  2211.       FDataList.Width := Max(Width, FDataList.GetWindowWidth)
  2212.     else FDataList.Width := Width;
  2213.     P := Parent.ClientToScreen(Point(Left, Top));
  2214.     Y := P.Y + Height;
  2215.     if Y + FDataList.Height > Screen.Height then
  2216.       Y := P.Y - FDataList.Height;
  2217.     case FDropDownAlign of
  2218.       daRight: Dec(P.X, FDataList.Width - Width);
  2219.       daCenter: Dec(P.X, (FDataList.Width - Width) div 2);
  2220.     end;
  2221.     if P.X + FDataList.Width > Screen.Width then
  2222.       P.X := Screen.Width - FDataList.Width;
  2223.     SetWindowPos(FDataList.Handle, HWND_TOP, Max(P.X, 0), Y, 0, 0,
  2224.       SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  2225.     FListVisible := True;
  2226.     InvalidateText;
  2227.     Repaint;
  2228.   end;
  2229. end;
  2230.  
  2231. function TRxDBLookupCombo.GetMinHeight: Integer;
  2232. begin
  2233.   Result := DefaultTextHeight + GetBorderSize + 3;
  2234. end;
  2235.  
  2236. procedure TRxDBLookupCombo.UpdateFieldText;
  2237. var
  2238.   I: Integer;
  2239.   S: string;
  2240. begin
  2241.   if FDisplayValues <> nil then FDisplayValues.Clear;
  2242.   if DisplayAllFields then begin
  2243.     S := '';
  2244.     for I := 0 to FListFields.Count - 1 do begin
  2245.       if S <> '' then S := S + FFieldsDelim + ' ';
  2246.       S := S + TField(FListFields[I]).DisplayText;
  2247.       if (ListStyle = lsFixed) and Assigned(FDisplayValues) then begin
  2248.         with TField(FListFields[I]) do
  2249.           FDisplayValues.AddObject(DisplayText,
  2250.             TObject(MakeLong(DisplayWidth, Ord(Alignment))));
  2251.       end;
  2252.     end;
  2253.     if S = '' then S := FDisplayField.DisplayText;
  2254.     inherited Text := S;
  2255.   end
  2256.   else inherited Text := FDisplayField.DisplayText;
  2257.   FAlignment := FDisplayField.Alignment;
  2258. end;
  2259.  
  2260. function TRxDBLookupCombo.GetDisplayValues(Index: Integer): string; 
  2261. begin
  2262.   if Assigned(FDisplayValues) and (FDisplayValues.Count > Index) then
  2263.     Result := FDisplayValues[Index]
  2264.   else  
  2265.     Result := FDisplayValue;
  2266. end;
  2267.  
  2268. function TRxDBLookupCombo.GetText: string;
  2269. begin
  2270.   Result := inherited Text;
  2271. end;
  2272.  
  2273. procedure TRxDBLookupCombo.InvalidateText;
  2274. var
  2275.   R: TRect;
  2276. begin
  2277.   SetRect(R, 1, 1, ClientWidth - FButtonWidth - 1, ClientHeight - 1);
  2278. {$IFNDEF WIN32}
  2279.   InflateRect(R, -1, -1);
  2280. {$ENDIF}
  2281.   InvalidateRect(Self.Handle, @R, False);
  2282.   UpdateWindow(Self.Handle);
  2283. end;
  2284.  
  2285. procedure TRxDBLookupCombo.KeyDown(var Key: Word; Shift: TShiftState);
  2286. var
  2287.   Delta: Integer;
  2288. begin
  2289.   if FListActive and ((Key = VK_UP) or (Key = VK_DOWN)) then
  2290.     if ssAlt in Shift then begin
  2291.       if FListVisible then CloseUp(True) else DropDown;
  2292.       Key := 0;
  2293.     end
  2294.     else if (not FListVisible) and (not ReadOnly) then begin
  2295.       if not LocateKey then FLookupLink.DataSet.First
  2296.       else begin
  2297.         if Key = VK_UP then Delta := -1 else Delta := 1;
  2298.         FLookupLink.DataSet.MoveBy(Delta);
  2299.       end;
  2300.       SelectKeyValue(FKeyField.AsString);
  2301.       Key := 0;
  2302.     end;
  2303.   if (Key <> 0) and FListVisible then FDataList.KeyDown(Key, Shift);
  2304.   inherited KeyDown(Key, Shift);
  2305. end;
  2306.  
  2307. procedure TRxDBLookupCombo.KeyPress(var Key: Char);
  2308. begin
  2309.   if FListVisible then begin
  2310.     if Key in [#13, #27] then begin
  2311.       CloseUp(Key = #13);
  2312.       Key := #0;
  2313.     end
  2314.     else FDataList.KeyPress(Key)
  2315.   end
  2316.   else begin
  2317.     if Key in [#32..#255] then begin
  2318.       DropDown;
  2319.       if FListVisible then FDataList.KeyPress(Key);
  2320.     end
  2321.     else if (Key = #27) and FEscapeClear and (not ValueIsEmpty(FValue)) and
  2322.       CanModify then
  2323.     begin
  2324.       ResetField;
  2325.       Key := #0;
  2326.     end;
  2327.   end;
  2328.   inherited KeyPress(Key);
  2329.   if (Key in [#13, #27]) then
  2330.     GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
  2331. end;
  2332.  
  2333. procedure TRxDBLookupCombo.DisplayValueChanged;
  2334. begin
  2335.   if FListActive and LocateDisplay then begin
  2336.     FValue := FKeyField.AsString;
  2337.     UpdateFieldText;
  2338.   end
  2339.   else begin
  2340.     FValue := FEmptyValue;
  2341.     inherited Text := DisplayEmpty;
  2342.     if FDisplayValues <> nil then FDisplayValues.Clear;
  2343.     FAlignment := taLeftJustify;
  2344.   end;
  2345.   UpdateDisplayValue;
  2346.   UpdateCurrentImage;
  2347.   Invalidate;
  2348. end;
  2349.  
  2350. procedure TRxDBLookupCombo.KeyValueChanged;
  2351. begin
  2352. {$IFDEF WIN32}
  2353.   if FLookupMode then begin
  2354.     if FDisplayValues <> nil then FDisplayValues.Clear;
  2355.     if FDataLink.Active and (FDataField <> nil) then begin
  2356.       inherited Text := FDataField.DisplayText;
  2357.       FAlignment := FDataField.Alignment;
  2358.     end
  2359.     else inherited Text := '';
  2360.   end else
  2361. {$ENDIF}
  2362.   if FListActive and LocateKey then
  2363.     UpdateFieldText
  2364.   else if FListActive then begin
  2365.     FValue := FEmptyValue;
  2366.     inherited Text := DisplayEmpty;
  2367.     if FDisplayValues <> nil then FDisplayValues.Clear;
  2368.     FAlignment := taLeftJustify;
  2369.   end
  2370.   else begin
  2371.     inherited Text := '';
  2372.     if FDisplayValues <> nil then FDisplayValues.Clear;
  2373.   end;
  2374.   UpdateDisplayValue;
  2375.   UpdateCurrentImage;
  2376.   Invalidate;
  2377. end;
  2378.  
  2379. procedure TRxDBLookupCombo.SetFieldsDelim(Value: Char);
  2380. begin
  2381.   if (FFieldsDelim <> Value) then begin
  2382.     inherited SetFieldsDelim(Value);
  2383.     if (ListStyle = lsDelimited) and DisplayAllFields and
  2384.       not (csReading in ComponentState) then KeyValueChanged;
  2385.   end;
  2386. end;
  2387.  
  2388. procedure TRxDBLookupCombo.SetListStyle(Value: TLookupListStyle);
  2389. begin
  2390.   if (FListStyle <> Value) then begin
  2391.     FListStyle := Value;
  2392.     if DisplayAllFields and not (csReading in ComponentState) then
  2393.       KeyValueChanged;
  2394.   end;
  2395. end;
  2396.  
  2397. function TRxDBLookupCombo.GetDisplayAll: Boolean;
  2398. begin
  2399. {$IFDEF WIN32}
  2400.   if FLookupMode then Result := False else
  2401. {$ENDIF}
  2402.   Result := FDisplayAll;
  2403. end;
  2404.  
  2405. procedure TRxDBLookupCombo.SetDisplayAll(Value: Boolean);
  2406. begin
  2407.   if FDisplayAll <> Value then begin
  2408. {$IFDEF WIN32}
  2409.     if FLookupMode then FDisplayAll := False else
  2410. {$ENDIF}
  2411.     FDisplayAll := Value;
  2412.     if not (csReading in ComponentState)
  2413.       {$IFDEF WIN32} and not FLookupMode {$ENDIF} then
  2414.       KeyValueChanged
  2415.     else Invalidate;
  2416.   end;
  2417. end;
  2418.  
  2419. procedure TRxDBLookupCombo.ListLinkDataChanged;
  2420. begin
  2421.   if FDataLink.Active and FDataLink.DataSet.IsLinkedTo(LookupSource) then
  2422.     if FListActive then DataLinkRecordChanged(nil);
  2423. end;
  2424.  
  2425. procedure TRxDBLookupCombo.ListLinkActiveChanged;
  2426. begin
  2427.   inherited ListLinkActiveChanged;
  2428.   if FListActive and Assigned(FMasterField) then UpdateKeyValue
  2429.   else KeyValueChanged;
  2430. end;
  2431.  
  2432. procedure TRxDBLookupCombo.ListMouseUp(Sender: TObject; Button: TMouseButton;
  2433.   Shift: TShiftState; X, Y: Integer);
  2434. begin
  2435.   if Button = mbLeft then
  2436.     CloseUp(PtInRect(FDataList.ClientRect, Point(X, Y)));
  2437. end;
  2438.  
  2439. procedure TRxDBLookupCombo.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2440.   X, Y: Integer);
  2441. begin
  2442.   if Button = mbLeft then begin
  2443.     if CanFocus then SetFocus;
  2444.     if not FFocused then Exit;
  2445.     if FListVisible then CloseUp(False)
  2446.     else if {FListActive} CanModify then begin
  2447.       MouseCapture := True;
  2448.       FTracking := True;
  2449.       TrackButton(X, Y);
  2450.       DropDown;
  2451.     end;
  2452.   end;
  2453.   inherited MouseDown(Button, Shift, X, Y);
  2454. end;
  2455.  
  2456. procedure TRxDBLookupCombo.MouseMove(Shift: TShiftState; X, Y: Integer);
  2457. var
  2458.   ListPos: TPoint;
  2459.   MousePos: TSmallPoint;
  2460. begin
  2461.   if FTracking then begin
  2462.     TrackButton(X, Y);
  2463.     if FListVisible then begin
  2464.       ListPos := FDataList.ScreenToClient(ClientToScreen(Point(X, Y)));
  2465.       if PtInRect(FDataList.ClientRect, ListPos) then begin
  2466.         StopTracking;
  2467.         MousePos := PointToSmallPoint(ListPos);
  2468.         SendMessage(FDataList.Handle, WM_LBUTTONDOWN, 0, Longint(MousePos));
  2469.         Exit;
  2470.       end;
  2471.     end;
  2472.   end;
  2473.   inherited MouseMove(Shift, X, Y);
  2474. end;
  2475.  
  2476. procedure TRxDBLookupCombo.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2477.   X, Y: Integer);
  2478. begin
  2479.   StopTracking;
  2480.   inherited MouseUp(Button, Shift, X, Y);
  2481. end;
  2482.  
  2483. procedure TRxDBLookupCombo.UpdateCurrentImage;
  2484. begin
  2485.   FSelImage.Assign(nil);
  2486.   FSelMargin := 0;
  2487.   FSelImage.Graphic := inherited GetPicture(False, ValueIsEmpty(Value),
  2488.     FSelMargin);
  2489. end;
  2490.  
  2491. function TRxDBLookupCombo.GetPicture(Current, Empty: Boolean;
  2492.   var TextMargin: Integer): TGraphic;
  2493. begin
  2494.   if Current then begin
  2495.     TextMargin := 0;
  2496.     Result := nil;
  2497.     if (FSelImage <> nil) and (FSelImage.Graphic <> nil) and
  2498.       not FSelImage.Graphic.Empty then
  2499.     begin
  2500.       Result := FSelImage.Graphic;
  2501.       TextMargin := FSelMargin;
  2502.     end;
  2503.   end
  2504.   else Result := inherited GetPicture(Current, Empty, TextMargin);
  2505. end;
  2506.  
  2507. procedure TRxDBLookupCombo.PaintDisplayValues(Canvas: TCanvas; R: TRect;
  2508.   ALeft: Integer);
  2509. var
  2510.   I, LastIndex, TxtWidth: Integer;
  2511.   X, W, ATop, ARight: Integer;
  2512.   S: string;
  2513. begin
  2514.   if ColorToRGB(Self.Color) <> ColorToRGB(clBtnFace) then
  2515.     Canvas.Pen.Color := clBtnFace
  2516.   else Canvas.Pen.Color := clBtnShadow;
  2517.   LastIndex := FDisplayValues.Count - 1;
  2518.   TxtWidth := Canvas.TextWidth('M');
  2519.   ATop := Max(0, (HeightOf(R) - Canvas.TextHeight('Xy')) div 2);
  2520.   ARight := R.Right;
  2521.   Inc(R.Left, ALeft);
  2522.   for I := 0 to LastIndex do begin
  2523.     S := FDisplayValues[I];
  2524.     W := LoWord(Longint(FDisplayValues.Objects[I]));
  2525.     if I < LastIndex then W := W * TxtWidth + 4
  2526.     else W := ARight - R.Left;
  2527.     X := 2;
  2528.     R.Right := R.Left + W;
  2529.     case TAlignment(HiWord(Longint(FDisplayValues.Objects[I]))) of
  2530.       taRightJustify: X := W - Canvas.TextWidth(S) - 3;
  2531.       taCenter: X := (W - Canvas.TextWidth(S)) div 2;
  2532.     end;
  2533.     Canvas.TextRect(R, R.Left + Max(0, X), ATop, S);
  2534.     Inc(R.Left, W);
  2535.     if I < LastIndex then begin
  2536.       Canvas.MoveTo(R.Right, R.Top);
  2537.       Canvas.LineTo(R.Right, R.Bottom);
  2538.       Inc(R.Left);
  2539.     end;
  2540.     if R.Left >= ARight then Break;
  2541.   end;
  2542. end;
  2543.  
  2544. procedure TRxDBLookupCombo.Paint;
  2545. const
  2546.   TransColor: array[Boolean] of TColor = (clBtnFace, clWhite);
  2547. var
  2548.   W, X, Flags, TextMargin: Integer;
  2549.   AText: string;
  2550.   Selected, DrawList, IsEmpty: Boolean;
  2551.   R, ImageRect: TRect;
  2552.   Image: TGraphic;
  2553.   Bmp: TBitmap;
  2554.   Alignment: TAlignment;
  2555. {$IFNDEF WIN32}
  2556.   Target: TRect;
  2557. {$ENDIF}
  2558. begin
  2559.   Canvas.Font := Font;
  2560.   Canvas.Brush.Color := Color;
  2561.   Selected := FFocused and not FListVisible {$IFDEF WIN32} and
  2562.     not (csPaintCopy in ControlState) {$ENDIF};
  2563.   if Selected then begin
  2564.     Canvas.Font.Color := clHighlightText;
  2565.     Canvas.Brush.Color := clHighlight;
  2566.   end
  2567.   else if not Enabled and NewStyleControls then
  2568.     Canvas.Font.Color := clGrayText;
  2569.   AText := inherited Text;
  2570.   Alignment := FAlignment;
  2571.   Image := nil;
  2572.   IsEmpty := False;
  2573.   DrawList := DisplayAllFields;
  2574. {$IFDEF WIN32}
  2575.   if (csPaintCopy in ControlState) and (FDataField <> nil) then begin
  2576.     DrawList := False;
  2577.     AText := FDataField.DisplayText;
  2578.     Alignment := FDataField.Alignment;
  2579.   end;
  2580. {$ENDIF}
  2581.   TextMargin := 0;
  2582.   if FListVisible then begin
  2583.     DrawList := False;
  2584.     if FDataList.FSearchText <> '' then begin
  2585.       AText := FDataList.FSearchText;
  2586.     end
  2587.     else begin
  2588.       if FDataList.ValueIsEmpty(FDataList.Value) then begin
  2589.         AText := DisplayEmpty;
  2590.         IsEmpty := True;
  2591.         Image := GetPicture(False, True, TextMargin);
  2592.       end
  2593.       else if (FDataList.FKeyField.AsString = FDataList.Value) then begin
  2594.         AText := FDataList.FDisplayField.DisplayText;
  2595.         Image := FDataList.GetPicture(False, False, TextMargin);
  2596.       end
  2597.       else begin
  2598.         Image := GetPicture(True, False, TextMargin);
  2599.       end;
  2600.     end;
  2601.   end
  2602.   else begin
  2603. {$IFDEF WIN32}
  2604.     if (csPaintCopy in ControlState) then Image := nil else
  2605. {$ENDIF}
  2606.     begin
  2607.       IsEmpty := ValueIsEmpty(Value);
  2608.       Image := GetPicture(True, IsEmpty, TextMargin);
  2609.     end;
  2610.   end;
  2611. {$IFDEF RX_D4}
  2612.   if UseRightToLeftAlignment then ChangeBiDiModeAlignment(Alignment);
  2613. {$ENDIF}
  2614.   W := ClientWidth - FButtonWidth;
  2615.   if W > 4 then begin
  2616.     SetRect(R, 1, 1, W - 1, ClientHeight - 1);
  2617. {$IFNDEF WIN32}
  2618.     InflateRect(R, -1, -1);
  2619. {$ENDIF}
  2620.     if TextMargin > 0 then Inc(TextMargin);
  2621.     X := 2 + TextMargin;
  2622.     if not (FListVisible and (FDataList.FSearchText <> '')) and not DrawList then
  2623.       case Alignment of
  2624.         taRightJustify: X := W - Canvas.TextWidth(AText) - 6;
  2625.         taCenter: X := (W + TextMargin - Canvas.TextWidth(AText)) div 2;
  2626.       end;
  2627.     Bmp := TBitmap.Create;
  2628.     try
  2629.       with Bmp.Canvas do begin
  2630.         Font := Self.Canvas.Font;
  2631.         Brush := Self.Canvas.Brush;
  2632.         Pen := Self.Canvas.Pen;
  2633.       end;
  2634. {$IFDEF RX_D4}
  2635.       if (BiDiMode = bdRightToLeft) then begin
  2636.         Inc(X, FButtonWidth);
  2637.         Inc(R.Left, FButtonWidth);
  2638.         R.Right := ClientWidth;
  2639.       end;
  2640.       if SysLocale.MiddleEast then begin
  2641.         TControlCanvas(Self.Canvas).UpdateTextFlags;
  2642.         Bmp.Canvas.TextFlags := Self.Canvas.TextFlags;
  2643.       end;
  2644. {$ENDIF}
  2645.       Bmp.Width := WidthOf(R);
  2646.       Bmp.Height := HeightOf(R);
  2647.       ImageRect := Rect(0, 0, WidthOf(R), HeightOf(R));
  2648.       if DrawList and (ListStyle = lsFixed) and (FDisplayValues <> nil) and
  2649.         (FDisplayValues.Count > 0) then
  2650.       begin
  2651.         if IsEmpty then begin
  2652.           AText := DisplayEmpty;
  2653.           Bmp.Canvas.TextRect(ImageRect, X, Max(0, (HeightOf(R) -
  2654.             Canvas.TextHeight(AText)) div 2), AText);
  2655.         end
  2656.         else PaintDisplayValues(Bmp.Canvas, ImageRect, TextMargin);
  2657.       end
  2658.       else begin
  2659.         Bmp.Canvas.TextRect(ImageRect, X, Max(0, (HeightOf(R) -
  2660.           Canvas.TextHeight(AText)) div 2), AText);
  2661.       end;
  2662.       if Image <> nil then begin
  2663.         ImageRect.Right := ImageRect.Left + TextMargin + 2;
  2664.         DrawPicture(Bmp.Canvas, ImageRect, Image);
  2665.       end;
  2666.       Canvas.Draw(R.Left, R.Top, Bmp);
  2667.     finally
  2668.       Bmp.Free;
  2669.     end;
  2670.     if Selected then Canvas.DrawFocusRect(R);
  2671.   end;
  2672.   SetRect(R, W, 0, ClientWidth, ClientHeight);
  2673. {$IFDEF RX_D4}
  2674.   if (BiDiMode = bdRightToLeft) then begin
  2675.     R.Left := 0;
  2676.     R.Right:= FButtonWidth;
  2677.   end;
  2678. {$ENDIF}
  2679. {$IFDEF WIN32}
  2680.   if (not FListActive) or (not Enabled) or ReadOnly then
  2681.     Flags := DFCS_SCROLLCOMBOBOX or DFCS_INACTIVE
  2682.   else if FPressed then
  2683.     Flags := DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED
  2684.   else
  2685.     Flags := DFCS_SCROLLCOMBOBOX;
  2686.   DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags);
  2687. {$ELSE}
  2688.   if NewStyleControls then begin
  2689.     InflateRect(R, -1, -1); Dec(R.Left);
  2690.   end
  2691.   else begin
  2692.     InflateRect(R, 1, 1); Inc(R.Left);
  2693.   end;
  2694.   R := DrawButtonFace(Canvas, R, 1, bsWin31, False, FPressed, False);
  2695.   { draw button glyph }
  2696.   if (not FListActive) or (not Enabled) or ReadOnly then
  2697.     Bmp := FBtnDisabled
  2698.   else
  2699.     Bmp := FBtnGlyph;
  2700.   Target := Bounds(R.Left, R.Top, Bmp.Width, Bmp.Height);
  2701.   OffsetRect(Target, ((R.Right - R.Left) div 2) - (Bmp.Width div 2),
  2702.     ((R.Bottom - R.Top) div 2) - (Bmp.Height div 2));
  2703.   { Canvas.Draw(Target.Left, Target.Top, Bmp); }
  2704.   DrawBitmapTransparent(Canvas, Target.Left, Target.Top, Bmp,
  2705.     TransColor[Bmp = FBtnGlyph]);
  2706. {$ENDIF}
  2707. end;
  2708.  
  2709. procedure TRxDBLookupCombo.ResetField;
  2710. begin
  2711.   if FListVisible then CloseUp(False);
  2712.   inherited ResetField;
  2713.   UpdateCurrentImage;
  2714.   Invalidate;
  2715. end;
  2716.  
  2717. procedure TRxDBLookupCombo.StopTracking;
  2718. begin
  2719.   if FTracking then begin
  2720.     TrackButton(-1, -1);
  2721.     FTracking := False;
  2722.     MouseCapture := False;
  2723.   end;
  2724. end;
  2725.  
  2726. procedure TRxDBLookupCombo.TrackButton(X, Y: Integer);
  2727. var
  2728.   NewState: Boolean;
  2729. begin
  2730.   NewState := PtInRect(Rect(ClientWidth - FButtonWidth, 0, ClientWidth,
  2731.     ClientHeight), Point(X, Y));
  2732.   if FPressed <> NewState then begin
  2733.     FPressed := NewState;
  2734.     Repaint;
  2735.   end;
  2736. end;
  2737.  
  2738. procedure TRxDBLookupCombo.UpdateDisplayEmpty(const Value: string);
  2739. begin
  2740.   if Text = FDisplayEmpty then inherited Text := Value;
  2741. end;
  2742.  
  2743. procedure TRxDBLookupCombo.Click;
  2744. begin
  2745.   inherited Click;
  2746.   Change;
  2747. end;
  2748.  
  2749. procedure TRxDBLookupCombo.CMCancelMode(var Message: TCMCancelMode);
  2750. begin
  2751.   if (Message.Sender <> Self) and (Message.Sender <> FDataList) then
  2752.     CloseUp(False);
  2753. end;
  2754.  
  2755. {$IFDEF WIN32}
  2756. procedure TRxDBLookupCombo.CMCtl3DChanged(var Message: TMessage);
  2757. begin
  2758.   if NewStyleControls then begin
  2759.     RecreateWnd;
  2760.     if not (csReading in ComponentState) and (Height < GetMinHeight) then
  2761.       Height := GetMinHeight;
  2762.   end;
  2763.   inherited;
  2764. end;
  2765.  
  2766. procedure TRxDBLookupCombo.CNKeyDown(var Message: TWMKeyDown);
  2767. begin
  2768.   if not (csDesigning in ComponentState) then
  2769.     if (Message.CharCode in [VK_RETURN, VK_ESCAPE]) and FListVisible and
  2770.       FLookupMode and FDataLink.DataSourceFixed then
  2771.     begin
  2772.       CloseUp(Message.CharCode = VK_RETURN);
  2773.       Message.Result := 1;
  2774.       Exit;
  2775.     end;
  2776.   inherited;
  2777. end;
  2778. {$ENDIF WIN32}
  2779.  
  2780. procedure TRxDBLookupCombo.CMFontChanged(var Message: TMessage);
  2781. begin
  2782.   inherited;
  2783.   if not (csReading in ComponentState) then
  2784.     Height := Max(Height, GetMinHeight);
  2785. end;
  2786.  
  2787. procedure TRxDBLookupCombo.CMEnabledChanged(var Message: TMessage);
  2788. begin
  2789.   inherited;
  2790.   Invalidate;
  2791. end;
  2792.  
  2793. {$IFDEF WIN32}
  2794. procedure TRxDBLookupCombo.CMGetDataLink(var Message: TMessage);
  2795. begin
  2796.   Message.Result := Integer(FDataLink);
  2797. end;
  2798. {$ENDIF}
  2799.  
  2800. procedure TRxDBLookupCombo.WMCancelMode(var Message: TMessage);
  2801. begin
  2802.   StopTracking;
  2803.   inherited;
  2804. end;
  2805.  
  2806. procedure TRxDBLookupCombo.WMGetDlgCode(var Message: TMessage);
  2807. begin
  2808.   inherited;
  2809.   Message.Result := DLGC_BUTTON or DLGC_WANTALLKEYS or DLGC_WANTARROWS
  2810.     or DLGC_WANTCHARS;
  2811. end;
  2812.  
  2813. procedure TRxDBLookupCombo.WMKillFocus(var Message: TWMKillFocus);
  2814. begin
  2815.   inherited;
  2816.   CloseUp(False);
  2817. end;
  2818.  
  2819. procedure TRxDBLookupCombo.WMSetCursor(var Message: TWMSetCursor);
  2820. var
  2821.   P: TPoint;
  2822. begin
  2823.   GetCursorPos(P);
  2824.   with ClientRect do
  2825.     if PtInRect(Bounds(Right - FButtonWidth, Top, FButtonWidth, Bottom - Top),
  2826.       ScreenToClient(P)) then
  2827. {$IFDEF WIN32}
  2828.       Windows.SetCursor(LoadCursor(0, IDC_ARROW))
  2829. {$ELSE}
  2830.       WinProcs.SetCursor(LoadCursor(0, IDC_ARROW))
  2831. {$ENDIF}
  2832.     else inherited;
  2833. end;
  2834.  
  2835. procedure TRxDBLookupCombo.WMSize(var Message: TWMSize);
  2836. begin
  2837.   inherited;
  2838.   if not (csReading in ComponentState) and (Height < GetMinHeight) then
  2839.     Height := GetMinHeight
  2840.   else begin
  2841.     if (csDesigning in ComponentState) then
  2842.       FDataList.SetBounds(0, Height + 1, 10, 10);
  2843.   end;
  2844. end;
  2845.  
  2846. {$IFDEF RX_D4}
  2847. procedure TRxDBLookupCombo.CMBiDiModeChanged(var Message: TMessage);
  2848. begin
  2849.   inherited;
  2850.   FDataList.BiDiMode := BiDiMode;
  2851. end;
  2852. {$ENDIF}
  2853.  
  2854. { TPopupDataWindow }
  2855.  
  2856. constructor TPopupDataWindow.Create(AOwner: TComponent);
  2857. begin
  2858.   inherited Create(AOwner);
  2859.   FEditor := TWinControl(AOwner);
  2860.   Visible := False;
  2861.   Parent := FEditor;
  2862.   OnMouseUp := PopupMouseUp;
  2863. end;
  2864.  
  2865. procedure TPopupDataWindow.InvalidateEditor;
  2866. var
  2867.   R: TRect;
  2868. begin
  2869.   if (FEditor is TCustomComboEdit) then begin
  2870.     with TComboEdit(FEditor) do
  2871.       SetRect(R, 0, 0, ClientWidth - Button.Width - 2, ClientHeight + 1);
  2872.   end
  2873.   else R := FEditor.ClientRect;
  2874.   InvalidateRect(FEditor.Handle, @R, False);
  2875.   UpdateWindow(FEditor.Handle);
  2876. end;
  2877.  
  2878. procedure TPopupDataWindow.Click;
  2879. begin
  2880.   inherited Click;
  2881.   if Value <> '' then
  2882.     with TRxLookupEdit(FEditor) do begin
  2883.       if not (FChanging or ReadOnly) then begin
  2884.         FChanging := True;
  2885.         try
  2886.           Text := Self.DisplayValue;
  2887.           if AutoSelect then SelectAll;
  2888.         finally
  2889.           FChanging := False;
  2890.         end;
  2891.       end;
  2892.     end;
  2893.   InvalidateEditor;
  2894. end;
  2895.  
  2896. procedure TPopupDataWindow.DisplayValueChanged;
  2897. begin
  2898.   if not FLockPosition then
  2899.     if FListActive then begin
  2900.       if LocateDisplay then
  2901.         FValue := FKeyField.AsString
  2902.       else begin
  2903.         FLookupLink.DataSet.First;
  2904.         FValue := EmptyValue;
  2905.       end;
  2906.     end
  2907.     else FValue := FEmptyValue;
  2908. end;
  2909.  
  2910. procedure TPopupDataWindow.KeyPress(var Key: Char);
  2911. begin
  2912.   inherited KeyPress(Key);
  2913.   InvalidateEditor;
  2914. end;
  2915.  
  2916. procedure TPopupDataWindow.PopupMouseUp(Sender: TObject; Button: TMouseButton;
  2917.   Shift: TShiftState; X, Y: Integer);
  2918. begin
  2919.   if Button = mbLeft then CloseUp(PtInRect(Self.ClientRect, Point(X, Y)));
  2920. end;
  2921.  
  2922. procedure TPopupDataWindow.CloseUp(Accept: Boolean);
  2923. begin
  2924.   if Assigned(FCloseUp) then FCloseUp(Self, Accept);
  2925. end;
  2926.  
  2927. function TPopupDataWindow.GetPicture(Current, Empty: Boolean;
  2928.   var TextMargin: Integer): TGraphic;
  2929. begin
  2930.   TextMargin := 0;
  2931.   Result := nil;
  2932.   if Assigned(FOnGetImage) then FOnGetImage(FEditor, Empty, Result, TextMargin);
  2933. end;
  2934.  
  2935. procedure TPopupDataWindow.Hide;
  2936. begin
  2937.   SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
  2938.     SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  2939.   Visible := False;
  2940. end;
  2941.  
  2942. procedure TPopupDataWindow.Show(Origin: TPoint);
  2943. begin
  2944.   SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
  2945.     SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
  2946.   Visible := True;
  2947. end;
  2948.  
  2949. { TRxLookupEdit }
  2950.  
  2951. constructor TRxLookupEdit.Create(AOwner: TComponent);
  2952. begin
  2953.   inherited Create(AOwner);
  2954.   FDropDownCount := 8;
  2955.   FPopupOnlyLocate := True;
  2956.   ControlState := ControlState + [csCreating];
  2957.   try
  2958.     FPopup := TPopupDataWindow.Create(Self);
  2959.     TPopupDataWindow(FPopup).OnCloseUp := PopupCloseUp;
  2960.     GlyphKind := gkDropDown; { force update }
  2961.   finally
  2962.     ControlState := ControlState - [csCreating];
  2963.   end;
  2964. end;
  2965.  
  2966. destructor TRxLookupEdit.Destroy;
  2967. begin
  2968.   if FPopup <> nil then
  2969.     with TPopupDataWindow(FPopup) do begin
  2970.       OnCloseUp := nil;
  2971.       OnGetImage := nil;
  2972.     end;
  2973.   FPopup.Free;
  2974.   FPopup := nil;
  2975.   inherited Destroy;
  2976. end;
  2977.  
  2978. procedure TRxLookupEdit.SetDropDownCount(Value: Integer);
  2979. begin
  2980.   if Value < 1 then Value := 1;
  2981.   if Value > 50 then Value := 50;
  2982.   FDropDownCount := Value;
  2983. end;
  2984.  
  2985. function TRxLookupEdit.GetListStyle: TLookupListStyle;
  2986. begin
  2987.   Result := TPopupDataWindow(FPopup).ListStyle;
  2988. end;
  2989.  
  2990. procedure TRxLookupEdit.SetListStyle(Value: TLookupListStyle);
  2991. begin
  2992.   TPopupDataWindow(FPopup).ListStyle := Value;
  2993. end;
  2994.  
  2995. function TRxLookupEdit.GetFieldsDelim: Char;
  2996. begin
  2997.   Result := TPopupDataWindow(FPopup).FieldsDelimiter;
  2998. end;
  2999.  
  3000. procedure TRxLookupEdit.SetFieldsDelim(Value: Char);
  3001. begin
  3002.   TPopupDataWindow(FPopup).FieldsDelimiter := Value;
  3003. end;
  3004.  
  3005. function TRxLookupEdit.GetLookupDisplay: string;
  3006. begin
  3007.   Result := TPopupDataWindow(FPopup).LookupDisplay;
  3008. end;
  3009.  
  3010. procedure TRxLookupEdit.SetLookupDisplay(const Value: string);
  3011. begin
  3012.   TPopupDataWindow(FPopup).LookupDisplay := Value;
  3013. end;
  3014.  
  3015. function TRxLookupEdit.GetDisplayIndex: Integer;
  3016. begin
  3017.   Result := TPopupDataWindow(FPopup).LookupDisplayIndex;
  3018. end;
  3019.  
  3020. procedure TRxLookupEdit.SetDisplayIndex(Value: Integer);
  3021. begin
  3022.   TPopupDataWindow(FPopup).LookupDisplayIndex := Value;
  3023. end;
  3024.  
  3025. function TRxLookupEdit.GetLookupField: string;
  3026. begin
  3027.   Result := TPopupDataWindow(FPopup).LookupField;
  3028. end;
  3029.  
  3030. procedure TRxLookupEdit.SetLookupField(const Value: string);
  3031. begin
  3032.   TPopupDataWindow(FPopup).LookupField := Value;
  3033. end;
  3034.  
  3035. function TRxLookupEdit.GetLookupSource: TDataSource;
  3036. begin
  3037.   Result := TPopupDataWindow(FPopup).LookupSource;
  3038. end;
  3039.  
  3040. procedure TRxLookupEdit.SetLookupSource(Value: TDataSource);
  3041. begin
  3042.   TPopupDataWindow(FPopup).LookupSource := Value;
  3043. end;
  3044.  
  3045. function TRxLookupEdit.GetOnGetImage: TGetImageEvent;
  3046. begin
  3047.   Result := TPopupDataWindow(FPopup).OnGetImage;
  3048. end;
  3049.  
  3050. procedure TRxLookupEdit.SetOnGetImage(Value: TGetImageEvent);
  3051. begin
  3052.   TPopupDataWindow(FPopup).OnGetImage := Value;
  3053. end;
  3054.  
  3055. function TRxLookupEdit.GetLookupValue: string;
  3056. begin
  3057.   TPopupDataWindow(FPopup).DisplayValue := Text;
  3058.   Result := TPopupDataWindow(FPopup).Value;
  3059. end;
  3060.  
  3061. procedure TRxLookupEdit.SetLookupValue(const Value: string);
  3062. begin
  3063.   TPopupDataWindow(FPopup).Value := Value;
  3064.   Text := TPopupDataWindow(FPopup).DisplayValue;
  3065. end;
  3066.  
  3067. procedure TRxLookupEdit.ShowPopup(Origin: TPoint);
  3068. begin
  3069.   TPopupDataWindow(FPopup).Show(Origin);
  3070. end;
  3071.  
  3072. procedure TRxLookupEdit.HidePopup;
  3073. begin
  3074.   TPopupDataWindow(FPopup).Hide;
  3075. end;
  3076.  
  3077. procedure TRxLookupEdit.PopupDropDown(DisableEdit: Boolean);
  3078. begin
  3079.   if not (ReadOnly or PopupVisible) then begin
  3080.     if Assigned(FOnDropDown) then FOnDropDown(Self);
  3081.     with TPopupDataWindow(FPopup) do begin
  3082.       Color := Self.Color;
  3083.       Font := Self.Font;
  3084.       if FDropDownWidth > 0 then
  3085.         Width := FDropDownWidth
  3086.       else if FDropDownWidth < 0 then
  3087.         Width := Max(Self.Width, GetWindowWidth)
  3088.       else Width := Self.Width;
  3089.       ReadOnly := Self.ReadOnly;
  3090.       RowCount := FDropDownCount;
  3091.     end;
  3092.   end;
  3093.   inherited PopupDropDown(False);
  3094. end;
  3095.  
  3096. procedure TRxLookupEdit.KeyDown(var Key: Word; Shift: TShiftState);
  3097. begin
  3098.   if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) and
  3099.     PopupVisible then
  3100.   begin
  3101.     TPopupDataWindow(FPopup).KeyDown(Key, Shift);
  3102.     Key := 0;
  3103.   end;
  3104.   inherited KeyDown(Key, Shift);
  3105.   FIgnoreChange := (SelLength > 0) or (Key = VK_BACK);
  3106.   if not (PopupVisible or ReadOnly) and (Key in [VK_UP, VK_DOWN]) and
  3107.     (Shift = []) then
  3108.   begin
  3109.     with TPopupDataWindow(FPopup) do begin
  3110.       KeyDown(Key, Shift);
  3111.       if Value <> EmptyValue then Key := 0;
  3112.     end;
  3113.   end;
  3114. end;
  3115.  
  3116. procedure TRxLookupEdit.KeyPress(var Key: Char);
  3117. begin
  3118.   inherited KeyPress(Key);
  3119.   FIgnoreChange := (SelLength > 0) or (Key = Char(VK_BACK));
  3120. end;
  3121.  
  3122. procedure TRxLookupEdit.Change;
  3123. begin
  3124.   if PopupOnlyLocate or PopupVisible then
  3125.     inherited Change
  3126.   else begin
  3127.     PopupChange;
  3128.     DoChange;
  3129.   end;
  3130. end;
  3131.  
  3132. procedure TRxLookupEdit.PopupChange;
  3133. var
  3134.   S: string;
  3135.   Len: Integer;
  3136. begin
  3137.   if FChanging or FIgnoreChange or ReadOnly then begin
  3138.     FIgnoreChange := False;
  3139.     Exit;
  3140.   end;
  3141.   FChanging := True;
  3142.   try
  3143.     S := Text;
  3144.     if TPopupDataWindow(FPopup).SearchText(S) then begin
  3145.       Len := Length(Text);
  3146.       Text := TPopupDataWindow(FPopup).DisplayValue;
  3147.       SelStart := Len;
  3148.       SelLength := Length(Text) - Len;
  3149.     end
  3150.     else with TPopupDataWindow(FPopup) do Value := EmptyValue;
  3151.   finally
  3152.     FChanging := False;
  3153.   end;
  3154. end;
  3155.  
  3156. {$IFDEF WIN32}
  3157. procedure TRxLookupEdit.SetPopupValue(const Value: Variant);
  3158. {$ELSE}
  3159. procedure TRxLookupEdit.SetPopupValue(const Value: string);
  3160. {$ENDIF}
  3161. begin
  3162. {$IFDEF WIN32}
  3163.   if VarIsNull(Value) or VarIsEmpty(Value) then
  3164.     TPopupDataWindow(FPopup).Value := TPopupDataWindow(FPopup).EmptyValue
  3165.   else
  3166. {$ENDIF}
  3167.     TPopupDataWindow(FPopup).DisplayValue := Value;
  3168. end;
  3169.  
  3170. {$IFDEF WIN32}
  3171. function TRxLookupEdit.GetPopupValue: Variant;
  3172. {$ELSE}
  3173. function TRxLookupEdit.GetPopupValue: string;
  3174. {$ENDIF}
  3175. begin
  3176.   with TPopupDataWindow(FPopup) do
  3177.     if Value <> EmptyValue then Result := DisplayValue
  3178.     else Result := Self.Text;
  3179. end;
  3180.  
  3181. {$IFDEF WIN32}
  3182. function TRxLookupEdit.AcceptPopup(var Value: Variant): Boolean;
  3183. {$ELSE}
  3184. function TRxLookupEdit.AcceptPopup(var Value: string): Boolean;
  3185. {$ENDIF}
  3186. begin
  3187.   Result := True;
  3188.   if Assigned(FOnCloseUp) then FOnCloseUp(Self);
  3189. end;
  3190.  
  3191. end.