1907 lines
52 KiB
ObjectPascal
1907 lines
52 KiB
ObjectPascal
{ rxlookup unit
|
|
|
|
Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
|
|
original conception from rx library for Delphi (c)
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version with the following modification:
|
|
|
|
As a special exception, the copyright holders of this library give you
|
|
permission to link this library with independent modules to produce an
|
|
executable, regardless of the license terms of these independent modules,and
|
|
to copy and distribute the resulting executable under terms of your choice,
|
|
provided that you also meet, for each linked independent module, the terms
|
|
and conditions of the license of that module. An independent module is a
|
|
module which is not derived from or based on this library. If you modify
|
|
this library, you may extend this exception to your version of the library,
|
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
|
exception statement from your version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
}
|
|
|
|
unit rxlookup;
|
|
|
|
{$I rx.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLType, LCLProc, LCLIntf, Classes, SysUtils, LResources, Forms, types,
|
|
Controls, Graphics, Dialogs, DB, EditBtn, DBGrids, Buttons,
|
|
LMessages, DbCtrls, GraphType, rxdbutils, RxDbGrid, rxpopupunit, Themes;
|
|
|
|
const
|
|
TextMargin = 5;
|
|
|
|
type
|
|
TRxCustomDBLookupCombo = class;
|
|
TRxCustomDBLookupEdit = class;
|
|
|
|
TClosePopup = procedure(Sender: TObject; SearchResult:boolean) of object;
|
|
|
|
{For deciding, what we need to show in combobox in case we cannot find curvalue in lookup table.}
|
|
TRxDBValueVariant = (rxufNone, rxufLastSuccessful, rxufOriginal);
|
|
TRxDBLookupStyle = (rxcsDropDown, rxcsDropDownList);
|
|
|
|
{ TLookupSourceLink }
|
|
TDataSourceLink = class(TDataLink)
|
|
private
|
|
FDataControl:TRxCustomDBLookupCombo;
|
|
protected
|
|
procedure ActiveChanged; override;
|
|
procedure LayoutChanged; override;
|
|
procedure FocusControl(Field: TFieldRef); override;
|
|
procedure RecordChanged(Field: TField); override;
|
|
procedure UpdateData; override;
|
|
end;
|
|
|
|
{ TLookupSourceLink }
|
|
|
|
TLookupSourceLink = class(TDataLink)
|
|
private
|
|
FOnActiveChanged:TNotifyEvent;
|
|
FOnLayoutChanged:TNotifyEvent;
|
|
FOnDataSetChanged:TNotifyEvent;
|
|
protected
|
|
procedure ActiveChanged; override;
|
|
procedure LayoutChanged; override;
|
|
procedure DataSetChanged; override;
|
|
end;
|
|
|
|
{ TRxCustomDBLookupEdit }
|
|
|
|
TRxCustomDBLookupEdit = class(TEditButton)
|
|
private
|
|
FLookupDisplayIndex: Integer;
|
|
FLookupField: string;
|
|
FLookupDisplay: string;
|
|
FKeyField:TField;
|
|
//
|
|
FLookupDataLink:TLookupSourceLink;
|
|
FLocateObject:TLocateObject;
|
|
FOnClosePopup: TClosePopup;
|
|
//
|
|
FRxPopUpForm:TPopUpForm;
|
|
|
|
FFieldList:TStringList;
|
|
FPopUpFormOptions:TPopUpFormOptions;
|
|
function GetDropDownCount: Integer;
|
|
function GetDropDownWidth: Integer;
|
|
function GetLookupSource: TDataSource;
|
|
function GetPopupVisible: boolean;
|
|
procedure SetDropDownCount(const AValue: Integer);
|
|
procedure SetDropDownWidth(const AValue: Integer);
|
|
procedure SetLookupDisplay(const AValue: string);
|
|
procedure SetLookupDisplayIndex(const AValue: Integer);
|
|
procedure SetLookupField(const AValue: string);
|
|
procedure SetLookupSource(AValue: TDataSource);
|
|
procedure SetPopUpFormOptions(const AValue: TPopUpFormOptions);
|
|
//
|
|
procedure ShowList;
|
|
procedure HideList;
|
|
procedure ShowPopUp;
|
|
procedure UpdateKeyValue;
|
|
protected
|
|
property PopUpFormOptions:TPopUpFormOptions read FPopUpFormOptions write SetPopUpFormOptions;
|
|
procedure ButtonClick; override;
|
|
function GetDefaultGlyphName: String; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure EditKeyDown(var Key: word; Shift: TShiftState); override;
|
|
procedure InternalClosePopup(AResult:boolean);virtual;
|
|
//
|
|
procedure LookupDataSetChanged(Sender: TObject); virtual;
|
|
procedure ListLinkActiveChanged(Sender: TObject); virtual;
|
|
//
|
|
property OnClosePopup:TClosePopup read FOnClosePopup write FOnClosePopup;
|
|
property DropDownCount: Integer read GetDropDownCount write SetDropDownCount default 8;
|
|
property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth default 0;
|
|
property LookupDisplay: string read FLookupDisplay write SetLookupDisplay;
|
|
property LookupDisplayIndex: Integer read FLookupDisplayIndex write SetLookupDisplayIndex default 0;
|
|
property LookupField: string read FLookupField write SetLookupField;
|
|
property LookupSource: TDataSource read GetLookupSource write SetLookupSource;
|
|
property PopupVisible:boolean read GetPopupVisible;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Spacing default 0;
|
|
end;
|
|
|
|
TRxLookupEdit = class(TRxCustomDBLookupEdit)
|
|
published
|
|
property DropDownCount;
|
|
property DropDownWidth;
|
|
property LookupDisplay;
|
|
property LookupDisplayIndex;
|
|
property LookupField;
|
|
property LookupSource;
|
|
property PopUpFormOptions;
|
|
property OnClosePopup;
|
|
end;
|
|
|
|
{ TRxCustomDBLookupCombo }
|
|
TRxCustomDBLookupCombo = class (TCustomControl)
|
|
private
|
|
FOnChangeData: TNotifyEvent;
|
|
//
|
|
FStopClick:boolean;
|
|
FMouseDown:boolean;
|
|
//FDataLink:TFieldDataLink;
|
|
FDataLink:TDataSourceLink;
|
|
FDataFieldName: string;
|
|
FDataField :TField;
|
|
//
|
|
FLookupDataLink:TLookupSourceLink;
|
|
FLocateObject:TLocateObject;
|
|
FLookupField: string;
|
|
FLookupDisplay: string;
|
|
FDisplayField:TField;
|
|
FKeyField:TField;
|
|
FLookupDisplayIndex: Integer;
|
|
FListActive:boolean;
|
|
//
|
|
FEmptyItemColor: TColor;
|
|
FEmptyValue: string;
|
|
FOnChange: TNotifyEvent;
|
|
FOnClosePopup: TClosePopup;
|
|
FPopUpFormOptions: TPopUpFormOptions;
|
|
//
|
|
FRxPopUpForm:TPopUpForm;
|
|
FFieldList:TStringList;
|
|
FStyle: TRxDBLookupStyle;
|
|
FValuesList:TStringList;
|
|
FValue:string;
|
|
//Visual
|
|
FButton: TSpeedButton;
|
|
FButtonNeedsFocus: Boolean;
|
|
FDirectInput : Boolean;
|
|
FOnButtonClick : TNotifyEvent;
|
|
FReadOnly: boolean;
|
|
FDisplayAll: boolean;
|
|
FUnfindedValue: TRxDBValueVariant;
|
|
FSuccesfullyFind : boolean;
|
|
|
|
FOnSelect : TNotifyEvent;
|
|
procedure SetStyle(AValue: TRxDBLookupStyle);
|
|
procedure SetValue(const Value: string);
|
|
function GetKeyValue: Variant;
|
|
procedure SetKeyValue(const Value: Variant);
|
|
|
|
function GetDataSource: TDataSource;
|
|
function GetDisplayAll: Boolean;
|
|
function GetDropDownCount: Integer;
|
|
function GetDropDownWidth: Integer;
|
|
function GetLookupSource: TDataSource;
|
|
function GetMinHeight: Integer;
|
|
function GetBorderSize: Integer;
|
|
procedure CheckButtonVisible;
|
|
function GetButtonWidth: Integer;
|
|
function GetFlat: Boolean;
|
|
function GetGlyph: TBitmap;
|
|
function GetNumGlyphs: Integer;
|
|
function GetOnGetGridCellProps: TGetCellPropsEvent;
|
|
function GetPopupVisible: boolean;
|
|
procedure SetButtonNeedsFocus(const AValue: Boolean);
|
|
procedure SetButtonWidth(const AValue: Integer);
|
|
procedure SetDataFieldName(const AValue: string);
|
|
procedure SetDataSource(const AValue: TDataSource);
|
|
procedure SetDisplayAll(const AValue: Boolean);
|
|
procedure SetDropDownCount(const AValue: Integer);
|
|
procedure SetDropDownWidth(const AValue: Integer);
|
|
procedure SetEmptyItemColor(const AValue: TColor);
|
|
procedure SetEmptyValue(const AValue: string);
|
|
procedure SetFlat(const AValue: Boolean);
|
|
procedure SetGlyph(const AValue: TBitmap);
|
|
procedure SetLookupDisplay(const AValue: string);
|
|
procedure SetLookupDisplayIndex(const AValue: Integer);
|
|
procedure SetLookupField(const AValue: string);
|
|
procedure SetLookupSource(const AValue: TDataSource);
|
|
procedure SetNumGlyphs(const AValue: Integer);
|
|
procedure SetOnGetGridCellProps(const AValue: TGetCellPropsEvent);
|
|
procedure SetPopUpFormOptions(const AValue: TPopUpFormOptions);
|
|
procedure SetReadOnly(const AValue: boolean);
|
|
function StoreEmpty: boolean;
|
|
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
|
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
|
procedure CMExit(var Message:TLMessage); message CM_EXIT;
|
|
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
|
procedure PaintDisplayValues(ACanvas: TCanvas; R: TRect; ALeft: Integer; AThemedDetails : PThemedElementDetails);
|
|
procedure CheckNotCircular;
|
|
procedure DisplayValueChanged;
|
|
procedure DataLinkActiveChanged;
|
|
procedure DataLinkRecordChanged(Field: TField);
|
|
procedure UpdateFieldValues;
|
|
procedure SetValueKey(const Value: string);
|
|
procedure UpdateKeyValue;
|
|
procedure KeyValueChanged;
|
|
procedure UpdateData;
|
|
procedure NeedUpdateData;
|
|
protected
|
|
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
|
|
WithThemeSpace: Boolean); override;
|
|
{procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
|
|
Raw: boolean = false;
|
|
WithThemeSpace: boolean = true); override;
|
|
class function GetControlClassDefaultSize: TSize; override;}
|
|
procedure ShowList; virtual;
|
|
procedure OnInternalClosePopup(AResult:boolean);virtual;
|
|
procedure SetEnabled(Value: Boolean); override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
|
|
procedure SetParent(AParent: TWinControl); override;
|
|
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
|
procedure DoPositionButton; virtual;
|
|
procedure DoChange; virtual;
|
|
procedure DoChangeData; virtual;
|
|
procedure DoSelect; virtual;
|
|
procedure DoButtonClick(Sender: TObject); virtual;
|
|
Procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED;
|
|
procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
|
|
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
|
procedure Resize; override;
|
|
|
|
procedure Click; override;
|
|
function RealGetText: TCaption; override;
|
|
procedure RealSetText(const Value: TCaption); override;
|
|
|
|
procedure SetBorderStyle(NewStyle: TBorderStyle); override;
|
|
procedure Paint; override;
|
|
|
|
procedure LookupDataSetChanged(Sender: TObject); virtual;
|
|
procedure ListLinkActiveChanged(Sender: TObject); virtual;
|
|
|
|
//
|
|
property Button: TSpeedButton read FButton;
|
|
property ButtonWidth : Integer read GetButtonWidth write SetButtonWidth;
|
|
property ButtonOnlyWhenFocused : Boolean Read FButtonNeedsFocus Write SetButtonNeedsFocus;
|
|
property DirectInput : Boolean read FDirectInput write FDirectInput Default True;
|
|
property DisplayAllFields: Boolean read GetDisplayAll write SetDisplayAll default False;
|
|
property Flat : Boolean read GetFlat write SetFlat;
|
|
property Glyph : TBitmap read GetGlyph write SetGlyph;
|
|
property NumGlyphs : Integer read GetNumGlyphs write SetNumGlyphs;
|
|
property OnButtonClick : TNotifyEvent read FOnButtonClick write FOnButtonClick;
|
|
property OnChange : TNotifyEvent read FOnChange write FOnChange;
|
|
property OnChangeData : TNotifyEvent read FOnChangeData write FOnChangeData;
|
|
property ReadOnly:boolean read FReadOnly write SetReadOnly;
|
|
property EmptyValue: string read FEmptyValue write SetEmptyValue stored StoreEmpty;
|
|
property EmptyItemColor: TColor read FEmptyItemColor write SetEmptyItemColor default clWindow;
|
|
//data
|
|
property PopUpFormOptions:TPopUpFormOptions read FPopUpFormOptions write SetPopUpFormOptions;
|
|
property DataField: string read FDataFieldName write SetDataFieldName;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
property DropDownCount: Integer read GetDropDownCount write SetDropDownCount default 8;
|
|
property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth default 0;
|
|
property LookupDisplay: string read FLookupDisplay write SetLookupDisplay;
|
|
property LookupDisplayIndex: Integer read FLookupDisplayIndex write SetLookupDisplayIndex default 0;
|
|
property LookupField: string read FLookupField write SetLookupField;
|
|
property LookupSource: TDataSource read GetLookupSource write SetLookupSource;
|
|
property OnGetGridCellProps: TGetCellPropsEvent read GetOnGetGridCellProps
|
|
write SetOnGetGridCellProps;
|
|
|
|
property Value: string read FValue write SetValue stored False;
|
|
property KeyValue: Variant read GetKeyValue write SetKeyValue stored False;
|
|
property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
|
|
property OnClosePopup:TClosePopup read FOnClosePopup write FOnClosePopup;
|
|
|
|
property UnfindedValue : TRxDBValueVariant read FUnfindedValue write FUnfindedValue default rxufNone;
|
|
property Style:TRxDBLookupStyle read FStyle write SetStyle default rxcsDropDown;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Clear;
|
|
function IsEmpty : Boolean;
|
|
|
|
property PopupVisible:boolean read GetPopupVisible;
|
|
end;
|
|
|
|
{ TRxDBLookupCombo }
|
|
TRxDBLookupCombo = class(TRxCustomDBLookupCombo)
|
|
protected
|
|
procedure OnInternalClosePopup(AResult:boolean);override;
|
|
public
|
|
property Value;
|
|
property KeyValue;
|
|
property Text;
|
|
published
|
|
property AutoSize;
|
|
property Align;
|
|
property Anchors;
|
|
property BorderStyle default bsNone;
|
|
property BorderSpacing;
|
|
property ButtonOnlyWhenFocused;
|
|
Property ButtonWidth;
|
|
property Color;
|
|
property DataField;
|
|
property DataSource;
|
|
Property DirectInput;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property PopUpFormOptions;
|
|
Property Flat;
|
|
property Font;
|
|
property Glyph;
|
|
property EmptyValue;
|
|
property EmptyItemColor;
|
|
property Style;
|
|
|
|
// property MaxLength;
|
|
property NumGlyphs;
|
|
Property OnButtonClick;
|
|
property OnChange;
|
|
property OnChangeData;
|
|
property OnClick;
|
|
property OnClosePopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDrag;
|
|
property OnGetGridCellProps;
|
|
property OnSelect;
|
|
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
{ property Width default 100;
|
|
property Height default 23;}
|
|
|
|
property DisplayAllFields;
|
|
property DropDownCount;
|
|
property DropDownWidth;
|
|
property LookupDisplay;
|
|
property LookupDisplayIndex;
|
|
property LookupField;
|
|
property LookupSource;
|
|
property UnfindedValue;
|
|
end;
|
|
|
|
implementation
|
|
uses rxlclutils, Math, rxdconst, LCLVersion;
|
|
|
|
type
|
|
{ TDbGridAccess = class(TDbGrid)
|
|
end;}
|
|
|
|
TPopUpFormAccess = class(TPopUpForm)
|
|
end;
|
|
|
|
|
|
{ TRxCustomDBLookupEdit }
|
|
|
|
function TRxCustomDBLookupEdit.GetLookupSource: TDataSource;
|
|
begin
|
|
Result:=FLookupDataLink.DataSource;
|
|
end;
|
|
|
|
function TRxCustomDBLookupEdit.GetPopupVisible: boolean;
|
|
begin
|
|
Result:=Assigned(FRxPopUpForm);
|
|
end;
|
|
|
|
function TRxCustomDBLookupEdit.GetDropDownCount: Integer;
|
|
begin
|
|
Result:=FPopUpFormOptions.DropDownCount;
|
|
end;
|
|
|
|
function TRxCustomDBLookupEdit.GetDropDownWidth: Integer;
|
|
begin
|
|
Result:=FPopUpFormOptions.DropDownWidth;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetDropDownCount(const AValue: Integer);
|
|
begin
|
|
FPopUpFormOptions.DropDownCount:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetDropDownWidth(const AValue: Integer);
|
|
begin
|
|
FPopUpFormOptions.DropDownWidth:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetLookupDisplay(const AValue: string);
|
|
var
|
|
S1, S2:string;
|
|
K:integer;
|
|
begin
|
|
if FLookupDisplay=AValue then exit;
|
|
FLookupDisplay:=AValue;
|
|
FFieldList.Clear;
|
|
S2:=AValue;
|
|
while S2<>'' do
|
|
begin
|
|
K:=Pos(';', S2);
|
|
if K>0 then
|
|
begin
|
|
S1:=Copy(S2, 1, K-1);
|
|
Delete(S2, 1, K);
|
|
end
|
|
else
|
|
begin
|
|
S1:=S2;
|
|
S2:='';
|
|
end;
|
|
FFieldList.Add(S1);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetLookupDisplayIndex(const AValue: Integer);
|
|
begin
|
|
if FLookupDisplayIndex=AValue then exit;
|
|
FLookupDisplayIndex:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetLookupField(const AValue: string);
|
|
begin
|
|
if FLookupField = AValue then exit;
|
|
FLookupField:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetLookupSource(AValue: TDataSource);
|
|
begin
|
|
FLookupDataLink.DataSource:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.SetPopUpFormOptions(
|
|
const AValue: TPopUpFormOptions);
|
|
begin
|
|
FPopUpFormOptions.Assign(AValue);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.ShowList;
|
|
begin
|
|
if FLookupDataLink.Active and not PopupVisible then
|
|
ShowPopUp;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.HideList;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.ShowPopUp;
|
|
var
|
|
AValue:string;
|
|
ALookupField:string;
|
|
begin
|
|
if FLookupDataLink.Active then
|
|
if not PopupVisible then
|
|
begin
|
|
ALookupField := FFieldList[FLookupDisplayIndex];
|
|
AValue := Text;
|
|
|
|
FLocateObject.Locate(ALookupField, AValue, true, false);
|
|
|
|
FRxPopUpForm:=ShowRxDBPopUpForm(Self, FLookupDataLink.DataSet, @InternalClosePopup,
|
|
FPopUpFormOptions, FLookupDisplay, LookupDisplayIndex, 0, Font);
|
|
end
|
|
end;
|
|
|
|
|
|
procedure TRxCustomDBLookupEdit.UpdateKeyValue;
|
|
var
|
|
S:string;
|
|
begin
|
|
S:=FFieldList[FLookupDisplayIndex];
|
|
if FLookupDataLink.Active then
|
|
Text:=FLookupDataLink.DataSet.FieldByName(S).AsString;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.ButtonClick;
|
|
begin
|
|
inherited ButtonClick;
|
|
if PopupVisible then
|
|
HideList
|
|
else
|
|
ShowList;
|
|
end;
|
|
|
|
function TRxCustomDBLookupEdit.GetDefaultGlyphName: String;
|
|
begin
|
|
Result:='rxbtn_downarrow';
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_RETURN]) and PopupVisible then
|
|
begin
|
|
{ if Key=VK_RETURN then HideList
|
|
else
|
|
TDbGridAccess(Flist).KeyDown(Key, Shift);
|
|
Key := 0;}
|
|
end
|
|
else
|
|
if (Key = VK_DOWN) and ((ssAlt in Shift) or (ssCtrl in Shift)) then
|
|
begin
|
|
ShowList;
|
|
Key := 0;
|
|
end;
|
|
inherited KeyDown(Key, Shift);
|
|
{ FIgnoreChange := (SelLength > 0) or (Key = VK_BACK);}
|
|
if not (PopupVisible or ReadOnly) and (Key in [VK_UP, VK_DOWN]) and (Shift = []) then
|
|
begin
|
|
case Key of
|
|
VK_UP: if not FLookupDataLink.DataSet.BOF then FLookupDataLink.DataSet.Prior;
|
|
VK_DOWN: if not FLookupDataLink.DataSet.EOF then FLookupDataLink.DataSet.Next;
|
|
end;
|
|
Text:=FLookupDataLink.DataSet.FieldByName(FFieldList[FLookupDisplayIndex]).AsString;
|
|
Key:=0;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.EditKeyDown(var Key: word; Shift: TShiftState);
|
|
begin
|
|
if (Key = VK_DOWN) and ((ssAlt in Shift) or (ssCtrl in Shift)) then
|
|
begin
|
|
ShowList;
|
|
Key := 0;
|
|
end
|
|
else
|
|
inherited EditKeyDown(Key, Shift);
|
|
if not (PopupVisible or ReadOnly) and (Key in [VK_UP, VK_DOWN]) and (Shift = []) then
|
|
begin
|
|
case Key of
|
|
VK_UP: if not FLookupDataLink.DataSet.BOF then FLookupDataLink.DataSet.Prior;
|
|
VK_DOWN: if not FLookupDataLink.DataSet.EOF then FLookupDataLink.DataSet.Next;
|
|
end;
|
|
Text:=FLookupDataLink.DataSet.FieldByName(FFieldList[FLookupDisplayIndex]).AsString;
|
|
Key:=0;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.InternalClosePopup(AResult: boolean);
|
|
begin
|
|
if Assigned(FOnClosePopup) then
|
|
FOnClosePopup(Self, AResult);
|
|
|
|
FRxPopUpForm:=nil;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.LookupDataSetChanged(Sender: TObject);
|
|
begin
|
|
if PopupVisible then
|
|
begin
|
|
UpdateKeyValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupEdit.ListLinkActiveChanged(Sender: TObject);
|
|
var
|
|
DataSet: TDataSet;
|
|
begin
|
|
FKeyField := nil;
|
|
DataSet:=nil;
|
|
if FLookupDataLink.Active and (FLookupField <> '') then
|
|
begin
|
|
DataSet := FLookupDataLink.DataSet;
|
|
FKeyField := DataSet.FieldByName(FLookupField);
|
|
end;
|
|
FLocateObject.DataSet := DataSet;
|
|
|
|
UpdateKeyValue
|
|
end;
|
|
|
|
constructor TRxCustomDBLookupEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Spacing:=0;
|
|
FLocateObject:=CreateLocate(nil);
|
|
|
|
//Lookup
|
|
FLookupDataLink:=TLookupSourceLink.Create;
|
|
FLookupDataLink.FOnActiveChanged:=@ListLinkActiveChanged;
|
|
FLookupDataLink.FOnLayoutChanged:=@ListLinkActiveChanged;
|
|
FLookupDataLink.FOnDataSetChanged:=@LookupDataSetChanged;
|
|
|
|
FFieldList:=TStringList.Create;
|
|
ButtonWidth:=15;
|
|
FPopUpFormOptions:=TPopUpFormOptions.Create(Self);
|
|
end;
|
|
|
|
destructor TRxCustomDBLookupEdit.Destroy;
|
|
begin
|
|
FreeAndNil(FLocateObject);
|
|
FreeAndNil(FPopUpFormOptions);
|
|
FFieldList.Clear;
|
|
FreeAndNil(FFieldList);
|
|
FreeAndNil(FLookupDataLink);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
{ TRxCustomDBLookupCombo }
|
|
|
|
function TRxCustomDBLookupCombo.GetMinHeight: Integer;
|
|
begin
|
|
Result := 15{DefaultTextHeight} + GetBorderSize + 3;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetDisplayAll: Boolean;
|
|
begin
|
|
Result := FDisplayAll;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetDropDownCount: Integer;
|
|
begin
|
|
Result:=FPopUpFormOptions.DropDownCount
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetDropDownWidth: Integer;
|
|
begin
|
|
Result:=FPopUpFormOptions.DropDownWidth;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetLookupSource: TDataSource;
|
|
begin
|
|
Result:=FLookupDataLink.DataSource;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetBorderSize: Integer;
|
|
{var
|
|
Params: TCreateParams;
|
|
R: TRect;}
|
|
begin
|
|
{ CreateParams(Params);
|
|
SetRect(R, 0, 0, 0, 0);
|
|
AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
|
|
Result := R.Bottom - R.Top;}
|
|
Result := 3;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CheckButtonVisible;
|
|
begin
|
|
if Assigned(FButton) then
|
|
FButton.Visible:=(
|
|
(FStyle = rxcsDropDown) or (not ThemeServices.ThemesEnabled) {and (csDesigning in ComponentState)}
|
|
)
|
|
and
|
|
(
|
|
(Visible and (Focused or not FButtonNeedsFocus))
|
|
);
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetButtonWidth: Integer;
|
|
begin
|
|
if Assigned(FButton) then Result:=FButton.Width
|
|
else Result:=0;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetFlat: Boolean;
|
|
begin
|
|
if Assigned(FButton) then Result:=FButton.Flat
|
|
else Result:=false;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetGlyph: TBitmap;
|
|
begin
|
|
if Assigned(FButton) then Result:=FButton.Glyph
|
|
else Result:=nil;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetNumGlyphs: Integer;
|
|
begin
|
|
if Assigned(FButton) then Result:=FButton.NumGlyphs
|
|
else Result:=0;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetOnGetGridCellProps: TGetCellPropsEvent;
|
|
begin
|
|
Result:=FPopUpFormOptions.OnGetCellProps;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetPopupVisible: boolean;
|
|
begin
|
|
Result:=Assigned(FRxPopUpForm);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetButtonNeedsFocus(const AValue: Boolean);
|
|
begin
|
|
if FButtonNeedsFocus<>AValue then
|
|
begin
|
|
FButtonNeedsFocus:=AValue;
|
|
CheckButtonVisible;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetButtonWidth(const AValue: Integer);
|
|
begin
|
|
if Assigned(FButton) then
|
|
FButton.Width:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetDataFieldName(const AValue: string);
|
|
begin
|
|
if FDataFieldName <> AValue then
|
|
begin
|
|
FDataFieldName := AValue;
|
|
DataLinkActiveChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetDataSource(const AValue: TDataSource);
|
|
begin
|
|
FDataLink.DataSource := AValue;
|
|
if AValue <> nil then AValue.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetDisplayAll(const AValue: Boolean);
|
|
begin
|
|
if FDisplayAll <> AValue then
|
|
begin
|
|
FDisplayAll := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetDropDownCount(const AValue: Integer);
|
|
begin
|
|
FPopUpFormOptions.DropDownCount:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetDropDownWidth(const AValue: Integer);
|
|
begin
|
|
FPopUpFormOptions.DropDownWidth:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetEmptyItemColor(const AValue: TColor);
|
|
begin
|
|
if FEmptyItemColor=AValue then exit;
|
|
FEmptyItemColor:=AValue;
|
|
if not (csReading in ComponentState) then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetEmptyValue(const AValue: string);
|
|
begin
|
|
if FEmptyValue=AValue then exit;
|
|
FEmptyValue:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetFlat(const AValue: Boolean);
|
|
begin
|
|
if Assigned(FButton) then
|
|
FButton.Flat:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetGlyph(const AValue: TBitmap);
|
|
begin
|
|
if Assigned(FButton) then
|
|
FButton.Glyph:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetLookupDisplay(const AValue: string);
|
|
var
|
|
S1, S2:string;
|
|
K:integer;
|
|
begin
|
|
if FLookupDisplay=AValue then exit;
|
|
FLookupDisplay:=AValue;
|
|
FFieldList.Clear;
|
|
S2:=AValue;
|
|
while S2<>'' do
|
|
begin
|
|
K:=Pos(';', S2);
|
|
if K>0 then
|
|
begin
|
|
S1:=Copy(S2, 1, K-1);
|
|
Delete(S2, 1, K);
|
|
end
|
|
else
|
|
begin
|
|
S1:=S2;
|
|
S2:='';
|
|
end;
|
|
FFieldList.Add(S1);
|
|
end;
|
|
DisplayValueChanged;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetLookupDisplayIndex(const AValue: Integer);
|
|
begin
|
|
if FLookupDisplayIndex=AValue then exit;
|
|
FLookupDisplayIndex:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetLookupField(const AValue: string);
|
|
begin
|
|
FLookupField:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetLookupSource(const AValue: TDataSource);
|
|
begin
|
|
FLookupDataLink.DataSource:=AValue;
|
|
FLocateObject.DataSet:=FLookupDataLink.DataSet;
|
|
FPopUpFormOptions.DataSource:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetNumGlyphs(const AValue: Integer);
|
|
begin
|
|
if Assigned(FButton) then
|
|
FButton.NumGlyphs:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetOnGetGridCellProps(
|
|
const AValue: TGetCellPropsEvent);
|
|
begin
|
|
FPopUpFormOptions.OnGetCellProps:=AValue;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetPopUpFormOptions(
|
|
const AValue: TPopUpFormOptions);
|
|
begin
|
|
FPopUpFormOptions.Assign(AValue);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetReadOnly(const AValue: boolean);
|
|
begin
|
|
if FReadOnly=AValue then exit;
|
|
FReadOnly:=AValue;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.StoreEmpty: boolean;
|
|
begin
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.WMSetFocus(var Message: TLMSetFocus);
|
|
begin
|
|
FButton.Visible:=(FStyle = rxcsDropDown) or (not ThemeServices.ThemesEnabled);
|
|
inherited WMSetFocus(Message);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.WMKillFocus(var Message: TLMKillFocus);
|
|
begin
|
|
if FButtonNeedsFocus then
|
|
FButton.Visible:=false;
|
|
inherited WMKillFocus(Message);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CMExit(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CMGetDataLink(var Message: TLMessage);
|
|
begin
|
|
Message.Result := PtrUInt(FDataLink);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.PaintDisplayValues(ACanvas: TCanvas; R: TRect;
|
|
ALeft: Integer; AThemedDetails: PThemedElementDetails);
|
|
var
|
|
I, LastIndex, TxtWidth: Integer;
|
|
X, W, ATop, ARight: Integer;
|
|
S: string;
|
|
F:TField;
|
|
Details: TThemedElementDetails;
|
|
R1: TRect;
|
|
begin
|
|
if (FValuesList.Count=0) or (not LookupSource.DataSet.Active) then exit;
|
|
if ColorToRGB(Self.Color) <> ColorToRGB(clBtnFace) then
|
|
ACanvas.Pen.Color := clBtnFace
|
|
else
|
|
ACanvas.Pen.Color := clBtnShadow;
|
|
LastIndex := FValuesList.Count-1;
|
|
TxtWidth := ACanvas.TextWidth('W');
|
|
ATop := Max(0, (HeightOf(R) - ACanvas.TextHeight('Xy')) div 2);
|
|
ARight := R.Right;
|
|
Inc(R.Left, ALeft);
|
|
for I := 0 to LastIndex do
|
|
begin
|
|
F:=LookupSource.DataSet.FieldByName(FFieldList[i]);
|
|
S := FValuesList[i];
|
|
|
|
if (FPopUpFormOptions.Columns.Count>i) and (I<LastIndex) then
|
|
W := FPopUpFormOptions.Columns[i].Width
|
|
else
|
|
begin
|
|
W := F.DisplayWidth;
|
|
if I < LastIndex then
|
|
W := W * TxtWidth + 4
|
|
else
|
|
W := ARight - R.Left;
|
|
end;
|
|
|
|
X := 2;
|
|
R.Right := R.Left + W;
|
|
case F.AlignMent of
|
|
taRightJustify: X := W - ACanvas.TextWidth(S) - 3;
|
|
taCenter: X := (W - ACanvas.TextWidth(S)) div 2;
|
|
end;
|
|
|
|
if ThemeServices.ThemesEnabled and (FStyle = rxcsDropDownList) and Assigned(AThemedDetails) then
|
|
begin
|
|
R1:=R;
|
|
R1.Left:=R1.Left + Max(0, X);
|
|
if R1.Right > ARight then
|
|
R1.Right:=ARight;
|
|
ThemeServices.DrawText(ACanvas, AThemedDetails^, S, R1, DT_LEFT or DT_VCENTER or DT_SINGLELINE, 0)
|
|
end
|
|
else
|
|
ACanvas.TextRect(R, R.Left + Max(0, X), ATop, S);
|
|
|
|
Inc(R.Left, W);
|
|
if R.Left >= ARight then
|
|
Break;
|
|
|
|
if I < LastIndex then
|
|
begin
|
|
if ThemeServices.ThemesEnabled and (FStyle = rxcsDropDownList) then
|
|
begin
|
|
R1:=Rect(R.Right - 1, R.Top + 2, R.Right, R.Bottom - 2);
|
|
Details := ThemeServices.GetElementDetails(tcComboBoxRoot);
|
|
ThemeServices.DrawElement(ACanvas.Handle, Details, R1, nil);
|
|
end
|
|
else
|
|
begin
|
|
ACanvas.MoveTo(R.Right, R.Top);
|
|
ACanvas.LineTo(R.Right, R.Bottom);
|
|
end;
|
|
Inc(R.Left);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CheckNotCircular;
|
|
begin
|
|
if FDataLink.Active and ((DataSource = LookupSource) or
|
|
(FDataLink.DataSet = FLookupDataLink.DataSet)) then
|
|
_DBError(SCircularDataLink);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DisplayValueChanged;
|
|
begin
|
|
FDisplayField:=nil;
|
|
if FLookupDataLink.Active and (FLookupDisplay <> '') then
|
|
begin
|
|
FDisplayField := FLookupDataLink.DataSet.FieldByName(FFieldList[FLookupDisplayIndex]);
|
|
if PopupVisible then
|
|
begin
|
|
// UpdateData;
|
|
UpdateFieldValues;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TRxCustomDBLookupCombo.DataLinkActiveChanged;
|
|
begin
|
|
if FDataLink.Active and (FDataFieldName <> '') then
|
|
begin
|
|
CheckNotCircular;
|
|
FDataField := FDataLink.DataSet.FieldByName(FDataFieldName);
|
|
end
|
|
else
|
|
begin
|
|
FDataField := nil;
|
|
end;
|
|
DataLinkRecordChanged(nil);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DataLinkRecordChanged(Field: TField);
|
|
begin
|
|
if (Field = nil) or (Field = FDataField) then
|
|
begin
|
|
if FDataField <> nil then
|
|
begin
|
|
SetValueKey(FDataField.AsString);
|
|
end
|
|
else
|
|
SetValueKey(FEmptyValue);
|
|
end
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.UpdateFieldValues;
|
|
var
|
|
i, k:integer;
|
|
F:TField;
|
|
begin
|
|
FValuesList.Clear;
|
|
if not Assigned(FDataField) then
|
|
begin
|
|
if FLookupDataLink.Active then
|
|
if (Self.FSuccesfullyFind) or (Self.UnfindedValue = rxufLastSuccessful) then
|
|
begin
|
|
for i:=0 to FFieldList.Count-1 do
|
|
begin
|
|
F:=FLookupDataLink.DataSet.FieldByName(FFieldList[i]);
|
|
k:=FValuesList.Add(F.DisplayText);
|
|
FValuesList.Objects[k]:=TObject(PtrInt(F.DisplayWidth));
|
|
end;
|
|
end
|
|
else
|
|
case Self.UnfindedValue of
|
|
rxufNone : {Do nothing};
|
|
rxufOriginal : FValuesList.Add(FValue);//Show original field value...
|
|
end;
|
|
end
|
|
else
|
|
if Assigned(FDataField) then
|
|
begin
|
|
if FDataField.IsNull then
|
|
FValuesList.Add(FEmptyValue)
|
|
else
|
|
if FLookupDataLink.Active then
|
|
if (Self.FSuccesfullyFind) or (Self.UnfindedValue = rxufLastSuccessful) then
|
|
begin
|
|
for i:=0 to FFieldList.Count-1 do
|
|
begin
|
|
F:=FLookupDataLink.DataSet.FieldByName(FFieldList[i]);
|
|
k:=FValuesList.Add(F.DisplayText);
|
|
FValuesList.Objects[k]:=TObject(PtrInt(F.DisplayWidth));
|
|
end;
|
|
end
|
|
else
|
|
case Self.UnfindedValue of
|
|
rxufNone : {Do nothing};
|
|
rxufOriginal : FValuesList.Add(FValue);//Show original field value...
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.ShowList;
|
|
begin
|
|
if Assigned(FLookupDataLink.DataSet) and (FLookupDataLink.DataSet.Active) then
|
|
if not PopupVisible then
|
|
begin
|
|
if FDataField<>nil then
|
|
if FDataField <> nil then
|
|
FValue := FDataField.AsString
|
|
else
|
|
FValue := FEmptyValue;
|
|
|
|
if not Assigned(FDataField) then
|
|
begin
|
|
if not FLocateObject.Locate(FLookupField, FValue, true, false) then
|
|
FLookupDataLink.DataSet.First;
|
|
end
|
|
else
|
|
if Assigned(FDataField) and not FDataField.IsNull then
|
|
begin
|
|
if not FLocateObject.Locate(FLookupField, FValue, true, false) then
|
|
FLookupDataLink.DataSet.First;//In case we cannot find curvalue...
|
|
end
|
|
else
|
|
if FLookupDataLink.Active then
|
|
FLookupDataLink.DataSet.First;
|
|
|
|
FRxPopUpForm:=ShowRxDBPopUpForm(Self, FLookupDataLink.DataSet, @OnInternalClosePopup,
|
|
FPopUpFormOptions, FLookupDisplay, LookupDisplayIndex, 0 {ButtonWidth}, Font);
|
|
end
|
|
end;
|
|
|
|
|
|
procedure TRxCustomDBLookupCombo.SetValueKey(const Value: string);
|
|
begin
|
|
if FValue <> Value then
|
|
begin
|
|
FValue := Value;
|
|
if Assigned(FLookupDataLink.DataSet) and (FLookupDataLink.DataSet.Active) then
|
|
begin
|
|
FSuccesfullyFind := FLocateObject.Locate(FLookupField, FValue, true, false);
|
|
KeyValueChanged;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.UpdateKeyValue;
|
|
begin
|
|
if Assigned(FDataField) then
|
|
if FDataField <> nil then
|
|
FValue := FDataField.AsString
|
|
else
|
|
FValue := FEmptyValue;
|
|
|
|
if not Assigned(FDataField) then
|
|
begin
|
|
if FValue=FEmptyValue then
|
|
FSuccesfullyFind := false
|
|
else
|
|
FSuccesfullyFind := FLocateObject.Locate(FLookupField, FValue, true, false);
|
|
end
|
|
else
|
|
if FDataField.IsNull then
|
|
FSuccesfullyFind := false
|
|
else
|
|
if not FDataField.IsNull then
|
|
FSuccesfullyFind := FLocateObject.Locate(FLookupField, FValue, true, false);
|
|
KeyValueChanged;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.KeyValueChanged;
|
|
begin
|
|
UpdateFieldValues;
|
|
Invalidate;
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.UpdateData;
|
|
begin
|
|
//We have nothing to do here...
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.NeedUpdateData;
|
|
begin
|
|
if FLookupDataLink.Active and Assigned(FDataField) and Assigned(FKeyField) then
|
|
begin
|
|
if FKeyField.IsNull then FDataField.Clear
|
|
else FDataField.AsString:=FKeyField.AsString;
|
|
DoChangeData;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
var
|
|
tmpCanvas: TCanvas;
|
|
begin
|
|
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);
|
|
|
|
// ignore width
|
|
PreferredWidth:=0;
|
|
tmpCanvas := GetWorkingCanvas(Canvas);
|
|
try
|
|
PreferredHeight:=Canvas.TextHeight('Wg')+12;
|
|
//PreferredWidth:=Canvas.TextWidth('W')*12;
|
|
finally
|
|
if TmpCanvas<>Canvas then
|
|
FreeWorkingCanvas(tmpCanvas);
|
|
end;
|
|
end;
|
|
|
|
{procedure TRxCustomDBLookupCombo.GetPreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; Raw: boolean; WithThemeSpace: boolean);
|
|
begin
|
|
inherited GetPreferredSize(PreferredWidth, PreferredHeight, Raw,
|
|
WithThemeSpace);
|
|
end;
|
|
|
|
|
|
class function TRxCustomDBLookupCombo.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 170;
|
|
Result.CY := 50;
|
|
end;
|
|
}
|
|
procedure TRxCustomDBLookupCombo.OnInternalClosePopup(AResult: boolean);
|
|
begin
|
|
if Assigned(FRxPopUpForm) and AResult and (pfgColumnResize in FPopUpFormOptions.Options) then
|
|
FillPopupWidth(FPopUpFormOptions, FRxPopUpForm);
|
|
|
|
if Assigned(FOnClosePopup) then
|
|
FOnClosePopup(Self, AResult);
|
|
|
|
if FRxPopUpForm=nil then
|
|
begin
|
|
SetFocus;
|
|
Exit;
|
|
end;
|
|
|
|
FRxPopUpForm:=nil;
|
|
if not AResult then
|
|
UpdateKeyValue
|
|
else
|
|
if AResult and not Assigned(FDataLink.DataSource) and (FLookupDataLink.Active) then
|
|
begin
|
|
if FKeyField.IsNull then
|
|
SetValueKey(FEmptyValue)
|
|
else
|
|
SetValueKey(FKeyField.AsString);
|
|
end
|
|
else
|
|
|
|
if AResult and Assigned(FDataLink.DataSource) then
|
|
begin
|
|
FDataLink.Edit;
|
|
Visible:=true;
|
|
NeedUpdateData;//We need to update DataField;
|
|
end;
|
|
|
|
SetFocus;
|
|
if AResult then
|
|
DoSelect;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetEnabled(Value: Boolean);
|
|
begin
|
|
inherited SetEnabled(Value);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_RETURN, VK_HOME, VK_END]) and PopupVisible then
|
|
begin
|
|
TPopUpFormAccess(FRxPopUpForm).KeyDown(Key, Shift);
|
|
end
|
|
else
|
|
if not PopupVisible then
|
|
begin
|
|
if (Key = VK_DOWN) and ((ssAlt in Shift) or (ssCtrl in Shift)) then
|
|
begin
|
|
ShowList;
|
|
Key := 0;
|
|
end
|
|
else
|
|
if (Key = VK_ESCAPE) and not (Assigned(FDataField)) then
|
|
begin
|
|
Clear;
|
|
Key:=0;
|
|
end
|
|
else
|
|
if (Key = VK_ESCAPE) and (not FDataField.IsNull) and (FDataLink.Edit) then
|
|
begin
|
|
Clear;
|
|
Key:=0;
|
|
end;
|
|
end;
|
|
inherited KeyDown(Key, Shift);
|
|
if FLookupDataLink.Active and FDataLink.Active and not (PopupVisible or ReadOnly) then
|
|
begin
|
|
if (Key in [VK_UP, VK_DOWN]) and (Shift = []) then
|
|
begin
|
|
FDataLink.Edit;
|
|
if not FDataField.IsNull then
|
|
begin
|
|
//FLocateObject.Locate(FLookupField, FDataField.AsString, true, false);
|
|
If not FLocateObject.Locate(FLookupField, FDataField.AsString, true, false) then FLookupDataLink.DataSet.First;
|
|
case Key of
|
|
VK_UP: if not FLookupDataLink.DataSet.BOF then
|
|
FLookupDataLink.DataSet.Prior;
|
|
VK_DOWN: if not FLookupDataLink.DataSet.EOF then
|
|
FLookupDataLink.DataSet.Next;
|
|
end;
|
|
end;
|
|
//FDataLink.UpdateRecord; -- no need more...
|
|
Self.NeedUpdateData;
|
|
DoSelect;
|
|
KeyValueChanged;
|
|
Key:=0;
|
|
end
|
|
end
|
|
else
|
|
if FLookupDataLink.Active and not (PopupVisible or ReadOnly) then
|
|
begin
|
|
if (Key in [VK_UP, VK_DOWN]) and (Shift = []) then
|
|
begin
|
|
case Key of
|
|
VK_UP: if not FLookupDataLink.DataSet.BOF then
|
|
FLookupDataLink.DataSet.Prior;
|
|
VK_DOWN: if not FLookupDataLink.DataSet.EOF then
|
|
FLookupDataLink.DataSet.Next;
|
|
end;
|
|
SetValueKey(FKeyField.AsString);
|
|
DoSelect;
|
|
Key:=0;
|
|
end
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.UTF8KeyPress(var UTF8Key: TUTF8Char);
|
|
begin
|
|
if not (PopupVisible) and ((UTF8Key >= #32) or (UTF8Key = #8)) then
|
|
ShowList;
|
|
inherited UTF8KeyPress(UTF8Key);
|
|
if PopupVisible then
|
|
FRxPopUpForm.UTF8KeyPress(UTF8Key);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetParent(AParent: TWinControl);
|
|
begin
|
|
inherited SetParent(AParent);
|
|
if FButton <> nil then
|
|
CheckButtonVisible;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DoSetBounds(ALeft, ATop, AWidth,
|
|
AHeight: Integer);
|
|
begin
|
|
if not (csReading in ComponentState) and (Height < GetMinHeight) then
|
|
AHeight := GetMinHeight
|
|
else
|
|
begin
|
|
if (csDesigning in ComponentState) then
|
|
if (Height < GetMinHeight) then
|
|
AHeight := GetMinHeight;
|
|
end;
|
|
|
|
inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
|
|
// DoPositionButton;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DoPositionButton;
|
|
begin
|
|
if FButton <> nil then
|
|
FButton.SetBounds(Left+Width, Top, FButton.Width, Height);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DoChange;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DoChangeData;
|
|
begin
|
|
if Assigned(FOnChangeData) then
|
|
FOnChangeData(Self)
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DoSelect;
|
|
begin
|
|
if Assigned(FOnSelect) then
|
|
FOnSelect(Self);
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.DoButtonClick(Sender: TObject);
|
|
begin
|
|
if (not FReadOnly) and (not FStopClick) then//We can do something if and only if that's not ReadOnly field...
|
|
begin
|
|
if Assigned(FOnButtonClick) then
|
|
FOnButtonClick(Self);
|
|
ShowList;
|
|
end;
|
|
FStopClick:=false;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
CheckButtonVisible;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (AComponent = FButton) and (Operation = opRemove) then
|
|
FButton := nil;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CMVisibleChanged(var Msg: TLMessage);
|
|
begin
|
|
inherited CMVisibleChanged(Msg);
|
|
CheckButtonVisible;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.CMEnabledChanged(var Msg: TLMessage);
|
|
begin
|
|
inherited CMEnabledChanged(Msg);
|
|
if FButton<>nil then
|
|
FButton.Enabled:=Enabled;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.MouseEnter;
|
|
begin
|
|
inherited MouseEnter;
|
|
FMouseDown:=false;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.MouseLeave;
|
|
begin
|
|
inherited MouseLeave;
|
|
FMouseDown:=false;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
FMouseDown:=true;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
FMouseDown:=false;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.Resize;
|
|
begin
|
|
inherited Resize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.Click;
|
|
begin
|
|
inherited Click;
|
|
If not Self.PopupVisible then
|
|
DoButtonClick(Self);
|
|
FStopClick:=false;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.RealGetText: TCaption;
|
|
begin
|
|
if PopupVisible then
|
|
Result:=inherited RealGetText
|
|
else
|
|
if (FLookupDisplayIndex>=0) and (FLookupDisplayIndex < FValuesList.Count) then
|
|
Result:=FValuesList[FLookupDisplayIndex]
|
|
else
|
|
Result:='';
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.RealSetText(const Value: TCaption);
|
|
var
|
|
LookFieldName:string;
|
|
begin
|
|
inherited RealSetText(Value);
|
|
if not PopupVisible then
|
|
begin
|
|
if Assigned(FLookupDataLink.DataSet) and (FLookupDataLink.DataSet.Active) then
|
|
begin
|
|
if (FLookupDisplayIndex>=0) and (FLookupDisplayIndex<FFieldList.Count) then
|
|
begin
|
|
LookFieldName:=FFieldList[FLookupDisplayIndex];
|
|
FSuccesfullyFind := FLocateObject.Locate(LookFieldName, Value, true, false);
|
|
if FSuccesfullyFind and Assigned(FKeyField) then
|
|
SetValue(FKeyField.AsString);
|
|
KeyValueChanged;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetBorderStyle(NewStyle: TBorderStyle);
|
|
begin
|
|
if FStyle = rxcsDropDownList then
|
|
NewStyle:=bsNone;
|
|
|
|
inherited SetBorderStyle(NewStyle);
|
|
|
|
if BorderStyle = bsNone then
|
|
FButton.BorderSpacing.Around := 2
|
|
else
|
|
FButton.BorderSpacing.Around := 0;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.Paint;
|
|
const
|
|
padding = 1;
|
|
var
|
|
Selected:boolean;
|
|
R, R1, R2: TRect;
|
|
AText: string;
|
|
border : Integer;
|
|
Details, DetailsBtn: TThemedElementDetails;
|
|
BtnSize: TSize;
|
|
pr: PRect;
|
|
begin
|
|
|
|
R := Rect(0, 0, ClientWidth, ClientHeight);
|
|
|
|
if ThemeServices.ThemesEnabled and (FStyle = rxcsDropDownList) then
|
|
begin
|
|
Canvas.Brush.Color := Parent.Color;
|
|
Canvas.FillRect(R);
|
|
|
|
if Enabled then
|
|
begin
|
|
{$IF lcl_fullversion >= 1090000}
|
|
if MouseInClient then
|
|
{$ELSE}
|
|
if MouseEntered then
|
|
{$ENDIF}
|
|
begin
|
|
if FMouseDown then
|
|
begin
|
|
Details := ThemeServices.GetElementDetails({$IFDEF DARWIN}tcDropDownButtonPressed{$ELSE}tbPushButtonPressed{$ENDIF});
|
|
DetailsBtn := ThemeServices.GetElementDetails(tcDropDownButtonPressed);
|
|
end
|
|
else
|
|
begin
|
|
Details := ThemeServices.GetElementDetails({$IFDEF DARWIN}tcDropDownButtonNormal{$ELSE}tbPushButtonHot{$ENDIF});
|
|
DetailsBtn := ThemeServices.GetElementDetails(tcDropDownButtonNormal);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Details := ThemeServices.GetElementDetails({$IFDEF DARWIN}tcDropDownButtonNormal{$ELSE}tbPushButtonNormal{$ENDIF});
|
|
DetailsBtn := ThemeServices.GetElementDetails(tcDropDownButtonNormal);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Details := ThemeServices.GetElementDetails({$IFDEF DARWIN}tcDropDownButtonDisabled{$ELSE}tbPushButtonDisabled{$ENDIF});
|
|
DetailsBtn := ThemeServices.GetElementDetails(tcDropDownButtonDisabled);
|
|
end;
|
|
ThemeServices.DrawElement(Canvas.Handle, Details, R, nil);
|
|
|
|
BtnSize.Width:=20;
|
|
{$IFDEF DARWIN}
|
|
{$ELSE}
|
|
//BtnSize:=ThemeServices.GetDetailSize(DetailsBtn);
|
|
// adjust this for each OS, on windows looks fine
|
|
R1 := Rect(ClientWidth - BtnSize.Width, 1, ClientWidth, ClientHeight - 1);
|
|
R2 := Rect(r1.Left+1, r1.Top+1, r1.Right-2, r1.Bottom-1);
|
|
pr := @R2;
|
|
ThemeServices.DrawElement(Canvas.Handle, DetailsBtn, R1, pr);
|
|
{$ENDIF}
|
|
R.Right:=R.Right - BtnSize.Width;
|
|
|
|
if FDisplayAll then
|
|
PaintDisplayValues(Canvas, R, TextMargin, @Details)
|
|
else
|
|
begin
|
|
if Assigned(FDataField) and FDataField.IsNull then
|
|
AText:=FEmptyValue
|
|
else
|
|
if FValuesList.Count > 0 then
|
|
AText:=FValuesList[FLookupDisplayIndex]
|
|
else
|
|
AText:='';
|
|
R.Left:=R.Left + TextMargin;
|
|
ThemeServices.DrawText(Canvas, Details, AText, R, DT_LEFT or DT_VCENTER or DT_SINGLELINE, 0);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Canvas.Font := Font;
|
|
Canvas.Brush.Color := Color;
|
|
Selected := Focused and (not (csPaintCopy in ControlState)) and (not PopupVisible);
|
|
if Selected then
|
|
begin
|
|
Canvas.Font.Color := clHighlightText;
|
|
Canvas.Brush.Color := clHighlight;
|
|
end
|
|
else
|
|
if not Enabled {and NewStyleControls }then
|
|
begin
|
|
Canvas.Font.Color := clInactiveCaption;
|
|
end;
|
|
|
|
if BorderStyle = bsNone then
|
|
begin
|
|
border := 3;
|
|
if Flat then
|
|
begin
|
|
Canvas.Frame3d(R, border, bvLowered);
|
|
end
|
|
else
|
|
begin
|
|
RxFrame3D(Canvas, R, clWindowFrame, clBtnHighlight, 1);
|
|
RxFrame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
border := 1;
|
|
end;
|
|
|
|
if ClientWidth > 2*border then
|
|
begin
|
|
R1 := Rect(border, border, ClientWidth - border, ClientHeight - border);
|
|
Canvas.FillRect(R1);
|
|
R.Right := R.Right - GetButtonWidth;
|
|
if PopupVisible and (Caption<>'') then
|
|
begin
|
|
AText := Caption;
|
|
Canvas.TextRect(R, TextMargin, Max(0, (HeightOf(R) - Canvas.TextHeight('Wg')) div 2), AText);
|
|
end
|
|
else
|
|
if FDisplayAll then
|
|
PaintDisplayValues(Canvas, R, TextMargin, nil)
|
|
else
|
|
begin
|
|
if Assigned(FDataField) and FDataField.IsNull then
|
|
begin
|
|
R1 := Rect(border + padding, border + padding, ClientWidth - (border + padding) - GetButtonWidth, ClientHeight - (border + padding));
|
|
Canvas.Brush.Color:=FEmptyItemColor;
|
|
Canvas.FillRect(R1);
|
|
AText:=FEmptyValue
|
|
end
|
|
else
|
|
if FValuesList.Count > 0 then
|
|
AText:=FValuesList[FLookupDisplayIndex]
|
|
else
|
|
AText:='';
|
|
Canvas.TextRect(R, TextMargin, Max(0, (HeightOf(R) - Canvas.TextHeight('Wg')) div 2), AText);
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.LookupDataSetChanged(Sender: TObject);
|
|
begin
|
|
if PopupVisible then
|
|
begin
|
|
FSuccesfullyFind := true;
|
|
UpdateFieldValues;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.ListLinkActiveChanged(Sender: TObject);
|
|
var
|
|
DataSet: TDataSet;
|
|
begin
|
|
FListActive := False;
|
|
FKeyField := nil;
|
|
FDisplayField := nil;
|
|
DataSet:=nil;
|
|
if FLookupDataLink.Active and (FLookupField <> '') and (FFieldList.Count>FLookupDisplayIndex) and (FLookupDisplayIndex>=0) then
|
|
begin
|
|
CheckNotCircular;
|
|
DataSet := FLookupDataLink.DataSet;
|
|
FKeyField := DataSet.FieldByName(FLookupField);
|
|
FListActive := True;
|
|
FDisplayField := FLookupDataLink.DataSet.FieldByName(FFieldList[FLookupDisplayIndex]);
|
|
end;
|
|
FLocateObject.DataSet := DataSet;
|
|
|
|
if not (csDestroying in ComponentState) then
|
|
begin
|
|
if FListActive and Assigned(FDataField) then UpdateKeyValue
|
|
// else KeyValueChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetValue(const Value: string);
|
|
begin
|
|
if (Value <> FValue) then
|
|
begin
|
|
if FListActive and not ReadOnly and (FDataLink.DataSource <> nil) and FDataLink.Edit then
|
|
begin
|
|
FDataField.AsString := Value;
|
|
DoChangeData;
|
|
end
|
|
else
|
|
SetValueKey(Value);
|
|
DoSelect;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetStyle(AValue: TRxDBLookupStyle);
|
|
begin
|
|
if FStyle=AValue then Exit;
|
|
FStyle:=AValue;
|
|
CheckButtonVisible;
|
|
if FStyle = rxcsDropDownList then
|
|
BorderStyle:=bsNone;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.GetKeyValue: Variant;
|
|
begin
|
|
if Value = FEmptyValue then
|
|
Result := null
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.SetKeyValue(const Value: Variant);
|
|
begin
|
|
Self.Value := Value;
|
|
end;
|
|
|
|
constructor TRxCustomDBLookupCombo.Create(AOwner: TComponent);
|
|
var
|
|
ArrowBmp:TBitmap;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FMouseDown:=false;
|
|
FStyle:=rxcsDropDown;
|
|
FStopClick:=false;
|
|
Width := 100;
|
|
AutoSize:=true;
|
|
FUnfindedValue:=rxufNone;
|
|
FFieldList := TStringList.Create;
|
|
FValuesList:= TStringList.Create;
|
|
FLocateObject:=CreateLocate(nil);
|
|
FPopUpFormOptions:=TPopUpFormOptions.Create(Self);
|
|
//Lookup
|
|
FLookupDataLink:=TLookupSourceLink.Create;
|
|
FLookupDataLink.FOnActiveChanged:=@ListLinkActiveChanged;
|
|
FLookupDataLink.FOnLayoutChanged:=@ListLinkActiveChanged;
|
|
FLookupDataLink.FOnDataSetChanged:=@LookupDataSetChanged;
|
|
|
|
//Data
|
|
FDataLink:=TDataSourceLink.Create;
|
|
FDataLink.FDataControl:=Self;
|
|
|
|
|
|
FButton := TSpeedButton.Create(Self);
|
|
FButton.Width := Self.Height;
|
|
FButton.Height := Self.Height;
|
|
FButton.FreeNotification(Self);
|
|
FButton.Parent:=Self;
|
|
CheckButtonVisible;
|
|
FButton.OnClick := @DoButtonClick;
|
|
FButton.Cursor := crArrow;
|
|
FButton.ControlStyle := FButton.ControlStyle + [csNoDesignSelectable];
|
|
FButton.Align:=alRight;
|
|
FButton.BorderSpacing.Around:=2;
|
|
|
|
ControlStyle := ControlStyle - [csSetCaption];
|
|
FDirectInput := True;
|
|
ParentColor:=false;
|
|
//
|
|
Color:=clWindow;
|
|
FEmptyItemColor:=clWindow;
|
|
// Glyph:=CreateArrowBitmap;
|
|
ArrowBmp:=CreateArrowBitmap;
|
|
Glyph:=ArrowBmp;
|
|
FreeAndNil(ArrowBmp); //free bitmap as TSpeedButton setter takes a copy of bitmap
|
|
|
|
ButtonWidth:=15;
|
|
TabStop:=true;
|
|
BorderStyle := bsNone;
|
|
end;
|
|
|
|
destructor TRxCustomDBLookupCombo.Destroy;
|
|
begin
|
|
FreeAndNil(FLocateObject);
|
|
FreeAndNil(FDataLink);
|
|
FreeAndNil(FLookupDataLink);
|
|
FreeAndNil(FButton);
|
|
FFieldList.Clear;
|
|
FreeAndNil(FFieldList);
|
|
FreeAndNil(FValuesList);
|
|
FreeAndNil(FPopUpFormOptions);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRxCustomDBLookupCombo.Clear;
|
|
begin
|
|
if not (Assigned(FDataField)) then
|
|
begin
|
|
SetValueKey(FEmptyValue);
|
|
DoSelect;
|
|
end
|
|
else if (not FDataField.IsNull) and (FDataLink.Edit) then
|
|
begin
|
|
FDataField.Clear;
|
|
UpdateKeyValue;
|
|
DoSelect;
|
|
DoChangeData;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomDBLookupCombo.IsEmpty: Boolean;
|
|
begin
|
|
Result := (Value = EmptyValue);
|
|
end;
|
|
|
|
|
|
{ TDataSourceLink }
|
|
|
|
procedure TDataSourceLink.ActiveChanged;
|
|
begin
|
|
if FDataControl <> nil then
|
|
FDataControl.DataLinkActiveChanged;
|
|
end;
|
|
|
|
procedure TDataSourceLink.LayoutChanged;
|
|
begin
|
|
inherited LayoutChanged;
|
|
end;
|
|
|
|
procedure TDataSourceLink.FocusControl(Field: TFieldRef);
|
|
begin
|
|
if Assigned(Field) and (FDataControl.FDataField = Field^) then
|
|
if FDataControl.CanFocus then
|
|
begin
|
|
Field^ := nil;
|
|
FDataControl.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
procedure TDataSourceLink.RecordChanged(Field: TField);
|
|
begin
|
|
if FDataControl <> nil then
|
|
FDataControl.DataLinkRecordChanged(Field);
|
|
end;
|
|
|
|
procedure TDataSourceLink.UpdateData;
|
|
begin
|
|
if FDataControl <> nil then
|
|
FDataControl.UpdateData;
|
|
end;
|
|
|
|
{ TLookupSourceLink }
|
|
|
|
procedure TLookupSourceLink.ActiveChanged;
|
|
begin
|
|
{ if FDataControl <> nil then
|
|
FDataControl.ListLinkActiveChanged;}
|
|
if Assigned(FOnActiveChanged) then
|
|
FOnActiveChanged(DataSet);
|
|
end;
|
|
|
|
procedure TLookupSourceLink.LayoutChanged;
|
|
begin
|
|
{ if FDataControl <> nil then
|
|
FDataControl.ListLinkActiveChanged;}
|
|
if Assigned(FOnLayoutChanged) then
|
|
FOnLayoutChanged(DataSet);
|
|
end;
|
|
|
|
procedure TLookupSourceLink.DataSetChanged;
|
|
begin
|
|
{ if FDataControl <> nil then
|
|
FDataControl.LookupDataSetChanged;}
|
|
if Assigned(FOnDataSetChanged) then
|
|
FOnDataSetChanged(DataSet);
|
|
end;
|
|
|
|
{ TRxDBLookupCombo }
|
|
|
|
procedure TRxDBLookupCombo.OnInternalClosePopup(AResult: boolean);
|
|
begin
|
|
inherited OnInternalClosePopup(AResult);
|
|
if MouseEntered or FButton.MouseEntered then
|
|
FStopClick:=true;
|
|
end;
|
|
|
|
end.
|
|
|