DBRV.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:29k
源码类别:

RichEdit

开发平台:

Delphi

  1. {*******************************************************}
  2. {                                                       }
  3. {       RichView                                        }
  4. {       TDBRichView: displays RVF/RTF/text field in     }
  5. {       a dataset.                                      }
  6. {       TDBRichViewEdit: edits RVF/RTF/text field in    }
  7. {       a dataset.                                      }
  8. {       (registered on "RichView" page of               }
  9. {       the Component Palette)                          }
  10. {                                                       }
  11. {       Copyright (c) Sergey Tkachenko                  }
  12. {       svt@trichview.com                               }
  13. {       http://www.trichview.com                        }
  14. {                                                       }
  15. {*******************************************************}
  16. unit DBRV;
  17. interface
  18. {$I RV_Defs.inc}
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  21.   RVScroll, RichView, RVEdit, DB, DBCtrls, CRVData, CRVFData
  22.   {$IFNDEF RICHVIEWCBDEF3}
  23.   , DBTables
  24.   {$ENDIF}
  25.   ;
  26. type
  27.   TRVDBFieldFormat = (rvdbRVF, rvdbRTF, rvdbText);
  28.   TDBRichView = class(TCustomRichView)
  29.   private
  30.     { Private declarations }
  31.     FDataLink: TFieldDataLink;
  32.     FAutoDisplay: Boolean;
  33.     FFocused: Boolean;
  34.     FMemoLoaded: Boolean;
  35.     FOnNewDocument: TNotifyEvent;
  36.     FOnLoadDocument: TNotifyEvent;
  37.     procedure DataChange(Sender: TObject);
  38.     function GetDataField: string;
  39.     function GetDataSource: TDataSource;
  40.     function GetField: TField;
  41.     procedure SetDataField(const Value: string);
  42.     procedure SetDataSource(Value: TDataSource);
  43.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  44.     procedure SetAutoDisplay(Value: Boolean);
  45.   protected
  46.     { Protected declarations }
  47.     procedure Loaded; override;
  48.     procedure Notification(AComponent: TComponent;
  49.       Operation: TOperation); override;
  50.     procedure DblClick; override;
  51.   public
  52.     { Public declarations }
  53.     constructor Create(AOwner: TComponent); override;
  54.     destructor Destroy; override;
  55.     procedure LoadField;
  56.     property Field: TField read GetField;
  57.   published
  58.     { Published declarations: new for TDBRichView }
  59.     property DataField: string read GetDataField write SetDataField;
  60.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  61.     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
  62.     property OnLoadDocument: TNotifyEvent read FOnLoadDocument write FOnLoadDocument;
  63.     property OnNewDocument: TNotifyEvent read FOnNewDocument write FOnNewDocument;    
  64.     { Published standard properties }
  65.     property Align;
  66.     {$IFDEF RICHVIEWDEF4}
  67.     property Anchors;
  68.     property Constraints;
  69.     {$ENDIF}
  70.     property Color default clNone;
  71.     property Ctl3D;
  72.     {$IFDEF RICHVIEWDEF4}
  73.     property DragKind;
  74.     {$ENDIF}    
  75.     property DragMode;
  76.     property Enabled;
  77.     property HelpContext;
  78.     property ParentCtl3D;
  79.     property ParentShowHint;
  80.     property PopupMenu;    
  81.     property ShowHint;
  82.     property TabOrder;
  83.     property TabStop default True;
  84.     property Visible;
  85.     { Published standard events }
  86.     property OnClick;
  87.     {$IFDEF RICHVIEWDEF5}
  88.     property OnContextPopup;
  89.     {$ENDIF}
  90.     property OnDblClick;
  91.     property OnDragDrop;
  92.     property OnDragOver;
  93.     property OnEndDrag;
  94.     property OnEnter;
  95.     property OnExit;
  96.     property OnKeyDown;
  97.     property OnKeyPress;
  98.     property OnKeyUp;
  99.     property OnMouseMove;
  100.     {$IFDEF RICHVIEWDEF4}
  101.     property OnMouseWheel;
  102.     property OnMouseWheelDown;
  103.     property OnMouseWheelUp;
  104.     property OnResize;    
  105.     {$ENDIF}
  106.     property OnStartDrag;
  107.     { Published RichView properties }
  108.     {$IFNDEF RVDONOTUSEANIMATION}
  109.     property AnimationMode;
  110.     {$ENDIF}    
  111.     property BackgroundBitmap;
  112.     property BackgroundStyle default bsNoBitmap;
  113.     property BiDiMode;
  114.     property BorderStyle default bsSingle;
  115.     property BottomMargin;
  116.     property CPEventKind default cpeNone;
  117.     property Cursor default crDefault;
  118.     property Delimiters;
  119.     //property DocProperties;
  120.     property DoInPaletteMode;
  121.     property FirstJumpNo;
  122.     property HScrollVisible;
  123.     property LeftMargin;
  124.     {$IFNDEF RVDONOTUSELIVESPELL}
  125.     //property LiveSpellingMode;
  126.     {$ENDIF}
  127.     property MaxTextWidth;
  128.     property MinTextWidth;
  129.     property Options;
  130.     property RightMargin;
  131.     property RTFOptions;
  132.     property RTFReadProperties;
  133.     property RVFOptions;
  134.     property RVFParaStylesReadMode;
  135.     property RVFTextStylesReadMode;
  136.     {$IFDEF RVFLATSCROLLBARS}
  137.     property ScrollBarColor;
  138.     property ScrollBarStyle;
  139.     {$ENDIF}
  140.     property Style;
  141.     property TabNavigation;
  142.     property TopMargin;
  143.     property Tracking;
  144.     property UseXPThemes;
  145.     {$IFDEF RICHVIEWDEF3}
  146.     property VAlign;
  147.     {$ENDIF}
  148.     property VScrollVisible;
  149.     {$IFDEF RICHVIEWDEF4}
  150.     property WheelStep;
  151.     {$ENDIF}
  152.     { Published RichView events }
  153.     property OnCheckpointVisible;
  154.     property OnControlAction;
  155.     property OnCopy;
  156.     {$IFDEF RV_ODHC}
  157.     property OnDocumentHeightChange;
  158.     {$ENDIF}
  159.     property OnImportPicture;
  160.     property OnItemAction;
  161.     property OnItemHint;
  162.     property OnJump;
  163.     property OnHScrolled;    
  164.     property OnHTMLSaveImage;
  165.     property OnPaint;
  166.     property OnProgress;
  167.     property OnReadHyperlink;    
  168.     property OnRVDblClick;
  169.     property OnRVFImageListNeeded;
  170.     property OnRVFControlNeeded;
  171.     property OnRVFPictureNeeded;
  172.     property OnRVMouseDown;
  173.     property OnRVMouseMove;
  174.     property OnRVMouseUp;
  175.     property OnRVRightClick;
  176.     property OnSaveComponentToFile;
  177.     property OnSaveHTMLExtra;
  178.     property OnSaveImage2;
  179.     property OnSaveItemToFile;    
  180.     property OnSaveRTFExtra;    
  181.     property OnSelect;
  182.     {$IFNDEF RVDONOTUSELIVESPELL}
  183.     property OnSpellingCheck;
  184.     {$IFDEF RVLIVESPELLEXEVENT}
  185.     property OnSpellingCheckEx;
  186.     {$ENDIF}
  187.     {$ENDIF}    
  188.     property OnVScrolled;
  189.     property OnWriteHyperlink;
  190.     { obsolete properties }
  191.     property AllowSelection;
  192.     property SingleClick;
  193.     property OnURLNeeded;
  194.   end;
  195. {-----------------------------------------------------------------------}
  196.   TDBRichViewEdit = class(TCustomRichViewEdit)
  197.   private
  198.     { Private declarations }
  199.     FDataLink: TFieldDataLink;
  200.     FAutoDisplay: Boolean;
  201.     FFocused: Boolean;
  202.     FMemoLoaded: Boolean;
  203.     FDataSaveStream: TMemoryStream;
  204.     FFieldFormat: TRVDBFieldFormat;
  205.     FAutoDeleteUnusedStyles: Boolean;
  206.     FOnNewDocument: TNotifyEvent;
  207.     FIgnoreEscape: Boolean;
  208.     FOnLoadDocument: TNotifyEvent;
  209.     procedure DataChange(Sender: TObject);
  210.     procedure EditingChange(Sender: TObject);
  211.     function GetDataField: string;
  212.     function GetDataSource: TDataSource;
  213.     function GetField: TField;
  214.     function DBGetReadOnly: Boolean;
  215.     procedure SetDataField(const Value: string);
  216.     procedure SetDataSource(Value: TDataSource);
  217.     procedure SetFocused(Value: Boolean);
  218.     procedure DBSetReadOnly(Value: Boolean);
  219.     procedure SetAutoDisplay(Value: Boolean);
  220.     procedure UpdateData(Sender: TObject);
  221.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  222.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  223.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  224.     procedure BeginEditing;
  225.     procedure DoLoadField(Check: Boolean);
  226.     procedure WMReload(var Msg: TMessage); message WM_RVRELOAD;
  227.   protected
  228.     { Protected declarations }
  229.     procedure Loaded; override;
  230.     procedure Notification(AComponent: TComponent;
  231.       Operation: TOperation); override;
  232.     procedure DblClick; override;
  233.     procedure KeyPress(var Key: Char); override;
  234.   public
  235.     procedure DoChange(ClearRedo: Boolean); override;
  236.     function BeforeChange(FromOutside: Boolean): Boolean; override;
  237.     { Public declarations }
  238.     constructor Create(AOwner: TComponent); override;
  239.     destructor Destroy; override;
  240.     procedure LoadField;
  241.     property Field: TField read GetField;
  242.   published
  243.     { Published declarations: new for TDBRichViewEdit }
  244.     property IgnoreEscape: Boolean read FIgnoreEscape write FIgnoreEscape default False;
  245.     property AutoDeleteUnusedStyles: Boolean read FAutoDeleteUnusedStyles write FAutoDeleteUnusedStyles default False;
  246.     property DataField: string read GetDataField write SetDataField;
  247.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  248.     property ReadOnly: Boolean read DBGetReadOnly write DBSetReadOnly;
  249.     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
  250.     property FieldFormat: TRVDBFieldFormat read FFieldFormat write FFieldFormat default rvdbRVF;
  251.     property OnLoadDocument: TNotifyEvent read FOnLoadDocument write FOnLoadDocument;
  252.     property OnNewDocument: TNotifyEvent read FOnNewDocument write FOnNewDocument;
  253.     { Published declarations: new for TRichViewEdit }
  254.     property AcceptDragDropFormats;
  255.     property EditorOptions;
  256.     property UndoLimit;
  257.     property OnCaretGetOut;
  258.     property OnCaretMove;    
  259.     property OnChange;
  260.     property OnChanging;
  261.     property OnCurParaStyleChanged;
  262.     property OnCurTextStyleChanged;
  263.     {$IFDEF RVONCUT}
  264.     property OnCut;
  265.     {$ENDIF}    
  266.     property OnDropFiles;
  267.     {$IFNDEF RVDONOTUSEDRAGDROP}
  268.     property OnOleDragEnter;
  269.     property OnOleDragLeave;
  270.     property OnOleDragOver;
  271.     property OnOleDrop;    
  272.     {$ENDIF}    
  273.     property OnParaStyleConversion;
  274.     property OnPaste;
  275.     property OnStyleConversion;
  276.     property TabNavigation;
  277.     { Published standard properties }
  278.     property Align;
  279.     {$IFDEF RICHVIEWDEF4}
  280.     property Anchors;
  281.     property Constraints;
  282.     {$ENDIF}
  283.     property Color default clNone;
  284.     property Ctl3D;
  285.     {$IFDEF RICHVIEWDEF4}
  286.     property DragKind;
  287.     {$ENDIF}    
  288.     property DragMode;
  289.     property Enabled;
  290.     property HelpContext;
  291.     property ParentCtl3D;
  292.     property ParentShowHint;
  293.     property PopupMenu;    
  294.     property ShowHint;
  295.     property TabOrder;
  296.     property TabStop default True;
  297.     property UseXPThemes;
  298.     property Visible;
  299.     { Published standard events }
  300.     property OnClick;
  301.     {$IFDEF RICHVIEWDEF5}
  302.     property OnContextPopup;
  303.     {$ENDIF}
  304.     property OnDblClick;
  305.     property OnDragDrop;
  306.     property OnDragOver;
  307.     property OnEndDrag;
  308.     property OnEnter;
  309.     property OnExit;
  310.     property OnKeyDown;
  311.     property OnKeyPress;
  312.     property OnKeyUp;
  313.     property OnMouseMove;
  314.     {$IFDEF RICHVIEWDEF4}
  315.     property OnMouseWheel;
  316.     property OnMouseWheelDown;
  317.     property OnMouseWheelUp;
  318.     property OnResize;    
  319.     {$ENDIF}
  320.     property OnStartDrag;
  321.     { Published RichView properties }
  322.     {$IFNDEF RVDONOTUSEANIMATION}
  323.     property AnimationMode;
  324.     {$ENDIF}    
  325.     property BackgroundBitmap;
  326.     property BackgroundStyle default bsNoBitmap;
  327.     property BiDiMode;
  328.     property BorderStyle default bsSingle;
  329.     property BottomMargin;
  330.     //property CPEventKind;
  331.     property Cursor default crIBeam;
  332.     property Delimiters;
  333.     //property DocProperties;
  334.     property DoInPaletteMode;
  335.     property FirstJumpNo;
  336.     property HScrollVisible;
  337.     property LeftMargin;
  338.     {$IFNDEF RVDONOTUSESMARTPOPUP}
  339.     property OnSmartPopupClick;
  340.     {$ENDIF}
  341.     {$IFNDEF RVDONOTUSELIVESPELL}
  342.     property LiveSpellingMode default rvlspOnChange;
  343.     {$ENDIF}    
  344.     property MaxTextWidth;
  345.     property MinTextWidth;
  346.     property Options;
  347.     property RightMargin;
  348.     property RTFOptions;
  349.     property RTFReadProperties;
  350.     property RVFOptions;
  351.     property RVFParaStylesReadMode;
  352.     property RVFTextStylesReadMode;
  353.     {$IFNDEF RVDONOTUSESMARTPOPUP}
  354.     property SmartPopupProperties;
  355.     {$ENDIF}    
  356.     {$IFDEF RVFLATSCROLLBARS}
  357.     property ScrollBarColor;
  358.     property ScrollBarStyle;
  359.     {$ENDIF}
  360.     property Style;
  361.     //property TabNavigation;
  362.     property TopMargin;
  363.     property Tracking;
  364.     {$IFDEF RICHVIEWDEF3}
  365.     property VAlign;
  366.     {$ENDIF}
  367.     property VScrollVisible;
  368.     {$IFDEF RICHVIEWDEF4}
  369.     property WheelStep;
  370.     {$ENDIF}
  371.     { Published RichView events }
  372.     //property OnCheckpointVisible;
  373.     property OnControlAction;
  374.     property OnCopy;
  375.     {$IFDEF RV_ODHC}
  376.     property OnDocumentHeightChange;
  377.     {$ENDIF}
  378.     property OnImportPicture;
  379.     property OnItemAction;
  380.     property OnItemHint;    
  381.     property OnJump;
  382.     property OnHScrolled;    
  383.     property OnHTMLSaveImage;
  384.     property OnPaint;
  385.     property OnProgress;    
  386.     property OnReadHyperlink;
  387.     property OnRVDblClick;
  388.     property OnRVFImageListNeeded;
  389.     property OnRVFControlNeeded;
  390.     property OnRVFPictureNeeded;
  391.     property OnRVMouseDown;
  392.     property OnRVMouseMove;
  393.     property OnRVMouseUp;
  394.     property OnRVRightClick;
  395.     property OnSaveComponentToFile;
  396.     property OnSaveHTMLExtra;
  397.     property OnSaveImage2;
  398.     property OnSaveItemToFile;
  399.     property OnSaveRTFExtra;
  400.     property OnSelect;
  401.     {$IFNDEF RVDONOTUSELIVESPELL}
  402.     property OnSpellingCheck;
  403.     {$IFDEF RVLIVESPELLEXEVENT}
  404.     property OnSpellingCheckEx;
  405.     {$ENDIF}    
  406.     {$ENDIF}    
  407.     property OnVScrolled;
  408.     property OnWriteHyperlink;
  409.     { obsolete properties }
  410.     property AllowSelection;
  411.     property SingleClick;
  412.     property OnURLNeeded;    
  413.   end;
  414. procedure Register;
  415. implementation
  416. {$IFNDEF RICHVIEWDEF3}
  417. function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
  418. asm
  419.         PUSH    ESI
  420.         PUSH    EDI
  421.         MOV     ESI,P1
  422.         MOV     EDI,P2
  423.         MOV     EDX,ECX
  424.         XOR     EAX,EAX
  425.         AND     EDX,3
  426.         SHR     ECX,2
  427.         REPE    CMPSD
  428.         JNE     @@2
  429.         MOV     ECX,EDX
  430.         REPE    CMPSB
  431.         JNE     @@2
  432. @@1:    INC     EAX
  433. @@2:    POP     EDI
  434.         POP     ESI
  435. end;
  436. {$ENDIF}
  437. {============================DBRichView=================================}
  438. constructor TDBRichView.Create(AOwner: TComponent);
  439. begin
  440.   inherited Create(AOwner);
  441.   FDataLink := TFieldDataLink.Create;
  442.   FDataLink.Control := Self;
  443.   FDataLink.OnDataChange := DataChange;
  444.   FAutoDisplay := True;
  445. end;
  446. {-----------------------------------------------------------------------}
  447. destructor TDBRichView.Destroy;
  448. begin
  449.   FDataLink.Free;
  450.   FDataLink := nil;
  451.   inherited Destroy;
  452. end;
  453. {-----------------------------------------------------------------------}
  454. procedure TDBRichView.Loaded;
  455. begin
  456.   inherited Loaded;
  457.   if (csDesigning in ComponentState) then DataChange(Self);
  458. end;
  459. {-----------------------------------------------------------------------}
  460. procedure TDBRichView.Notification(AComponent: TComponent;
  461.   Operation: TOperation);
  462. begin
  463.   inherited Notification(AComponent, Operation);
  464.   if (Operation = opRemove) and (FDataLink <> nil) and
  465.     (AComponent = DataSource) then DataSource := nil;
  466. end;
  467. {-----------------------------------------------------------------------}
  468. function TDBRichView.GetDataSource: TDataSource;
  469. begin
  470.   Result := FDataLink.DataSource;
  471. end;
  472. {-----------------------------------------------------------------------}
  473. procedure TDBRichView.SetDataSource(Value: TDataSource);
  474. begin
  475.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  476.     FDataLink.DataSource := Value;
  477.   if Value <> nil then Value.FreeNotification(Self);
  478. end;
  479. {-----------------------------------------------------------------------}
  480. function TDBRichView.GetDataField: string;
  481. begin
  482.   Result := FDataLink.FieldName;
  483. end;
  484. {-----------------------------------------------------------------------}
  485. procedure TDBRichView.SetDataField(const Value: string);
  486. begin
  487.   FDataLink.FieldName := Value;
  488. end;
  489. {-----------------------------------------------------------------------}
  490. function TDBRichView.GetField: TField;
  491. begin
  492.   Result := FDataLink.Field;
  493. end;
  494. {-----------------------------------------------------------------------}
  495. procedure TDBRichView.SetAutoDisplay(Value: Boolean);
  496. begin
  497.   if FAutoDisplay <> Value then
  498.   begin
  499.     FAutoDisplay := Value;
  500.     if Value then LoadField;
  501.   end;
  502. end;
  503. {-----------------------------------------------------------------------}
  504. procedure TDBRichView.CMGetDataLink(var Message: TMessage);
  505. begin
  506.   Message.Result := Integer(FDataLink);
  507. end;
  508. {-----------------------------------------------------------------------}
  509. procedure TDBRichView.DblClick;
  510. begin
  511.   if not FMemoLoaded then
  512.     LoadField
  513.   else
  514.     inherited;
  515. end;
  516. {-----------------------------------------------------------------------}
  517. procedure TDBRichView.LoadField;
  518. var Stream: TMemoryStream;
  519. begin
  520.   if not FMemoLoaded and Assigned(FDataLink.Field) then
  521.   begin
  522.     Clear;
  523.     try
  524.       Stream := TMemoryStream.Create;
  525.       try
  526.         (FDataLink.Field as TBlobField).SaveToStream(Stream);
  527.         if Assigned(FOnNewDocument) then
  528.           FOnNewDocument(Self);
  529.         Stream.Position := 0;
  530.         LoadFromStream(Stream, rvynaNo);
  531.         if Assigned(FOnLoadDocument) then
  532.           FOnLoadDocument(Self);
  533.       finally
  534.         Stream.Free;
  535.       end;
  536.       if RVData.Items.Count = 0 then AddNLATag('',0,0,0);
  537.       FMemoLoaded := True;
  538.     except
  539.       on E:EInvalidOperation do
  540.         AddNLATag(SysUtils.Format('(%s)', [E.Message]),0,0,0);
  541.     end;
  542.     Format;
  543.     Invalidate;
  544.   end;
  545. end;
  546. {-----------------------------------------------------------------------}
  547. procedure TDBRichView.DataChange(Sender: TObject);
  548. begin
  549.   if FDataLink.Field <> nil then
  550.     if {FDataLink.Field.IsBlob} True then
  551.       if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then begin
  552.         FMemoLoaded := False;
  553.         LoadField;
  554.         end
  555.       else begin
  556.         FMemoLoaded := False;
  557.         Clear;
  558.         AddNLATag(SysUtils.Format('(%s)', [FDataLink.Field.DisplayLabel]),0,0,0);
  559.         Format;
  560.         Invalidate;
  561.       end
  562.     else begin
  563.       Clear;
  564.       if FFocused and FDataLink.CanModify then
  565.         AddNLATag(FDataLink.Field.Text,0,0,0)
  566.       else
  567.         AddNLATag(FDataLink.Field.DisplayText,0,0,0);
  568.       if RVData.Items.Count = 0 then AddNLATag('',0,0,0);
  569.       Format;
  570.       Invalidate;
  571.       FMemoLoaded := True;
  572.     end
  573.   else begin
  574.     Clear;
  575.     Format;
  576.     Invalidate;
  577.     FMemoLoaded := False;
  578.   end;
  579. end;
  580. {==========================DBRichViewEdit===============================}
  581. constructor TDBRichViewEdit.Create(AOwner: TComponent);
  582. begin
  583.   inherited Create(AOwner);
  584.   inherited ReadOnly := True;
  585.   FieldFormat := rvdbRVF;
  586.   FAutoDisplay := True;
  587.   FDataLink := TFieldDataLink.Create;
  588.   FDataLink.Control := Self;
  589.   FDataLink.OnDataChange := DataChange;
  590.   FDataLink.OnEditingChange := EditingChange;
  591.   FDataLink.OnUpdateData := UpdateData;
  592.   FDataSaveStream := nil;
  593.   RVData.Flags := RVData.Flags + [rvflDBRichViewEdit];
  594. end;
  595. {-----------------------------------------------------------------------}
  596. destructor TDBRichViewEdit.Destroy;
  597. begin
  598.   FDataSaveStream.Free;
  599.   FDataLink.Free;
  600.   FDataLink := nil;
  601.   inherited Destroy;
  602. end;
  603. {-----------------------------------------------------------------------}
  604. procedure TDBRichViewEdit.Loaded;
  605. begin
  606.   inherited Loaded;
  607.   if (csDesigning in ComponentState) then DataChange(Self);
  608. end;
  609. {-----------------------------------------------------------------------}
  610. procedure TDBRichViewEdit.Notification(AComponent: TComponent;
  611.   Operation: TOperation);
  612. begin
  613.   inherited Notification(AComponent, Operation);
  614.   if (Operation = opRemove) and (FDataLink <> nil) and
  615.     (AComponent = DataSource) then DataSource := nil;
  616. end;
  617. {-----------------------------------------------------------------------}
  618. procedure TDBRichViewEdit.DoChange(ClearRedo: Boolean);
  619. begin
  620.   if FMemoLoaded then FDataLink.Modified;
  621.   inherited DoChange(ClearRedo);
  622. end;
  623. {-----------------------------------------------------------------------}
  624. function TDBRichViewEdit.GetDataSource: TDataSource;
  625. begin
  626.   Result := FDataLink.DataSource;
  627. end;
  628. {-----------------------------------------------------------------------}
  629. procedure TDBRichViewEdit.SetDataSource(Value: TDataSource);
  630. begin
  631.   FDataLink.DataSource := Value;
  632.   if Value <> nil then Value.FreeNotification(Self);
  633. end;
  634. {-----------------------------------------------------------------------}
  635. function TDBRichViewEdit.GetDataField: string;
  636. begin
  637.   Result := FDataLink.FieldName;
  638. end;
  639. {-----------------------------------------------------------------------}
  640. procedure TDBRichViewEdit.SetDataField(const Value: string);
  641. begin
  642.   FDataLink.FieldName := Value;
  643. end;
  644. {-----------------------------------------------------------------------}
  645. function TDBRichViewEdit.DBGetReadOnly: Boolean;
  646. begin
  647.   Result := FDataLink.ReadOnly;
  648. end;
  649. {-----------------------------------------------------------------------}
  650. procedure TDBRichViewEdit.DBSetReadOnly(Value: Boolean);
  651. begin
  652.   FDataLink.ReadOnly := Value;
  653. end;
  654. {-----------------------------------------------------------------------}
  655. function TDBRichViewEdit.GetField: TField;
  656. begin
  657.   Result := FDataLink.Field;
  658. end;
  659. {-----------------------------------------------------------------------}
  660. procedure TDBRichViewEdit.LoadField;
  661. begin
  662.   DoLoadField(FMemoLoaded);
  663. end;
  664. {-----------------------------------------------------------------------}
  665. procedure TDBRichViewEdit.DoLoadField(Check: Boolean);
  666. var Stream, Stream2: TMemoryStream;
  667.     sf, equal: Boolean;
  668.     {..............................}
  669.     function HasFocus: Boolean;
  670.     var ctrl: TWinControl;
  671.     begin
  672.       Result := True;
  673.       ctrl := Self;
  674.       while ctrl<>nil do begin
  675.         if ctrl.Focused then
  676.           exit;
  677.         if ctrl is TCustomRichViewEdit then
  678.           ctrl := TCustomRichViewEdit(ctrl).InplaceEditor
  679.         else
  680.           ctrl := nil;
  681.       end;
  682.       Result := False;;
  683.     end;
  684.     {..............................}
  685. begin
  686.   if not FMemoLoaded and Assigned(FDataLink.Field) {and FDataLink.Field.IsBlob} then
  687.   begin
  688.     equal := False;
  689.     sf := HasFocus;
  690.     try
  691.       Stream := TMemoryStream.Create;
  692.       try
  693.         (FDataLink.Field as TBlobField).SaveToStream(Stream);
  694.         Stream.Position := 0;
  695.         if Check and (FieldFormat=rvdbRVF) then begin
  696.           Stream2 := TMemoryStream.Create;
  697.           try
  698.             SaveRVFToStream(Stream2, False);
  699.             equal := (Stream.Size=Stream2.Size) and
  700.               CompareMem(Stream.Memory, Stream2.Memory, Stream.Size);
  701.           finally
  702.             Stream2.Free;
  703.           end;
  704.         end;
  705.         if not equal then begin
  706.           Clear;
  707.           if FAutoDeleteUnusedStyles then
  708.             DeleteUnusedStyles(True, True, True);
  709.           if Assigned(FOnNewDocument) then
  710.             FOnNewDocument(Self);
  711.           LoadFromStream(Stream, rvynaAuto);
  712.           if Assigned(FOnLoadDocument) then
  713.             FOnLoadDocument(Self);
  714.         end;
  715.       finally
  716.         Stream.Free;
  717.       end;
  718.       if RVData.Items.Count = 0 then AddNLATag('',0,0,0);
  719.       FMemoLoaded := True;
  720.     except
  721.       on E:EInvalidOperation do
  722.         AddNLATag(SysUtils.Format('(%s)', [E.Message]),0,0,0);
  723.     end;
  724.     if not equal then begin
  725.       Format;
  726.       if sf then
  727.         Windows.SetFocus(Handle);
  728.       Invalidate;
  729.     end;
  730.     EditingChange(Self);
  731.   end;
  732. end;
  733. {-----------------------------------------------------------------------}
  734. procedure TDBRichViewEdit.BeginEditing;
  735. begin
  736.   if not FDataLink.Editing then
  737.   try
  738.     if {FDataLink.Field.IsBlob} True then begin
  739.       if FDataSaveStream=nil then
  740.         FDataSaveStream := TMemoryStream.Create
  741.       else
  742.         FDataSaveStream.Clear;
  743.       (FDataLink.Field as TBlobField).SaveToStream(FDataSaveStream);
  744.     end;
  745.     FDataLink.Edit;
  746.   finally
  747.     FDataSaveStream.Free;
  748.     FDataSaveStream := nil;
  749.   end;
  750. end;
  751. {-----------------------------------------------------------------------}
  752. procedure TDBRichViewEdit.DataChange(Sender: TObject);
  753. var Stream: TMemoryStream;
  754.     equal, ml: Boolean;
  755. begin
  756.   if FDataLink.Field <> nil then begin
  757.     if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then begin
  758.       if (FDataSaveStream <> nil) then begin
  759.         Stream := TMemoryStream.Create;
  760.         try
  761.           (FDataLink.Field as TBlobField).SaveToStream(Stream);
  762.           equal := (Stream.Size=FDataSaveStream.Size) and
  763.             CompareMem(Stream.Memory, FDataSaveStream.Memory, FDataSaveStream.Size);
  764.         finally
  765.           Stream.Free;
  766.         end;
  767.         if equal then exit;
  768.         PostMessage(Handle, WM_RVRELOAD, 0, 0);
  769.         exit;
  770.       end;
  771.       ml := FMemoLoaded;
  772.       FMemoLoaded := False;
  773.       DoLoadField(ml);
  774.       end
  775.     else begin
  776.       FMemoLoaded := False;
  777.       Clear;
  778.       AddNLATag(SysUtils.Format('(%s)', [FDataLink.Field.DisplayLabel]),0,0,0);
  779.       Format;
  780.       Invalidate;
  781.     end;
  782.     end
  783.   else begin
  784.     Clear;
  785.     Format;
  786.     Invalidate;
  787.     FMemoLoaded := False;
  788.   end;
  789. end;
  790. {-----------------------------------------------------------------------}
  791. procedure TDBRichViewEdit.WMReload(var Msg: TMessage);
  792. var ml: Boolean;
  793. begin
  794.   ml := FMemoLoaded;
  795.   FMemoLoaded := False;
  796.   DoLoadField(ml);
  797. end;
  798. {-----------------------------------------------------------------------}
  799. procedure TDBRichViewEdit.EditingChange(Sender: TObject);
  800. begin
  801.   inherited ReadOnly := not (FDataLink.Editing {FDataLink.CanModify} and FMemoLoaded);
  802. end;
  803. {-----------------------------------------------------------------------}
  804. procedure TDBRichViewEdit.UpdateData(Sender: TObject);
  805. var Stream: TMemoryStream;
  806. begin
  807.   if {FDataLink.Field.IsBlob} True then begin
  808.     Stream := TMemoryStream.Create;
  809.     try
  810.       case FieldFormat of
  811.         rvdbRVF {$IFDEF RVDONOTUSERTF}, rvdbRTF{$ENDIF}:
  812.          begin
  813.            if FAutoDeleteUnusedStyles then
  814.              DeleteUnusedStyles(True, True, True);
  815.            SaveRVFToStream(Stream, False);
  816.          end;
  817.         {$IFNDEF RVDONOTUSERTF}
  818.         rvdbRTF:
  819.          begin
  820.            if FAutoDeleteUnusedStyles then
  821.              DeleteUnusedStyles(True, True, True);
  822.            SaveRTFToStream(Stream, False);
  823.          end;
  824.         {$ENDIF}
  825.         rvdbText:
  826.           SaveTextToStream('',Stream,80,False,True)
  827.       end;
  828.       Stream.Position := 0;
  829.       (FDataLink.Field as TBlobField).LoadFromStream(Stream);
  830.     finally
  831.       Stream.Free;
  832.     end;
  833.   end;
  834. end;
  835. {-----------------------------------------------------------------------}
  836. procedure TDBRichViewEdit.SetFocused(Value: Boolean);
  837. begin
  838.   if FFocused <> Value then
  839.   begin
  840.     FFocused := Value;
  841.     if not (rvstClearing in RVData.State) and  not Assigned(FDataLink.Field) {or not FDataLink.Field.IsBlob} then
  842.       FDataLink.Reset;
  843.   end;
  844. end;
  845. {-----------------------------------------------------------------------}
  846. procedure TDBRichViewEdit.CMEnter(var Message: TCMEnter);
  847. begin
  848. //  if not FMemoLoaded then LoadField;
  849.   SetFocused(True);
  850.   inherited;
  851.   if {$IFDEF RICHVIEWCBDEF3}SysLocale.FarEast and{$ENDIF}
  852.      FDataLink.CanModify then
  853.     inherited ReadOnly := False;
  854. end;
  855. {-----------------------------------------------------------------------}
  856. procedure TDBRichViewEdit.CMExit(var Message: TCMExit);
  857. begin
  858.   try
  859.     with FDataLink do
  860.       if (DataSet <> nil) and (DataSet.State in dsEditModes) then
  861.     FDataLink.UpdateRecord;
  862.   except
  863.     SetFocus;
  864.     raise;
  865.   end;
  866.   SetFocused(False);
  867.   inherited;
  868. end;
  869. {-----------------------------------------------------------------------}
  870. procedure TDBRichViewEdit.SetAutoDisplay(Value: Boolean);
  871. begin
  872.   if FAutoDisplay <> Value then
  873.   begin
  874.     FAutoDisplay := Value;
  875.     if Value then
  876.       DoLoadField(FMemoLoaded);
  877.   end;
  878. end;
  879. {-----------------------------------------------------------------------}
  880. procedure TDBRichViewEdit.DblClick;
  881. begin
  882.   if not FMemoLoaded then
  883.     DoLoadField(FMemoLoaded)
  884.   else
  885.     inherited;
  886. end;
  887. {-----------------------------------------------------------------------}
  888. procedure TDBRichViewEdit.KeyPress(var Key: Char);
  889. begin
  890.   inherited KeyPress(Key);
  891.   if FMemoLoaded and (Key=#27) and not IgnoreEscape then
  892.     FDataLink.Reset;
  893.   if not FMemoLoaded and (Key=#13) then begin
  894.     DoLoadField(FMemoLoaded);
  895.     Key := #0;
  896.   end;
  897. end;
  898. {-----------------------------------------------------------------------}
  899. procedure TDBRichViewEdit.CMGetDataLink(var Message: TMessage);
  900. begin
  901.   Message.Result := Integer(FDataLink);
  902. end;
  903. {-----------------------------------------------------------------------}
  904. function TDBRichViewEdit.BeforeChange(FromOutside: Boolean): Boolean;
  905. begin
  906.   if FMemoLoaded then BeginEditing;
  907.   Result := inherited BeforeChange(FromOutside);
  908. end;
  909. {=======================================================================}
  910. procedure Register;
  911. begin
  912.   RegisterComponents('RichView', [TDBRichView, TDBRichViewEdit]);
  913. end;
  914. end.