Componentes.Terceros.TRichView/12.0.4/Demos/DelphiUnicode/DB Demo/3 DBGrid/MainFrm.pas

{*******************************************************}
{                                                       }
{       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.