mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-28 14:28:53 +02:00
220 lines
6.4 KiB
PHP
220 lines
6.4 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.LCL, 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.pp
|
|
|
|
{ Private Methods }
|
|
|
|
//update the Selected item on next record etc...
|
|
procedure TDBListBox.DataChange(Sender: TObject);
|
|
begin
|
|
//if a valid selection then use that else just an empty string
|
|
if (FDataLink.Field <> nil) then
|
|
ItemIndex := Items.IndexOf(FDataLink.Field.DisplayText)//this is wrong, but Text seems Broken
|
|
else
|
|
ItemIndex := -1;
|
|
end;
|
|
|
|
procedure TDBListBox.EditingChange(Sender: TObject);
|
|
begin
|
|
end;
|
|
|
|
procedure TDBListBox.UpdateData(Sender: TObject);
|
|
begin
|
|
//if a valid selection then use that else just an empty string
|
|
if (ItemIndex >= 0) then begin
|
|
FDataLink.Field.Text := Items[ItemIndex];
|
|
FDataLink.Field.AsString := Items[ItemIndex]// I shouldn't have to do this, but text seems broken
|
|
end
|
|
else begin
|
|
FDataLink.Field.Text := '';
|
|
FDataLink.Field.AsString := '';// I shouldn't have to do this, but text seems broken
|
|
end;
|
|
end;
|
|
|
|
procedure TDBListBox.FocusRequest(Sender: TObject);
|
|
begin
|
|
//the FieldLink has requested the control
|
|
//recieve focus for some reason..
|
|
//perhaps an error occured?
|
|
SetFocus;
|
|
end;
|
|
|
|
function TDBListBox.GetDataField: string;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
function TDBListBox.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
function TDBListBox.GetField: TField;
|
|
begin
|
|
Result := FDataLink.Field;
|
|
end;
|
|
|
|
Procedure TDBListBox.SetItems(Values : TStrings);
|
|
begin
|
|
Items.Assign(Values);
|
|
DataChange(Self);
|
|
end;
|
|
|
|
//we want to override the readonly state so we can
|
|
//reflect the state of the Datalink/Field
|
|
function TDBListBox.GetReadOnly: Boolean;
|
|
begin
|
|
//we want to override the readonly state so we can
|
|
//reflect the state of the Datalink/Field
|
|
Result := FDataLink.ReadOnly;
|
|
end;
|
|
|
|
procedure TDBListBox.SetReadOnly(Value: Boolean);
|
|
begin
|
|
//we want to override the readonly state so we can
|
|
//reflect the state of the Datalink/Field, so changing
|
|
//readonly changes the DataLink to ReadOnly, and when Editing
|
|
//changes the 'real' Readonly state will be updated to match
|
|
//according to the editing flag, which will always be false if
|
|
//this is true anyway. so I think all should be happy...
|
|
FDataLink.ReadOnly := Value;
|
|
end;
|
|
|
|
procedure TDBListBox.SetDataField(Value: string);
|
|
begin
|
|
FDataLink.FieldName := Value;
|
|
end;
|
|
|
|
procedure TDBListBox.SetDataSource(Value: TDataSource);
|
|
begin
|
|
FDataLink.DataSource := Value;
|
|
end;
|
|
|
|
{ Protected Methods}
|
|
procedure TDBListBox.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;
|
|
Key := VK_UNKNOWN;
|
|
end else if (Key<>VK_UNKNOWN) then begin
|
|
//make sure we call edit to ensure the datset is in edit,
|
|
//this is for where the datasource is in autoedit, so we aren't
|
|
//read only even though the dataset isn't really in edit
|
|
//if this validates false make sure the entry doesn't change
|
|
//since listbox doesn't have its own read only yet we gots to fake it
|
|
//here
|
|
if FDataLink.Edit then
|
|
exit;
|
|
Key := VK_UNKNOWN;
|
|
end;
|
|
end;
|
|
|
|
procedure TDBListBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
//need to make sure the state is updated on first load
|
|
if (csDesigning in ComponentState) then
|
|
DataChange(Self);
|
|
end;
|
|
|
|
procedure TDBListBox.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
// if the datasource is being removed then we need to make sure
|
|
// we are updated or we can get AV/Seg's *cough* as I foolishly
|
|
// discovered firsthand....
|
|
if (Operation=opRemove) then begin
|
|
if (FDataLink<>nil) and (AComponent=DataSource) then
|
|
DataSource:=nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TDBListBox.Click;
|
|
begin
|
|
//make sure we are in modify mode if can edit
|
|
//so if a user changed the selection it can be
|
|
//updated, and if not canel out ala ReadOnly
|
|
if not FDataLink.Edit then
|
|
exit;
|
|
|
|
inherited Click;
|
|
FDataLink.Modified;
|
|
end;
|
|
|
|
procedure TDBListBox.EditingDone;
|
|
begin
|
|
FDataLink.UpdateRecord;
|
|
inherited EditingDone;
|
|
end;
|
|
|
|
{ Public Methods }
|
|
constructor TDBListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDataLink := TFieldDataLink.Create;
|
|
FDataLink.Control := Self;
|
|
FDataLink.OnDataChange := @DataChange;
|
|
FDataLink.OnEditingChange := @EditingChange;
|
|
FDataLink.OnUpdateData := @UpdateData;
|
|
end;
|
|
|
|
destructor TDBListBox.Destroy;
|
|
begin
|
|
FDataLink.Free;
|
|
FDataLink := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ =============================================================================
|
|
|
|
$Log$
|
|
Revision 1.8 2004/09/01 11:12:04 mattias
|
|
replaced KeyPress dependencies with KeyDown
|
|
|
|
Revision 1.7 2004/08/30 16:37:58 mattias
|
|
added OnUTF8KeyPresss
|
|
|
|
Revision 1.6 2004/08/30 10:49:20 mattias
|
|
fixed focus catch for combobox csDropDownList
|
|
|
|
Revision 1.5 2004/08/13 16:40:47 mazen
|
|
+ TCharater type used to allow UTF8 keyboard with gtk2
|
|
|
|
Revision 1.4 2004/04/10 17:58:57 mattias
|
|
implemented mainunit hints for include files
|
|
|
|
Revision 1.3 2003/09/22 15:03:19 ajgenius
|
|
partly fixed streaming of DBCalendar, and opRemove notification of DBText DBEdit DBCalendar
|
|
|
|
Revision 1.2 2003/09/18 14:36:17 ajgenius
|
|
added TFieldDataLink.FocusControl/OnFocusRequest
|
|
|
|
Revision 1.1 2003/09/15 01:56:48 ajgenius
|
|
Added TDBListBox. needs more work for ReadOnly
|
|
|
|
|
|
}
|
|
|