{%MainUnit ../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.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } // included by dbctrls.pp { Private Methods } function TCustomDBListBox.GetDataField: string; begin Result := FDataLink.FieldName; end; function TCustomDBListBox.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; function TCustomDBListBox.GetField: TField; begin Result := FDataLink.Field; end; procedure TCustomDBListBox.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 TCustomDBListBox.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 TCustomDBListBox.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 TCustomDBListBox.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; procedure TCustomDBListBox.SetDataSource(Value: TDataSource); begin ChangeDataSource(Self,FDataLink,Value); end; procedure TCustomDBListBox.CMGetDataLink(var Message: TLMessage); begin Message.Result := PtrUInt(FDataLink); end; { Protected Methods} procedure TCustomDBListBox.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key,Shift); case Key of VK_ESCAPE: begin //cancel out of editing by reset on esc FDataLink.Reset; Key := VK_UNKNOWN; end; VK_DOWN, VK_UP: begin FDataLink.Edit; end; end; end; procedure TCustomDBListBox.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; { Public Methods } constructor TCustomDBListBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := @DataChange; FDataLink.OnUpdateData := @UpdateData; end; destructor TCustomDBListBox.Destroy; begin FDataLink.Destroy; inherited Destroy; end; function TCustomDBListBox.ExecuteAction(AAction: TBasicAction): Boolean; begin Result := inherited ExecuteAction(AAction) or (FDataLink <> nil) and FDataLink.ExecuteAction(AAction); end; function TCustomDBListBox.UpdateAction(AAction: TBasicAction): Boolean; begin Result := inherited UpdateAction(AAction) or (FDataLink <> nil) and FDataLink.UpdateAction(AAction); end;