{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Boban Spasic
}
unit DBIPEdit;
interface
uses
SysUtils, Classes, Controls, StdCtrls, LResources, LCLType, StrUtils, DBCtrls,
Db, LMessages, IPEdit
;
type
{ TDBIPEdit }
TDBIPEdit = class (TIPEdit)
private
FDataLink: TFieldDataLink;
FFocusedDisplay: boolean;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
procedure SetDataField(AValue: string);
procedure SetDataSource(AValue: TDataSource);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
procedure WndProc(var Message: TLMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
function ExecuteAction(AAction: TBasicAction): Boolean; override;
function UpdateAction(AAction: TBasicAction): Boolean; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Misc', [TIPEdit]);
{.$I ipedit.lrs}
end;
{ TDBIPEdit }
function TDBIPEdit.GetDataField(): string;
begin
Result := FDataLink.FieldName;
end;
function TDBIPEdit.GetDataSource(): TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TDBIPEdit.GetField(): TField;
begin
Result := FDataLink.Field;
end;
procedure TDBIPEdit.SetDataField(AValue: string);
begin
FDataLink.FieldName := AValue;
end;
procedure TDBIPEdit.SetDataSource(AValue: TDataSource);
begin
ChangeDataSource(Self,FDataLink,AValue);
end;
procedure TDBIPEdit.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink);
end;
//update the caption on next record etc...
procedure TDBIPEdit.DataChange(Sender: TObject);
var
DataLinkField: TField;
begin
DataLinkField := FDataLink.Field;
if DataLinkField <> nil then begin
Alignment := DataLinkField.Alignment;
if FDatalink.CanModify then
begin
Text := DatalinkField.Text;
end;
if (DataLinkField.DataType in [ftString, ftFixedChar, ftWidestring, ftFixedWideChar]) and (MaxLength = 0) then
begin
MaxLength := DatalinkField.Size;
end;
end
else
begin
Text := '';
MaxLength := 0;
end;
Inherited EditingDone;
end;
procedure TDBIPEdit.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
EditingDone();
FDataLink.Field.Text := Text;
end;
procedure TDBIPEdit.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;
procedure TDBIPEdit.WMSetFocus(var Message: TLMSetFocus);
var
EditOnFocus: Boolean;
begin
// update text before inherited so DoEnter has the new text
if not FFocusedDisplay then
begin
FDataLink.Reset;
end;
inherited WMSetFocus(Message);
end;
procedure TDBIPEdit.WMKillFocus(var Message: TLMKillFocus);
begin
inherited WMKillFocus(Message);
FFocusedDisplay := False;
if csDestroying in ComponentState then Exit;
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);
FDataLink.Field.DisplayText;
//reset the modified flag that is changed after setting the text
FDataLink.Reset; //IsModified := False;
end;
end
else
FDatalink.Reset;
end;
procedure TDBIPEdit.WndProc(var Message: TLMessage);
begin
case Message.Msg of
LM_CLEAR,
LM_CUT,
LM_PASTE:
begin
if FDataLink.CanModify then
begin
//LCL changes the Text before LM_PASTE is called and not after like Delphi. Issue 20330
//When Edit is called the Text property is reset to the previous value
//Add a workaround while bug is not fixed
FDataLink.OnDataChange := nil;
FDatalink.Edit;
FDataLink.Modified;
FDataLink.OnDataChange := @DataChange;
inherited WndProc(Message);
end
else
Message.Result := 1; // prevent calling default window proc
end;
else
inherited WndProc(Message);
end;
end;
constructor TDBIPEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
end;
destructor TDBIPEdit.Destroy;
begin
FDataLink.Destroy;
inherited Destroy;
end;
function TDBIPEdit.ExecuteAction(AAction: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(AAction) or
(FDataLink <> nil) and FDataLink.ExecuteAction(AAction);
end;
function TDBIPEdit.UpdateAction(AAction: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(AAction) or
(FDataLink <> nil) and FDataLink.UpdateAction(AAction);
end;
end.
Recent
