{%MainUnit ../dbctrls.pp} {****************************************************************************** TDBEdit data aware Edit, 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 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 begin //display the real text since we can modify it RestoreMask(FDatalink.Field.Text); SelectAll; end else //otherwise display the pretified/formated text since we can't DisableMask(FDataLink.Field.DisplayText); if (FDataLink.Field.DataType = ftString) and (MaxLength = 0) then MaxLength := FDatalink.Field.Size; end else begin //todo: uncomment this when TField implements EditMask //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.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 Result := FDataLink.ReadOnly; end; procedure TDBEdit.SetReadOnly(Value: Boolean); begin inherited; FDataLink.ReadOnly := Value; end; procedure TDBEdit.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; procedure TDBEdit.SetDataSource(Value: TDataSource); begin ChangeDataSource(Self,FDataLink,Value); end; function TDBEdit.IsReadOnly: boolean; begin // This function in unneccesary for fpc versions > 2.2.4. // In those versions FDatalink.CanModify already checks if the dataset is active. // So this temporary method should be removed in the future, and the calls to // 'not IsReadOnly' should then be replaced by calls to FDatalink.CanModify. If FDatalink.Active then Result := not FDatalink.CanModify else Result := False; end; procedure TDBEdit.CMGetDataLink(var Message: TLMessage); begin Message.Result := PtrUInt(FDataLink); 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 in [VK_DELETE, VK_BACK] then begin if not IsReadOnly then FDatalink.Edit else Key := VK_UNKNOWN; end; end; procedure TDBEdit.KeyPress(var Key: char); function CanAcceptKey(AKey: char): boolean; begin Result := (Field<>nil) and Field.IsValidChar(AKey) and (Field.DataType<>ftAutoInc); end; var SavedKey: Char; begin SavedKey := Key; inherited KeyPress(Key); //TCustomMaskEdit sets all normal Keys (and BackSpace) to #0 if IsMasked //but not if control is ReadOnly if (not IsMasked) or (inherited ReadOnly) then begin case Key of #8: // special keys if not IsReadOnly then FDatalink.Edit else Key:=#0; #32..#255: //standard keys if not IsReadOnly and CanAcceptKey(Key) then FDatalink.Edit else Key:=#0; end;//case end else begin case SavedKey of #8: // special keys if not IsReadOnly then FDatalink.Edit; #32..#255: //standard keys if not IsReadOnly and CanAcceptKey(SavedKey) then FDatalink.Edit; end;//case 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; function TDBEdit.GetEditText: string; begin if not (csDesigning in ComponentState) and not FDatalink.Active then begin Result := ''; exit; end; Result:=inherited GetEditText; 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.WMSetFocus(var Message: TLMSetFocus); begin inherited WMSetFocus(Message); FDataLink.Reset; end; procedure TDBEdit.WMKillFocus(var Message: TLMKillFocus); begin inherited WMKillFocus(Message); if FDatalink.Editing then begin FDatalink.UpdateRecord; //check for Focused before disabling the mask since SetFocus can be called //inside events propagated by WMKillFocus or UpdateRecord if not Focused then begin DisableMask(FDataLink.Field.DisplayText); //reset the modified flag that is changed after setting the text FDataLink.IsModified := False; end; end else FDatalink.Reset; end; procedure TDBEdit.LMPasteFromClip(var Message: TLMessage); begin if not IsReadOnly then FDatalink.Edit; inherited LMPasteFromClip(Message); end; procedure TDBEdit.LMCutToClip(var Message: TLMessage); begin if not IsReadOnly then FDatalink.Edit; inherited LMCutToClip(Message); end; { Public Methods } constructor TDBEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := @DataChange; FDataLink.OnUpdateData := @UpdateData; FDataLink.OnActiveChange := @ActiveChange; FDataLink.OnLayoutChange := @LayoutChange; end; destructor TDBEdit.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end;