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

RichEdit

开发平台:

Delphi

  1. {*******************************************************}
  2. {                                                       }
  3. {       RichView                                        }
  4. {       Demo: drawing RVF fields in TDBGrid             }
  5. {                                                       }
  6. {       Copyright (c) Sergey Tkachenko                  }
  7. {       svt@trichview.com                               }
  8. {       http://www.trichview.com                        }
  9. {                                                       }
  10. {*******************************************************}
  11. {
  12. Tested:
  13. Delphi 2: the code is ok, but will not work on this example database because
  14. RichView does not support loading collections of styles from RVF fields in
  15. Delphi 2
  16. Delphi 3: ok, but minor glitches with drawing because of row height hack
  17. Delphi 7: ok.
  18. }
  19. unit MainFrm;
  20. interface
  21. uses
  22.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  23.   Dialogs, Grids, DBGrids, DB, DBTables, RVScroll, RichView, PtblRV, RVReport,
  24.   RVStyle, StdCtrls, ExtCtrls;
  25. type
  26.   TfrmMain = class(TForm)
  27.     Table1: TTable;
  28.     DataSource1: TDataSource;
  29.     DBGrid1: TDBGrid;
  30.     RVReportHelper1: TRVReportHelper;
  31.     RVStyle1: TRVStyle;
  32.     Panel1: TPanel;
  33.     CheckBox1: TCheckBox;
  34.     procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  35.       DataCol: Integer; Column: TColumn; State: TGridDrawState);
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure DBGrid1EditButtonClick(Sender: TObject);
  38.     procedure CheckBox1Click(Sender: TObject);
  39.   private
  40.     { Private declarations }
  41.     DefRowHeight: Integer;
  42.     function IsRVFField(Field: TField): Boolean;
  43.     procedure SetRowHeight;
  44.   public
  45.     { Public declarations }
  46.   end;
  47. var
  48.   frmMain: TfrmMain;
  49. implementation
  50. uses EditFrm;
  51. {$R *.dfm}
  52. procedure TfrmMain.FormCreate(Sender: TObject);
  53. var i: Integer;
  54. begin
  55.   // Initializing RVReportHelper's properties
  56.   RVReportHelper1.RichView.Style := RVStyle1;
  57.   RVReportHelper1.RichView.Options := RVReportHelper1.RichView.Options + [rvoTagsArePChars];
  58.   // Allowing editing RVF fields
  59.   for i := 0 to DBGrid1.Columns.Count-1 do
  60.     if IsRVFField(DBGrid1.Columns[i].Field) then
  61.       DBGrid1.Columns[i].ButtonStyle := cbsEllipsis;
  62.   DefRowHeight := TDrawGrid(DBGrid1).DefaultRowHeight;
  63.   SetRowHeight;
  64. end;
  65. procedure TfrmMain.SetRowHeight;
  66. begin
  67.   // A hack to change DBGrid row heights. Is it possible without hacks?
  68.   TDrawGrid(DBGrid1).DefaultRowHeight := 100;
  69.   TDrawGrid(DBGrid1).RowHeights[0] := DefRowHeight;
  70. end;
  71. procedure MakeSelected(rvh: TRVReportHelper);
  72. var i: Integer;
  73. begin
  74.   for i := 0 to rvh.RichView.Style.TextStyles.Count-1 do
  75.     rvh.RichView.Style.TextStyles[i].Color := clHighlightText;
  76.   rvh.RichView.Color := clHighlight;
  77. end;
  78. // Drawing RVF field on Canvas at Rect using rvh.
  79. procedure DrawRVFField(field: TBlobField;
  80.   Canvas: TCanvas; const Rect: TRect; rvh: TRVReportHelper;
  81.   Selected: Boolean);
  82. var Stream: TMemoryStream;
  83.     bmp: TBitmap;
  84. begin
  85.   try
  86.     rvh.RichView.Clear;
  87.     rvh.RichView.Color := clWindow;
  88.     Stream := TMemoryStream.Create;
  89.     try
  90.       field.SaveToStream(Stream);
  91.       Stream.Position := 0;
  92.       rvh.RichView.LoadRVFFromStream(Stream)
  93.     finally
  94.       Stream.Free;
  95.     end;
  96.     bmp := TBitmap.Create;
  97.     try
  98.       bmp.Width := Rect.Right-Rect.Left;
  99.       bmp.Height := Rect.Bottom-Rect.Top;
  100.       rvh.Init(bmp.Canvas, bmp.Width);
  101.       rvh.FormatNextPage(1000);
  102.       if Selected then
  103.         MakeSelected(rvh);
  104.       if rvh.PagesCount>0 then begin
  105.         rvh.DrawPage(1, bmp.Canvas, True, bmp.Height);
  106.       end;
  107.       Canvas.Draw(Rect.Left, Rect.Top, bmp);
  108.     finally
  109.       bmp.Free;
  110.     end;
  111.   except
  112.   end;
  113. end;
  114. // Drawing DBGrid RVF cell
  115. procedure TfrmMain.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  116.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  117. begin
  118.   if IsRVFField(Column.Field) then
  119.     DrawRVFField(Column.Field as TBlobField, DBGrid1.Canvas, Rect,
  120.       RVReportHelper1, gdSelected in State);
  121. end;
  122. // Editing
  123. procedure TfrmMain.DBGrid1EditButtonClick(Sender: TObject);
  124. var Stream: TMemoryStream;
  125. begin
  126.   if not IsRVFField(DBGrid1.SelectedField) then
  127.     exit;
  128.   Stream := TMemoryStream.Create;
  129.   try
  130.     (DBGrid1.SelectedField as TBlobField).SaveToStream(Stream);
  131.     Stream.Position := 0;
  132.     frmEdit.RichViewEdit1.LoadRVFFromStream(Stream);
  133.     frmEdit.RichViewEdit1.Format;
  134.   finally
  135.     Stream.Free;
  136.   end;
  137.   frmEdit.ActiveControl := frmEdit.RichViewEdit1;
  138.   if frmEdit.ShowModal=mrOk then begin
  139.     Table1.Edit;
  140.     Stream := TMemoryStream.Create;
  141.     try
  142.       frmEdit.RichViewEdit1.SaveRVFToStream(Stream, False);
  143.       Stream.Position := 0;
  144.       (DBGrid1.SelectedField as TBlobField).LoadFromStream(Stream);
  145.     finally
  146.       Stream.Free;
  147.     end;
  148.   end;
  149. end;
  150. // Is this field a RVF field?
  151. function TfrmMain.IsRVFField(Field: TField): Boolean;
  152. begin
  153.   Result := Field.FieldName='Data';
  154. end;
  155. procedure TfrmMain.CheckBox1Click(Sender: TObject);
  156. begin
  157.   if CheckBox1.Checked then
  158.     DBGrid1.Options := DBGrid1.Options-[dgEditing]
  159.   else
  160.     DBGrid1.Options := DBGrid1.Options+[dgEditing];
  161.   SetRowHeight;
  162. end;
  163. end.