mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-28 17:22:45 +02:00
128 lines
3.7 KiB
PHP
128 lines
3.7 KiB
PHP
{%MainUnit ../dbctrls.pas}
|
|
|
|
{******************************************************************************
|
|
TDBListBox
|
|
data aware ListBox, base found in 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 copyright. *
|
|
* *
|
|
* 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. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
|
|
// included by dbctrls.pas
|
|
|
|
{TCustomDBComboBox}
|
|
|
|
function TCustomDBComboBox.GetDataField: string;
|
|
begin
|
|
Result:=FDataLink.FieldName;
|
|
end;
|
|
|
|
function TCustomDBComboBox.GetDataSource: TDataSource;
|
|
begin
|
|
Result:=FDataLink.DataSource;
|
|
end;
|
|
|
|
function TCustomDBComboBox.GetField: TField;
|
|
begin
|
|
Result:=FDataLink.Field;
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.Change;
|
|
begin
|
|
FDataLink.Modified;
|
|
inherited Change;
|
|
end;
|
|
|
|
function TCustomDBComboBox.GetReadOnly: Boolean;
|
|
begin
|
|
Result:=FDataLink.ReadOnly;
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.SetDataField(const AValue: string);
|
|
begin
|
|
FDataLink.FieldName:=AValue;
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.SetDataSource(const AValue: TDataSource);
|
|
begin
|
|
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
|
|
ChangeDataSource(Self,FDataLink,AValue);
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.SetReadOnly(const AValue: Boolean);
|
|
begin
|
|
FDataLink.ReadOnly:=AValue;
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.CMGetDataLink(var Message: TLMessage);
|
|
begin
|
|
Message.Result := PtrUInt(FDataLink);
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation=opRemove) then begin
|
|
if (FDataLink<>nil) and (AComponent=DataSource) then
|
|
DataSource:=nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.EditingDone;
|
|
begin
|
|
FDataLink.UpdateRecord;
|
|
inherited EditingDone;
|
|
end;
|
|
|
|
procedure TCustomDBComboBox.WndProc(var Message: TLMessage);
|
|
begin
|
|
case Message.Msg of
|
|
LM_CLEAR,
|
|
LM_CUT,
|
|
LM_PASTE:
|
|
begin
|
|
if FDataLink.CanModify then
|
|
begin
|
|
//LCL changes the Text before LM_PASTE is called and not after like Delphi. Issue 20330
|
|
//When Edit is called the Text property is reset to the previous value
|
|
//Add a workaround while bug is not fixed
|
|
FDataLink.OnDataChange := nil;
|
|
FDatalink.Edit;
|
|
FDataLink.Modified;
|
|
FDataLink.OnDataChange := @DataChange;
|
|
inherited WndProc(Message);
|
|
end;
|
|
end;
|
|
else
|
|
inherited WndProc(Message);
|
|
end;
|
|
end;
|
|
|
|
constructor TCustomDBComboBox.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
ControlStyle:=ControlStyle+[csReplicatable];
|
|
FDataLink:=TFieldDataLink.Create;
|
|
FDataLink.Control:=Self;
|
|
FDataLink.OnDataChange:=@DataChange;
|
|
FDataLink.OnUpdateData:=@UpdateData;
|
|
end;
|
|
|
|
destructor TCustomDBComboBox.Destroy;
|
|
begin
|
|
FDataLink.Destroy;
|
|
inherited Destroy;
|
|
end;
|
|
|