mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-09 15:28:14 +02:00
Added TDBListBox. needs more work for ReadOnly
git-svn-id: trunk@4622 -
This commit is contained in:
parent
5d09926025
commit
c24fd21f7c
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -807,6 +807,7 @@ lcl/include/customradiogroup.inc svneol=native#text/pascal
|
||||
lcl/include/customstatictext.inc svneol=native#text/pascal
|
||||
lcl/include/customupdown.inc svneol=native#text/pascal
|
||||
lcl/include/dbedit.inc svneol=native#text/pascal
|
||||
lcl/include/dblistbox.inc svneol=native#text/pascal
|
||||
lcl/include/dbtext.inc svneol=native#text/pascal
|
||||
lcl/include/defaultbitbtnimages.inc svneol=native#text/pascal
|
||||
lcl/include/docktree.inc svneol=native#text/pascal
|
||||
|
@ -172,6 +172,53 @@ Type
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
end;
|
||||
|
||||
{ TDBListBox }
|
||||
TDBListBox = class(TCustomListBox)
|
||||
FDataLink: TFieldDataLink;
|
||||
|
||||
procedure DataChange(Sender: TObject);
|
||||
procedure EditingChange(Sender: TObject);
|
||||
procedure UpdateData(Sender: TObject);
|
||||
|
||||
function GetDataField: string;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetField: TField;
|
||||
|
||||
Procedure SetItems(Values : TStrings);
|
||||
|
||||
function GetReadOnly: Boolean;
|
||||
procedure SetReadOnly(Value: Boolean);
|
||||
|
||||
procedure SetDataField(Value: string);
|
||||
procedure SetDataSource(Value: TDataSource);
|
||||
protected
|
||||
procedure KeyPress(var Key: Char); override;
|
||||
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent;
|
||||
Operation: TOperation); override;
|
||||
|
||||
procedure Click; override;
|
||||
|
||||
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
property Field: TField read GetField;
|
||||
published
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
|
||||
// we need to overrride the write method for db aware.
|
||||
// the Read isn't an issue since the list will be updated
|
||||
// on data change anyway
|
||||
property Items write SetItems;
|
||||
|
||||
//same as dbedit need to match the datalink status
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{TFieldDataLink Private Methods}
|
||||
@ -482,12 +529,16 @@ end;
|
||||
|
||||
{$Include dbedit.inc}
|
||||
{$Include dbtext.inc}
|
||||
{$Include dblistbox.inc}
|
||||
|
||||
end.
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.2 2003/09/15 01:56:48 ajgenius
|
||||
Added TDBListBox. needs more work for ReadOnly
|
||||
|
||||
Revision 1.1 2003/09/14 18:40:55 ajgenius
|
||||
add initial TFieldDataLink, TDBEdit and TDBText
|
||||
|
||||
|
199
lcl/include/dblistbox.inc
Normal file
199
lcl/include/dblistbox.inc
Normal file
@ -0,0 +1,199 @@
|
||||
// included by dbctrls.pp
|
||||
|
||||
{******************************************************************************
|
||||
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;
|
||||
|
||||
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.KeyPress(var Key: Char);
|
||||
begin
|
||||
inherited KeyPress(Key);
|
||||
case Key of
|
||||
//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 realy in edit and
|
||||
//if this validates false make sure the entry doesn't change
|
||||
//since listbox doesn't have its own read only we gots to fake it
|
||||
//here
|
||||
#32..#255:
|
||||
begin
|
||||
if FDataLink.Edit then
|
||||
exit;
|
||||
|
||||
Key := #0;
|
||||
end;
|
||||
//cancel out of editing by reset on esc
|
||||
#27:
|
||||
begin
|
||||
FDataLink.Reset;
|
||||
Key := #0;
|
||||
end;
|
||||
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) and (AComponent = DataSource)
|
||||
then
|
||||
DataSource := nil;
|
||||
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.WMKillFocus(var Message: TLMKillFocus);
|
||||
begin
|
||||
//I am not sure where else to do this :/
|
||||
//we need to make sure the field is updated
|
||||
//if we leave the control after changes
|
||||
|
||||
FDataLink.UpdateRecord;
|
||||
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.1 2003/09/15 01:56:48 ajgenius
|
||||
Added TDBListBox. needs more work for ReadOnly
|
||||
|
||||
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user