lazarus/lcl/include/dbmemo.inc
2008-04-03 01:33:43 +00:00

244 lines
5.8 KiB
PHP

{%MainUnit ../dbctrls.pp}
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, 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. *
* *
*****************************************************************************
}
{ TDBMemo }
function TDBMemo.GetDataField: string;
begin
Result:=FDataLink.FieldName;
end;
function TDBMemo.GetDataSource: TDataSource;
begin
Result:=FDataLink.DataSource;
end;
function TDBMemo.GetField: TField;
begin
Result:=FDataLink.Field;
end;
function TDBMemo.GetReadOnly: Boolean;
begin
Result:=FDataLink.ReadOnly;
end;
procedure TDBMemo.SetAutoDisplay(const AValue: Boolean);
begin
if FAutoDisplay=AValue then exit;
FAutoDisplay:=AValue;
if FAutoDisplay then LoadMemo;
end;
procedure TDBMemo.SetDataField(const AValue: string);
begin
FDataLink.FieldName:=AValue;
end;
procedure TDBMemo.SetDataSource(const AValue: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource:=AValue;
if AValue<>nil then
AValue.FreeNotification(Self);
end;
procedure TDBMemo.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink);
end;
procedure TDBMemo.SetReadOnly(AValue: Boolean);
begin
inherited;
FDataLink.ReadOnly:=AValue;
end;
function TDBMemo.WordWrapIsStored: boolean;
begin
Result:=not WordWrap;
end;
procedure TDBMemo.DataChange(Sender: TObject);
begin
if FDataLink.Field<>nil then begin
if FDataLink.Field.IsBlob then begin
if FAutoDisplay or (FDataLink.Editing and FDBMemoLoaded) then begin
FDBMemoLoaded:=False;
LoadMemo;
end else begin
Text:=Format('(%s)', [FDataLink.Field.DisplayLabel]);
FDBMemoLoaded:=False;
end;
end else begin
if FDBMemoFocused and FDataLink.CanModify then
Text:=FDataLink.Field.Text
else
Text:=FDataLink.Field.DisplayText;
FDBMemoLoaded:=True;
end
end else begin
if csDesigning in ComponentState then
Text:=Name
else
Text:='';
FDBMemoLoaded:=False;
end;
end;
procedure TDBMemo.ActiveChange(Sender: TObject);
begin
if FDatalink.Active then datachange(sender)
else
begin
Lines.Clear;
FDataLink.reset;
end;
end;
procedure TDBMemo.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) then begin
if (FDataLink<>nil) and (AComponent=DataSource) then
DataSource:=nil;
end;
end;
procedure TDBMemo.UpdateData(Sender: TObject);
begin
if not FDBMemoLoaded then exit;
if FDataLink=nil then exit;
if not FDataLink.CanModify then exit;
FDataLink.Field.AsString:=Text;
end;
constructor TDBMemo.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle:=ControlStyle+[csReplicatable];
FAutoDisplay:=True;
FDataLink:=TFieldDataLink.Create;
FDataLink.Control:=Self;
FDataLink.OnDataChange:=@DataChange;
FDataLInk.OnActiveChange := @ActiveChange;
FDataLink.OnUpdateData:=@UpdateData;
end;
procedure TDBMemo.FocusRequest(Sender: TObject);
begin
//the FieldLink has requested the control
//recieve focus for some reason..
//perhaps an error occured?
SetFocus;
end;
procedure TDBMemo.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then
DataChange(Self);
end;
procedure TDBMemo.EditingDone;
begin
FDataLink.UpdateRecord;
inherited EditingDone;
end;
procedure TDBMemo.Change;
begin
FDatalink.Modified;
inherited Change;
end;
procedure TDBMemo.KeyPress(var Key: Char);
function CheckValidChar: boolean;
begin
result := FDBMemoLoaded and (FDatalink.Field<>nil) and
FDatalink.Field.IsValidChar(Key);
if Result then
FDatalink.Edit
else
Key := #0;
end;
function CheckEditingKey: boolean;
begin
result := FDbMemoLoaded;
if Result then
FDatalink.Edit
else
Key := #0;
end;
begin
inherited KeyPress(Key);
case key of
#32..#255: // alphabetic characters
CheckValidChar;
^M: // enter key
if not CheckEditingKey then
LoadMemo;
#27: // escape
if FDbMemoLoaded then
FDatalink.Reset
else
Key:=#0;
// Verifyes if we are in edit mode for special keys may change the text
// Ctrl+I = Tab
// Ctrl+J = LineFeed
// Ctrl+H = Backspace
^X, ^V, ^Z, ^I, ^J, ^H:
CheckEditingKey;
// Don't do anything for special keys that don't change the text
// Like Ctrl+C for example
end;
end;
procedure TDBMemo.WndProc(var AMessage: TLMessage);
begin
case AMessage.Msg of
LM_CLEAR,
LM_CUT,
LM_PASTE:
FDatalink.Edit;
end;
inherited WndProc(AMessage);
end;
destructor TDBMemo.Destroy;
begin
FDataLink.Free;
FDataLink:=nil;
inherited Destroy;
end;
procedure TDBMemo.LoadMemo;
begin
if not FDBMemoLoaded and (FDataLink.Field<>nil)
and FDataLink.Field.IsBlob then begin
try
Lines.Text:=FDataLink.Field.AsString;
FDBMemoLoaded:=True;
except
on E:EInvalidOperation do
Lines.Text:='('+E.Message+')';
end;
end;
end;
// included by dbctrls.pas