dbrv.pas

richview1.7 full.source

  begin
    FAutoDisplay := Value;
    if Value then LoadField;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichView.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;
{-----------------------------------------------------------------------}
procedure TDBRichView.DblClick;
begin
  if not FMemoLoaded then
    LoadField
  else
    inherited;
end;
{-----------------------------------------------------------------------}
procedure LoadXXXFromStream(Stream: TStream; rv: TCustomRichView);
var s: String;
const RTF_START = '{\rtf';
  {...................................................}
  function IsRTF(Stream: TStream): Boolean;
  var DataStart: String;
  begin
    Result := (Stream.Size>5);
    if not Result then
      exit;
    SetLength(DataStart,5);
    Stream.ReadBuffer(PChar(DataStart)^,5);
    Result := DataStart=RTF_START;
    Stream.Position := 0;
  end;
  {...................................................}
  function AllZero(const s: String):Boolean;
  var i: Integer;
  begin
    Result := False;
    for i := 1 to Length(s) do
      if s[i]<>#0 then
        exit;
    Result := True;
  end;
  {...................................................}
begin
  Stream.Position := 0;
  if not rv.LoadRVFFromStream(Stream) then begin
    Stream.Position := 0;
    if not (IsRTF(Stream) and rv.LoadRTFFromStream(Stream)) then begin
      Stream.Position := 0;
      SetLength(s, Stream.Size);
      Stream.ReadBuffer(PChar(s)^,Stream.Size);
      rv.Clear;
      if AllZero(s) then
        s := '';
      rv.AddTextNL(s, 0,0,0);
    end;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichView.LoadField;
var Stream: TMemoryStream;
begin
  if not FMemoLoaded and Assigned(FDataLink.Field) then
  begin
    Clear;
    try
      Stream := TMemoryStream.Create;
      try
        (FDataLink.Field as TBlobField).SaveToStream(Stream);
        LoadXXXFromStream(Stream, Self);
      finally
        Stream.Free;
      end;
      if RVData.Items.Count = 0 then AddNL('',0,0);
      FMemoLoaded := True;
    except
      on E:EInvalidOperation do
        AddNL(SysUtils.Format('(%s)', [E.Message]),0,0);
    end;
    Format;
    Invalidate;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichView.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
    if {FDataLink.Field.IsBlob} True then
      if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then begin
        FMemoLoaded := False;
        LoadField;
        end
      else begin
        FMemoLoaded := False;
        Clear;
        AddNL(SysUtils.Format('(%s)', [FDataLink.Field.DisplayLabel]),0,0);
        Format;
        Invalidate;
      end
    else begin
      Clear;
      if FFocused and FDataLink.CanModify then
        AddNL(FDataLink.Field.Text,0,0)
      else
        AddNL(FDataLink.Field.DisplayText,0,0);
      if RVData.Items.Count = 0 then AddNL('',0,0);
      Format;
      Invalidate;
      FMemoLoaded := True;
    end
  else begin
    Clear;
    Format;
    Invalidate;
    FMemoLoaded := False;
  end;
end;
{==========================DBRichViewEdit===============================}
constructor TDBRichViewEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  FieldFormat := rvdbRVF;
  FAutoDisplay := True;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataSaveStream := nil;
end;
{-----------------------------------------------------------------------}
destructor TDBRichViewEdit.Destroy;
begin
  FDataSaveStream.Free;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then DataChange(Self);
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.DoChange(ClearRedo: Boolean);
begin
  if FMemoLoaded then FDataLink.Modified;
  inherited DoChange(ClearRedo);
end;
{-----------------------------------------------------------------------}
function TDBRichViewEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;
{-----------------------------------------------------------------------}
function TDBRichViewEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;
{-----------------------------------------------------------------------}
function TDBRichViewEdit.DBGetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.DBSetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;
{-----------------------------------------------------------------------}
function TDBRichViewEdit.GetField: TField;
begin
  Result := FDataLink.Field;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.LoadField;
var Stream: TMemoryStream;
    sf: Boolean;
    {..............................}
    function HasFocus: Boolean;
    var ctrl: TWinControl;
    begin
      Result := True;
      ctrl := Self;
      while ctrl<>nil do begin
        if ctrl.Focused then
          exit;
        if ctrl is TCustomRichViewEdit then
          ctrl := TCustomRichViewEdit(ctrl).InplaceEditor
        else
          ctrl := nil;
      end;
      Result := False;;
    end;
    {..............................}
