📄 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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -