home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / DBRICHED.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  14KB  |  540 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1997, 1998 Master-Bank          }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit DBRichEd;
  10.  
  11. interface
  12.  
  13. {$IFDEF WIN32}
  14.  
  15. {$I RX.INC}
  16.  
  17. uses
  18.   Windows, Messages, ComCtrls, CommCtrl, RichEdit, SysUtils, Classes,
  19.   Graphics, Controls, Menus, StdCtrls, DB, {$IFNDEF RX_D3} DBTables, {$ENDIF}
  20.   RxRichEd, DBCtrls;
  21.  
  22. type
  23.   TRxDBRichEdit = class(TRxCustomRichEdit)
  24.   private
  25.     FDataLink: TFieldDataLink;
  26.     FUpdating: Boolean;
  27.     FStateChanging: Boolean;
  28.     FMemoLoaded: Boolean;
  29.     FAutoDisplay: Boolean;
  30.     FFocused: Boolean;
  31.     FDataSave: string;
  32.     function GetField: TField;
  33.     function GetDataField: string;
  34.     function GetDataSource: TDataSource;
  35.     function GetReadOnly: Boolean;
  36.     procedure SetReadOnly(Value: Boolean);
  37.     procedure SetDataField(const Value: string);
  38.     procedure SetDataSource(Value: TDataSource);
  39.     procedure SetAutoDisplay(Value: Boolean);
  40.     procedure SetFocused(Value: Boolean);
  41.     procedure DataChange(Sender: TObject);
  42.     procedure UpdateData(Sender: TObject);
  43.     procedure EditingChange(Sender: TObject);
  44.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  45.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  46.     procedure WMCut(var Message: TMessage); message WM_CUT;
  47.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  48.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  49.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  50.     procedure EMSetCharFormat(var Message: TMessage); message EM_SETCHARFORMAT;
  51.     procedure EMSetParaFormat(var Message: TMessage); message EM_SETPARAFORMAT;
  52.   protected
  53.     procedure Change; override;
  54.     function EditCanModify: Boolean; virtual;
  55.     procedure Loaded; override;
  56.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  57.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  58.     procedure KeyPress(var Key: Char); override;
  59.     procedure SetPlainText(Value: Boolean); override;
  60.   public
  61.     constructor Create(AOwner: TComponent); override;
  62.     destructor Destroy; override;
  63.     procedure LoadMemo; virtual;
  64.     procedure UpdateMemo;
  65. {$IFDEF RX_D4}
  66.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  67.     function UpdateAction(Action: TBasicAction): Boolean; override;
  68.     function UseRightToLeftAlignment: Boolean; override;
  69. {$ENDIF}
  70.     property Field: TField read GetField;
  71.     property Lines;
  72.   published
  73.     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
  74.     property DataField: string read GetDataField write SetDataField;
  75.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  76.     property Align;
  77.     property Alignment;
  78.     property AllowObjects;
  79. {$IFDEF RX_D3}
  80.     property AllowInPlace;
  81. {$ENDIF}
  82.     property AutoURLDetect;
  83.     property AutoVerbMenu;
  84.     property BorderStyle;
  85.     property Color;
  86.     property Ctl3D;
  87.     property DragCursor;
  88.     property DragMode;
  89.     property Enabled;
  90.     property Font;
  91.     property HideSelection;
  92.     property HideScrollBars;
  93. {$IFDEF RX_D4}
  94.     property Anchors;
  95.     property BiDiMode;
  96.     property Constraints;
  97.     property DragKind;
  98.     property ParentBiDiMode;
  99. {$ENDIF}
  100. {$IFNDEF VER90}
  101.     property ImeMode;
  102.     property ImeName;
  103. {$ENDIF}
  104.     property LangOptions;
  105.     property MaxLength;
  106.     property ParentColor;
  107.     property ParentCtl3D;
  108.     property ParentFont;
  109.     property ParentShowHint;
  110.     property PlainText;
  111.     property PopupMenu;
  112.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  113.     property ScrollBars;
  114.     property ShowHint;
  115.     property SelectionBar;
  116.     property StreamFormat;
  117.     property StreamMode;
  118.     property TabOrder;
  119.     property TabStop default True;
  120.     property Title;
  121.     property UndoLimit;
  122.     property Visible;
  123.     property WantReturns;
  124.     property WantTabs;
  125.     property WordSelection;
  126.     property WordWrap;
  127.     property OnChange;
  128.     property OnClick;
  129.     property OnDblClick;
  130.     property OnDragDrop;
  131.     property OnDragOver;
  132.     property OnEndDrag;
  133.     property OnEnter;
  134.     property OnExit;
  135.     property OnKeyDown;
  136.     property OnKeyPress;
  137.     property OnKeyUp;
  138.     property OnMouseDown;
  139.     property OnMouseMove;
  140.     property OnMouseUp;
  141.     property OnResizeRequest;
  142.     property OnSelectionChange;
  143.     property OnProtectChange; { obsolete }
  144.     property OnProtectChangeEx;
  145.     property OnSaveClipboard;
  146.     property OnStartDrag;
  147. {$IFDEF RX_D5}
  148.     property OnContextPopup;
  149. {$ENDIF}
  150. {$IFDEF RX_D4}
  151.     property OnMouseWheel;
  152.     property OnMouseWheelDown;
  153.     property OnMouseWheelUp;
  154.     property OnEndDock;
  155.     property OnStartDock;
  156. {$ENDIF}
  157.     property OnTextNotFound;
  158. {$IFDEF RX_D3}
  159.     property OnCloseFindDialog;
  160. {$ENDIF}
  161.     property OnURLClick;
  162.   end;
  163.  
  164. {$ENDIF}
  165.  
  166. implementation
  167.  
  168. {$IFDEF WIN32}
  169.  
  170. { TRxDBRichEdit }
  171.  
  172. constructor TRxDBRichEdit.Create(AOwner: TComponent);
  173. begin
  174.   inherited Create(AOwner);
  175.   inherited ReadOnly := True;
  176.   FAutoDisplay := True;
  177.   FDataLink := TFieldDataLink.Create;
  178.   FDataLink.Control := Self;
  179.   FDataLink.OnDataChange := DataChange;
  180.   FDataLink.OnEditingChange := EditingChange;
  181.   FDataLink.OnUpdateData := UpdateData;
  182. end;
  183.  
  184. destructor TRxDBRichEdit.Destroy;
  185. begin
  186.   FDataLink.Free;
  187.   FDataLink := nil;
  188.   inherited Destroy;
  189. end;
  190.  
  191. procedure TRxDBRichEdit.Loaded;
  192. begin
  193.   inherited Loaded;
  194.   if (csDesigning in ComponentState) then DataChange(Self);
  195. end;
  196.  
  197. procedure TRxDBRichEdit.Notification(AComponent: TComponent; Operation: TOperation);
  198. begin
  199.   inherited Notification(AComponent, Operation);
  200.   if (Operation = opRemove) and (FDataLink <> nil) and
  201.     (AComponent = DataSource) then DataSource := nil;
  202. end;
  203.  
  204. {$IFDEF RX_D4}
  205. function TRxDBRichEdit.UseRightToLeftAlignment: Boolean;
  206. begin
  207.   Result := DBUseRightToLeftAlignment(Self, Field);
  208. end;
  209. {$ENDIF}
  210.  
  211. function TRxDBRichEdit.EditCanModify: Boolean;
  212. begin
  213.   FStateChanging := True;
  214.   try
  215.     Result := FDataLink.Editing;
  216.     if not Result and Assigned(FDataLink.Field) then
  217.     try
  218. {$IFDEF RX_D3}
  219.       if FDataLink.Field.IsBlob then
  220. {$ELSE}
  221.       if FDataLink.Field is TBlobField then
  222. {$ENDIF}
  223.         FDataSave := FDataLink.Field.AsString;
  224.       Result := FDataLink.Edit;
  225.     finally
  226.       FDataSave := '';
  227.     end;
  228.   finally
  229.     FStateChanging := False;
  230.   end;
  231. end;
  232.  
  233. procedure TRxDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
  234. begin
  235.   inherited KeyDown(Key, Shift);
  236.   if FMemoLoaded then begin
  237.     if (Key in [VK_DELETE, VK_BACK, VK_CLEAR]) or
  238.       ((Key = VK_INSERT) and (ssShift in Shift)) or
  239.       (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
  240.       EditCanModify;
  241.   end
  242.   else Key := 0;
  243. end;
  244.  
  245. procedure TRxDBRichEdit.KeyPress(var Key: Char);
  246. begin
  247.   inherited KeyPress(Key);
  248.   if FMemoLoaded then begin
  249.     if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  250.       not FDataLink.Field.IsValidChar(Key) then
  251.     begin
  252.       MessageBeep(0);
  253.       Key := #0;
  254.     end;
  255.     case Key of
  256.       ^H, ^I, ^J, ^M, ^V, ^X, #32..#255: EditCanModify;
  257.       #27: FDataLink.Reset;
  258.     end;
  259.   end
  260.   else begin
  261.     if Key = Chr(VK_RETURN) then LoadMemo;
  262.     if FMemoLoaded then Key := #0;
  263.   end;
  264. end;
  265.  
  266. procedure TRxDBRichEdit.Change;
  267. begin
  268.   if FMemoLoaded then FDataLink.Modified;
  269.   FMemoLoaded := True;
  270.   inherited Change;
  271. end;
  272.  
  273. function TRxDBRichEdit.GetDataSource: TDataSource;
  274. begin
  275.   Result := FDataLink.DataSource;
  276. end;
  277.  
  278. procedure TRxDBRichEdit.SetDataSource(Value: TDataSource);
  279. begin
  280.   FDataLink.DataSource := Value;
  281.   if Value <> nil then Value.FreeNotification(Self);
  282. end;
  283.  
  284. function TRxDBRichEdit.GetDataField: string;
  285. begin
  286.   Result := FDataLink.FieldName;
  287. end;
  288.  
  289. procedure TRxDBRichEdit.SetDataField(const Value: string);
  290. begin
  291.   FDataLink.FieldName := Value;
  292. end;
  293.  
  294. function TRxDBRichEdit.GetReadOnly: Boolean;
  295. begin
  296.   Result := FDataLink.ReadOnly;
  297. end;
  298.  
  299. procedure TRxDBRichEdit.SetReadOnly(Value: Boolean);
  300. begin
  301.   FDataLink.ReadOnly := Value;
  302. end;
  303.  
  304. function TRxDBRichEdit.GetField: TField;
  305. begin
  306.   Result := FDataLink.Field;
  307. end;
  308.  
  309. procedure TRxDBRichEdit.LoadMemo;
  310. {$IFDEF RX_D3}
  311. begin
  312.   if FMemoLoaded or (FDataLink.Field = nil) or not
  313.     FDataLink.Field.IsBlob then Exit;
  314.   FUpdating := True;
  315.   try
  316.     try
  317.       Lines.Assign(FDataLink.Field);
  318.       FMemoLoaded := True;
  319.     except
  320.       on E: EOutOfResources do
  321.         Lines.Text := Format('(%s)', [E.Message]);
  322.     end;
  323.     EditingChange(Self);
  324.   finally
  325.     FUpdating := False;
  326.   end;
  327. {$ELSE}
  328. var
  329.   Stream: TBlobStream;
  330. begin
  331.   if FMemoLoaded or (FDataLink.Field = nil) or not
  332.     (FDataLink.Field is TBlobField) then Exit;
  333.   FUpdating := True;
  334.   try
  335.     Stream := TBlobStream.Create(TBlobField(FDataLink.Field), bmRead);
  336.     try
  337.       try
  338.         Lines.LoadFromStream(Stream);
  339.         FMemoLoaded := True;
  340.       except
  341.         on E: EOutOfResources do
  342.           Lines.Text := Format('(%s)', [E.Message]);
  343.       end;
  344.     finally
  345.       Stream.Free;
  346.     end;
  347.     EditingChange(Self);
  348.   finally
  349.     FUpdating := False;
  350.   end;
  351. {$ENDIF}
  352. end;
  353.  
  354. procedure TRxDBRichEdit.DataChange(Sender: TObject);
  355. begin
  356.   if FDataLink.Field = nil then begin
  357.     if (csDesigning in ComponentState) then Text := Name
  358.     else Text := '';
  359.     FMemoLoaded := False;
  360.   end
  361. {$IFDEF RX_D3}
  362.   else if FDataLink.Field.IsBlob then begin
  363. {$ELSE}
  364.   else if FDataLink.Field is TBlobField then begin
  365. {$ENDIF}
  366.     if AutoDisplay or (FDataLink.Editing and FMemoLoaded) then
  367.     begin
  368.       { Check if the data has changed since we read it the first time }
  369.       if FStateChanging and (FDataSave <> '') and
  370.         (FDataSave = FDataLink.Field.AsString) then Exit;
  371.       FMemoLoaded := False;
  372.       LoadMemo;
  373.     end
  374.     else begin
  375.       Text := Format('(%s)', [FDataLink.Field.DisplayLabel]);
  376.       FMemoLoaded := False;
  377.     end;
  378.   end
  379.   else if FDataLink.CanModify then begin
  380.     if not FStateChanging then begin
  381.       inherited SetPlainText(True);
  382.       if FFocused then Text := FDataLink.Field.Text
  383.       else Text := FDataLink.Field.DisplayText;
  384.       FMemoLoaded := True;
  385.     end;
  386.   end
  387.   else begin
  388.     inherited SetPlainText(True);
  389.     Text := FDataLink.Field.DisplayText;
  390.     FMemoLoaded := True;
  391.   end;
  392.   if HandleAllocated then
  393.     RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
  394. end;
  395.  
  396. procedure TRxDBRichEdit.EditingChange(Sender: TObject);
  397. begin
  398.   inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
  399. end;
  400.  
  401. procedure TRxDBRichEdit.UpdateData(Sender: TObject);
  402. {$IFDEF RX_D3}
  403. begin
  404.   if (FDataLink.Field <> nil) then begin
  405.     if FDataLink.Field.IsBlob then FDataLink.Field.Assign(Lines)
  406.     else FDataLink.Field.AsString := Text;
  407.   end;
  408. {$ELSE}
  409. var
  410.   Stream: TBlobStream;
  411. begin
  412.   if FDataLink.Field is TBlobField then begin
  413.     Stream := TBlobStream.Create(TBlobField(FDataLink.Field), bmWrite);
  414.     try
  415.       if Lines.Count > 0 then Lines.SaveToStream(Stream);
  416.     finally
  417.       Stream.Free;
  418.     end;
  419.   end
  420.   else FDataLink.Field.AsString := Text;
  421. {$ENDIF}
  422. end;
  423.  
  424. procedure TRxDBRichEdit.SetFocused(Value: Boolean);
  425. begin
  426.   if FFocused <> Value then begin
  427.     FFocused := Value;
  428.     if not Assigned(FDataLink.Field) or not
  429. {$IFDEF RX_D3}
  430.       FDataLink.Field.IsBlob then
  431. {$ELSE}
  432.       (FDataLink.Field is TBlobField) then
  433. {$ENDIF}
  434.       FDataLink.Reset;
  435.   end;
  436. end;
  437.  
  438. procedure TRxDBRichEdit.CMEnter(var Message: TCMEnter);
  439. begin
  440.   SetFocused(True);
  441.   inherited;
  442. {$IFDEF RX_D3}
  443.   if SysLocale.FarEast and FDataLink.CanModify then
  444.     inherited ReadOnly := False;
  445. {$ENDIF RX_D3}
  446. end;
  447.  
  448. procedure TRxDBRichEdit.CMExit(var Message: TCMExit);
  449. begin
  450.   try
  451.     FDataLink.UpdateRecord;
  452.   except
  453.     if CanFocus then SetFocus;
  454.     raise;
  455.   end;
  456.   SetFocused(False);
  457.   inherited;
  458. end;
  459.  
  460. procedure TRxDBRichEdit.SetAutoDisplay(Value: Boolean);
  461. begin
  462.   if Value <> FAutoDisplay then begin
  463.     FAutoDisplay := Value;
  464.     if FAutoDisplay then LoadMemo;
  465.   end;
  466. end;
  467.  
  468. procedure TRxDBRichEdit.SetPlainText(Value: Boolean);
  469. begin
  470.   if PlainText <> Value then begin
  471.     inherited SetPlainText(Value);
  472.     if FMemoLoaded then FDataLink.Reset;
  473.   end;
  474. end;
  475.  
  476. procedure TRxDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  477. begin
  478.   if not FMemoLoaded then LoadMemo
  479.   else inherited;
  480. end;
  481.  
  482. procedure TRxDBRichEdit.WMCut(var Message: TMessage);
  483. begin
  484.   EditCanModify;
  485.   inherited;
  486. end;
  487.  
  488. procedure TRxDBRichEdit.WMPaste(var Message: TMessage);
  489. begin
  490.   EditCanModify;
  491.   inherited;
  492. end;
  493.  
  494. procedure TRxDBRichEdit.CMGetDataLink(var Message: TMessage);
  495. begin
  496.   Message.Result := Longint(FDataLink);
  497. end;
  498.  
  499. procedure TRxDBRichEdit.UpdateMemo;
  500. begin
  501.   if FDataLink.Editing and FMemoLoaded then UpdateData(Self);
  502. end;
  503.  
  504. {$IFDEF RX_D4}
  505. function TRxDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
  506. begin
  507.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  508.     FDataLink.ExecuteAction(Action);
  509. end;
  510.  
  511. function TRxDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
  512. begin
  513.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  514.     FDataLink.UpdateAction(Action);
  515. end;
  516. {$ENDIF}
  517.  
  518. procedure TRxDBRichEdit.EMSetCharFormat(var Message: TMessage);
  519. begin
  520.   if FMemoLoaded then begin
  521.     if not FUpdating then begin
  522.       if EditCanModify then Change;
  523.     end;
  524.   end;
  525.   inherited;
  526. end;
  527.  
  528. procedure TRxDBRichEdit.EMSetParaFormat(var Message: TMessage);
  529. begin
  530.   if FMemoLoaded then begin
  531.     if not FUpdating then begin
  532.       if EditCanModify then Change;
  533.     end;
  534.   end;
  535.   inherited;
  536. end;
  537.  
  538. {$ENDIF WIN32}
  539.  
  540. end.