begin
  if not FMemoLoaded and Assigned(FDataLink.Field) {and FDataLink.Field.IsBlob} then
  begin
    sf := HasFocus;
    Clear;
    try
      Stream := TMemoryStream.Create;
      try
        (FDataLink.Field as TBlobField).SaveToStream(Stream);
        Stream.Position := 0;
        LoadXXXFromStream(Stream, Self);
      finally
        Stream.Free;
      end;
      if RVData.Items.Count = 0 then AddNL('',0,0);
      FMemoLoaded := True;
    except
      on E:EInvalidOperation do
        AddNL(SysUtils.Format('(%s)', [E.Message]),0,0);
    end;
    Format;
    if sf then
      Windows.SetFocus(Handle);    
    Invalidate;
    EditingChange(Self);
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.BeginEditing;
begin
  if not FDataLink.Editing then
  try
    if {FDataLink.Field.IsBlob} True then begin
      if FDataSaveStream=nil then FDataSaveStream := TMemoryStream.Create;
      SaveRVFToStream(FDataSaveStream, False);
    end;
    FDataLink.Edit;
  finally
    FDataSaveStream.Free;
    FDataSaveStream := nil;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.DataChange(Sender: TObject);
var Stream: TMemoryStream;
    equal: Boolean;
begin
  if FDataLink.Field <> nil then
    if {FDataLink.Field.IsBlob} True then
      if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then begin
        if (FDataSaveStream <> nil) then begin
          Stream := TMemoryStream.Create;
          try
            SaveRVFToStream(Stream, False);
            equal := CompareMem(Stream.Memory, FDataSaveStream.Memory, FDataSaveStream.Size);
          finally
            Stream.Free;
          end;
          if equal then exit;
        end;
        FMemoLoaded := False;
        LoadField;
        end
      else begin
        FMemoLoaded := False;
        Clear;
        AddNL(SysUtils.Format('(%s)', [FDataLink.Field.DisplayLabel]),0,0);
        Format;
        Invalidate;
      end
    else begin
      Clear;
      if FFocused and FDataLink.CanModify then
        AddNL(FDataLink.Field.Text,0,0)
      else
        AddNL(FDataLink.Field.DisplayText,0,0);
      if RVData.Items.Count = 0 then AddNL('',0,0);
      Format;
      Invalidate;
      FMemoLoaded := True;
    end
  else begin
    Clear;
    Format;
    Invalidate;
    FMemoLoaded := False;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not (FDataLink.Editing {FDataLink.CanModify} and FMemoLoaded);
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.UpdateData(Sender: TObject);
var Stream: TMemoryStream;
begin
  if {FDataLink.Field.IsBlob} True then begin
    Stream := TMemoryStream.Create;
    try
      case FieldFormat of
        rvdbRVF:
         begin
           if FAutoDeleteUnusedStyles then
             DeleteUnusedStyles(True, True, True);
           SaveRVFToStream(Stream, False);
         end;
        rvdbRTF:
         begin
           if FAutoDeleteUnusedStyles then
             DeleteUnusedStyles(True, True, True);
           SaveRTFToStream(Stream, False);
         end;
        rvdbText:
          SaveTextToStream('',Stream,80,False,True)
      end;
      Stream.Position := 0;
      (FDataLink.Field as TBlobField).LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if not (rvstClearing in RVData.State) and  not Assigned(FDataLink.Field) {or not FDataLink.Field.IsBlob} then
      FDataLink.Reset;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.CMEnter(var Message: TCMEnter);
begin
//  if not FMemoLoaded then LoadField;
  SetFocused(True);
  inherited;
  if {$IFDEF RICHVIEWCBDEF3}SysLocale.FarEast and{$ENDIF}
     FDataLink.CanModify then
    inherited ReadOnly := False;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  SetFocused(False);
  inherited;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then LoadField;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.DblClick;
begin
  if not FMemoLoaded then
    LoadField
  else
    inherited;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if FMemoLoaded and (Key=#27) then
    FDataLink.Reset;
  if not FMemoLoaded and (Key=#13) then begin
    LoadField;
    Key := #0;
  end;
end;
{-----------------------------------------------------------------------}
procedure TDBRichViewEdit.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;
{-----------------------------------------------------------------------}
function TDBRichViewEdit.BeforeChange(FromOutside: Boolean): Boolean;
begin
  if FMemoLoaded then BeginEditing;
  Result := inherited BeforeChange(FromOutside);
end;
{=======================================================================}
procedure Register;
begin
  RegisterComponents('RichView', [TDBRichView, TDBRichViewEdit]);
end;

end.