MainFrm.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:5k
- {*******************************************************}
- { }
- { 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.