{%MainUnit ../dbctrls.pas} {****************************************************************************** TDBEdit data aware Edit, 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 caption on next record etc... procedure TDBEdit.DataChange(Sender: TObject); begin if FDataLink.Field <> nil then begin //use the right EditMask if any //EditMask := FDataLink.Field.EditMask; doesn't exist yet //if we are focused its possible to edit, //if the field is currently modifiable if Focused and FDataLink.CanModify then //display the real text since we can modify it Text := FDataLink.Field.DisplayText//this is wrong, but Text seems Broken else //otherwise display the pretified/formated text since we can't EditText := FDataLink.Field.DisplayText; end else begin EditMask := ''; Text := ''; end; end; procedure TDBEdit.ActiveChange(Sender: TObject); begin if FDatalink.Active then datachange(sender) else begin text := ''; FDataLink.reset; end; end; procedure TDBEdit.LayoutChange(Sender: TObject); begin DataChange(Sender); end; procedure TDBEdit.EditingChange(Sender: TObject); begin //ok to hide the 'real' readonly state we must override it //and so here when the data changes we need to set the //'real' value to match the state of the FieldLink //i.e. always ReadOnly unless its editing inherited ReadOnly := not FDataLink.Editing; end; procedure TDBEdit.UpdateData(Sender: TObject); begin //the field is being updated, probably for post //so we are getting called to make sure its //up-to-date and matches any modifications //since its possible to have a mask for say //date or currency we need to make sure the //text is valid before we update this is in //case for instance they call table.post via //a keyboard shortcut while still focused, before //the changes have been validated ValidateEdit; FDataLink.Field.Text := Text; FDataLink.Field.AsString := Text;// I shouldn't have to do this, but text seems broken end; procedure TDBEdit.FocusRequest(Sender: TObject); begin //the FieldLink has requested the control //recieve focus for some reason.. //perhaps an error occured? SetFocus; end; function TDBEdit.GetDataField: string; begin Result := FDataLink.FieldName; end; function TDBEdit.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; function TDBEdit.GetField: TField; begin Result := FDataLink.Field; end; function TDBEdit.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 TDBEdit.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 TDBEdit.SetDataField(Value: string); begin FDataLink.FieldName := Value; end; procedure TDBEdit.SetDataSource(Value: TDataSource); begin FDataLink.DataSource := Value; end; { Protected Methods} procedure TDBEdit.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; SelectAll; 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 realy in edit FDataLink.Edit; end; end; procedure TDBEdit.Loaded; begin inherited Loaded; //need to make sure the state is updated on first load if (csDesigning in ComponentState) then DataChange(Self); end; procedure TDBEdit.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; function TDBEdit.EditCanModify: Boolean; begin //should follow the FieldLink for this one Result := FDataLink.Edit; end; procedure TDBEdit.Change; begin //need to override this to make sure the datalink gets notified //its been modified, then when post etc, it will call //updatedata to update the field data with current value FDataLink.Modified; inherited Change; end; procedure TDBEdit.Reset; begin //need to override this to make sure the datalink gets reset //if the changes get canceled FDataLink.reset; inherited Reset; end; procedure TDBEdit.SetFocus; begin if not Focused then begin inherited SetFocus; FDataLink.Reset;//force call to data changed to update text(display vs actual) end; end; procedure TDBEdit.EditingDone; begin inherited EditingDone; if FDataLink.CanModify then FDataLink.UpdateRecord; end; { Public Methods } constructor TDBEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := @DataChange; FDataLink.OnEditingChange := @EditingChange; FDataLink.OnUpdateData := @UpdateData; FDataLInk.OnActiveChange := @ActiveChange; FDatalink.OnLayoutChange := @LayoutChange; inherited ReadOnly := True;//start read only end; destructor TDBEdit.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end;