{*******************************************************} { } { RichView } { Demo: drawing RVF fields in TDBGrid } { } { Copyright (c) Sergey Tkachenko } { svt@trichview.com } { http://www.trichview.com } { } {*******************************************************} { Tested: Delphi 2: the code is ok, but will not work on this example database because RichView does not support loading collections of styles from RVF fields in Delphi 2 Delphi 3: ok, but minor glitches with drawing because of row height hack Delphi 7: ok. } unit MainFrm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, DB, DBTables, RVScroll, RichView, PtblRV, RVReport, RVStyle, StdCtrls, ExtCtrls; type TfrmMain = class(TForm) Table1: TTable; DataSource1: TDataSource; DBGrid1: TDBGrid; RVReportHelper1: TRVReportHelper; RVStyle1: TRVStyle; Panel1: TPanel; CheckBox1: TCheckBox; procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); procedure FormCreate(Sender: TObject); procedure DBGrid1EditButtonClick(Sender: TObject); procedure CheckBox1Click(Sender: TObject); private { Private declarations } DefRowHeight: Integer; function IsRVFField(Field: TField): Boolean; procedure SetRowHeight; public { Public declarations } end; var frmMain: TfrmMain; implementation uses EditFrm; {$R *.dfm} procedure TfrmMain.FormCreate(Sender: TObject); var i: Integer; begin // Initializing RVReportHelper's properties RVReportHelper1.RichView.Style := RVStyle1; RVReportHelper1.RichView.Options := RVReportHelper1.RichView.Options + [rvoTagsArePChars]; // Allowing editing RVF fields for i := 0 to DBGrid1.Columns.Count-1 do if IsRVFField(DBGrid1.Columns[i].Field) then DBGrid1.Columns[i].ButtonStyle := cbsEllipsis; DefRowHeight := TDrawGrid(DBGrid1).DefaultRowHeight; SetRowHeight; end; procedure TfrmMain.SetRowHeight; begin // A hack to change DBGrid row heights. Is it possible without hacks? TDrawGrid(DBGrid1).DefaultRowHeight := 100; TDrawGrid(DBGrid1).RowHeights[0] := DefRowHeight; end; procedure MakeSelected(rvh: TRVReportHelper); var i: Integer; begin for i := 0 to rvh.RichView.Style.TextStyles.Count-1 do rvh.RichView.Style.TextStyles[i].Color := clHighlightText; rvh.RichView.Color := clHighlight; end; // Drawing RVF field on Canvas at Rect using rvh. procedure DrawRVFField(field: TBlobField; Canvas: TCanvas; const Rect: TRect; rvh: TRVReportHelper; Selected: Boolean); var Stream: TMemoryStream; bmp: TBitmap; begin try rvh.RichView.Clear; rvh.RichView.Color := clWindow; Stream := TMemoryStream.Create; try field.SaveToStream(Stream); Stream.Position := 0; rvh.RichView.LoadRVFFromStream(Stream) finally Stream.Free; end; bmp := TBitmap.Create; try bmp.Width := Rect.Right-Rect.Left; bmp.Height := Rect.Bottom-Rect.Top; rvh.Init(bmp.Canvas, bmp.Width); rvh.FormatNextPage(1000); if Selected then MakeSelected(rvh); if rvh.PagesCount>0 then begin rvh.DrawPage(1, bmp.Canvas, True, bmp.Height); end; Canvas.Draw(Rect.Left, Rect.Top, bmp); finally bmp.Free; end; except end; end; // Drawing DBGrid RVF cell procedure TfrmMain.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if IsRVFField(Column.Field) then DrawRVFField(Column.Field as TBlobField, DBGrid1.Canvas, Rect, RVReportHelper1, gdSelected in State); end; // Editing procedure TfrmMain.DBGrid1EditButtonClick(Sender: TObject); var Stream: TMemoryStream; begin if not IsRVFField(DBGrid1.SelectedField) then exit; Stream := TMemoryStream.Create; try (DBGrid1.SelectedField as TBlobField).SaveToStream(Stream); Stream.Position := 0; frmEdit.RichViewEdit1.LoadRVFFromStream(Stream); frmEdit.RichViewEdit1.Format; finally Stream.Free; end; frmEdit.ActiveControl := frmEdit.RichViewEdit1; if frmEdit.ShowModal=mrOk then begin Table1.Edit; Stream := TMemoryStream.Create; try frmEdit.RichViewEdit1.SaveRVFToStream(Stream, False); Stream.Position := 0; (DBGrid1.SelectedField as TBlobField).LoadFromStream(Stream); finally Stream.Free; end; end; end; // Is this field a RVF field? function TfrmMain.IsRVFField(Field: TField): Boolean; begin Result := Field.FieldName='Data'; end; procedure TfrmMain.CheckBox1Click(Sender: TObject); begin if CheckBox1.Checked then DBGrid1.Options := DBGrid1.Options-[dgEditing] else DBGrid1.Options := DBGrid1.Options+[dgEditing]; SetRowHeight; end; end.