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