paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 03:48:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, implements NullValueKey for dblookuplistbox and dblookupcombobox, issue #14408

Browse Source 
git-svn-id: trunk@28158 -
This commit is contained in:
jesus 2010-11-08 20:44:44 +00:00
parent db0a5c00b2
commit d112e09512
4 changed files with 79 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/dbctrls.pp
View File

@ -143,6 +143,8 @@ Type
FListField: TField; // Result field in lookup dataset
FLookupCache: boolean;
FLookupList: TLookupList;
FNullValueKey: TShortcut;
FOnClearSelection: TNotifyEvent;
procedure ActiveChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
procedure FetchLookupData;
@ -154,9 +156,11 @@ Type
procedure SetListFieldName(const Value: string);
procedure SetListSource(Value: TDataSource);
procedure SetLookupCache(const Value: boolean);
procedure NullKeyHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure DoClearSelection;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -172,6 +176,8 @@ Type
property ListField: string read FListFieldName write SetListFieldName;
property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
property ListSource: TDataSource read GetListSource write SetListSource;
property NullValueKey: TShortcut read FNullValueKey write FNullValueKey;
property OnClearSelection: TNotifyEvent read FOnClearSelection write FOnClearSelection;
end;
{ TDBEdit }
@ -444,12 +450,15 @@ Type
function GetListFieldIndex: Integer;
function GetListSource: TDataSource;
function GetLookupCache: boolean;
function GetNullValueKey: TShortCut;
procedure SetKeyField(const Value: string);
procedure SetKeyValue(const AValue: Variant);
procedure SetListField(const Value: string);
procedure SetListFieldIndex(const Value: Integer);
procedure SetListSource(const Value: TDataSource);
procedure SetLookupCache(const Value: boolean);
procedure RemoveSelection(Sender: TObject);
procedure SetNullValueKey(const AValue: TShortCut);
protected
procedure DataChange(Sender: TObject); override;
procedure InitializeWnd; override;
@ -473,6 +482,7 @@ Type
property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
property ListSource: TDataSource read GetListSource write SetListSource;
property LookupCache: boolean read GetLookupCache write SetLookupCache;
property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
// property MultiSelect;
property OnClick;
property OnDblClick;
@ -755,12 +765,15 @@ Type
function GetListFieldIndex: Integer;
function GetListSource: TDataSource;
function GetLookupCache: boolean;
function GetNullValueKey: TShortCut;
procedure SetKeyField(const Value: string);
procedure SetKeyValue(const AValue: variant);
procedure SetListField(const Value: string);
procedure SetListFieldIndex(const Value: Integer);
procedure SetListSource(const Value: TDataSource);
procedure SetLookupCache(const Value: boolean);
procedure SetNullValueKey(const AValue: TShortCut);
procedure RemoveSelection(Sender: TObject);
protected
procedure InitializeWnd; override;
procedure UpdateData(Sender: TObject); override;
@ -792,6 +805,7 @@ Type
property ListSource: TDataSource read GetListSource write SetListSource;
property LookupCache: boolean read GetLookupCache write SetLookupCache;
// property MaxLength default -1;
property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
property OnChange;
property OnChangeBounds;
property OnClick;

28
lcl/include/dblookup.inc
View File

@ -75,6 +75,7 @@ begin
FHasLookUpField:= False;
FListLinkTmpSetActive := False;
FLookupCache := False;
Application.AddOnKeyDownBeforeHandler(@NullKeyHandler, false);
end;
destructor TDBLookup.Destroy;
@ -146,6 +147,27 @@ begin
FLookupList := TLookupList.Create;
end;
procedure TDBLookup.NullKeyHandler(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
i: Integer;
begin
if (FNullValueKey=KeyToShortCut(Key, Shift)) then
begin
// null associated field
if Assigned(FControlLink) and (FDataFieldNames<>'') and FControlLink.Active then
begin
FControlLink.DataSet.Edit;
for i:=0 to FDataFields.Count-1 do
TField(FDataFields[i]).Clear;
end else
if Assigned(FListLink.DataSet) and FListLink.DataSet.Active and Assigned(FListField) then
// associated list is active, clear current selection
DoClearSelection;
end;
end;
procedure TDBLookup.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
@ -154,6 +176,12 @@ begin
FListSource:= nil;
end;
procedure TDBLookup.DoClearSelection;
begin
if Assigned(FOnClearSelection) then
OnClearSelection(Self);
end;
procedure TDBLookup.LinkGetBookMark;
begin
FListLinkTmpSetActive := not FListLink.DataSet.Active;

17
lcl/include/dblookupcombobox.inc
View File

@ -27,6 +27,7 @@ constructor TDBLookupComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLookup:= TDBLookup.Create(Self);
FLookup.OnClearSelection:=@RemoveSelection;
FDataLink.OnActiveChange:= @ActiveChange;
end;
@ -84,6 +85,11 @@ begin
Result := FLookup.LookupCache;
end;
function TDBLookupComboBox.GetNullValueKey: TShortCut;
begin
result := FLookup.NullValueKey;
end;
procedure TDBLookupComboBox.SetKeyField(const Value: string);
begin
FLookup.KeyField:= Value;
@ -122,4 +128,15 @@ begin
ActiveChange(Self);
end;
procedure TDBLookupComboBox.SetNullValueKey(const AValue: TShortCut);
begin
FLookup.NullValueKey := AValue;
end;
procedure TDBLookupComboBox.RemoveSelection(Sender: TObject);
begin
ItemIndex := -1;
Text := '';
end;

20
lcl/include/dblookuplistbox.inc
View File

@ -26,6 +26,7 @@ constructor TDBLookupListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLookup:= TDBLookup.Create(Self);
FLookup.OnClearSelection := @RemoveSelection;
FDataLink.OnActiveChange:= @ActiveChange;
end;
@ -97,6 +98,11 @@ begin
Result := FLookup.LookupCache;
end;
function TDBLookupListBox.GetNullValueKey: TShortCut;
begin
Result := FLookup.NullValueKey;
end;
procedure TDBLookupListBox.SetKeyField(const Value: string);
begin
FLookup.KeyField:= Value;
@ -135,3 +141,17 @@ begin
ActiveChange(Self);
end;
procedure TDBLookupListBox.RemoveSelection(Sender: TObject);
begin
if not assigned(FDatalink.DataSet) or not FDatalink.DataSet.Active or
not assigned(FDatalink.Field) then
GetItemIndex; // a list-only dblookuplist do not automatically update itemindex
ItemIndex := -1;
end;
procedure TDBLookupListBox.SetNullValueKey(const AValue: TShortCut);
begin
FLookup.NullValueKey := AValue;
end;