lazarus/lcl/include/dbcombobox.inc
2017-12-30 20:57:13 +00:00

81 lines
1.8 KiB
PHP

{%MainUnit ../dbctrls.pp}
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
// included by dbctrls.pp
{ TDBComboBox }
procedure TDBComboBox.UpdateData(Sender: TObject);
begin
FDataLink.Field.Text := Text;
end;
procedure TDBComboBox.DataChange(Sender: TObject);
var
DataLinkField: TField;
begin
DataLinkField := FDataLink.Field;
if Assigned(DataLinkField) then
Text := DataLinkField.Text
else
Text := '';
end;
procedure TDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key=VK_ESCAPE then begin
//cancel out of editing by reset on esc
FDataLink.Reset;
SelectAll;
Key := VK_UNKNOWN;
end else
if Key in [VK_DELETE, VK_BACK] then begin
if not FDataLink.Edit then
Key := VK_UNKNOWN;
end;
end;
procedure TDBComboBox.KeyPress(var Key: char);
begin
inherited KeyPress(Key);
case Key of
#8: // special keys
if not FDatalink.Edit then
Key:=#0;
#32..#255: //standard keys
if not FieldCanAcceptKey(FDataLink.Field, Key) or not FDatalink.Edit then
Key:=#0;
end;//case
end;
procedure TDBComboBox.Select;
begin
//avoid reseting text when calling select
FDataLink.OnDataChange := nil;
try
if FDataLink.Edit then
begin
FDataLink.Modified;
FDataLink.UpdateData;
inherited Select;
end
else
begin
// if cannot modify, let it reset
FDatalink.Reset;
DataChange(Self);
end;
finally
FDataLink.OnDataChange := @DataChange;
end;
end;