Added TDBListBox. needs more work for ReadOnly

git-svn-id: trunk@4622 -
This commit is contained in:
ajgenius 2003-09-15 01:56:48 +00:00
parent 5d09926025
commit c24fd21f7c
3 changed files with 251 additions and 0 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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
View 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
}