Menu
▾
▴
[JVCL-Checkins] CVS: dev/p3/examples/JvPreviewDocument JvPrvwDemo.dpr,1.1,1.2 MainFrm.dfm,1.3,1.4 MainFrm.pas,1.3,1.4
|
From: Peter T. <pe...@us...> - 2003-01-28 01:19:30
|
Update of /cvsroot/jvcl/dev/p3/examples/JvPreviewDocument
In directory sc8-pr-cvs1:/tmp/cvs-serv30718/p3/examples/JvPreviewDocument
Modified Files:
JvPrvwDemo.dpr MainFrm.dfm MainFrm.pas
Log Message:
Index: JvPrvwDemo.dpr
===================================================================
RCS file: /cvsroot/jvcl/dev/p3/examples/JvPreviewDocument/JvPrvwDemo.dpr,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** JvPrvwDemo.dpr 22 Jan 2003 17:37:11 -0000 1.1
--- JvPrvwDemo.dpr 28 Jan 2003 01:19:27 -0000 1.2
***************
*** 3,7 ****
uses
Forms,
! MainFrm in 'MainFrm.pas' {Form1},
JvPrvwDoc in '..\..\source\JvPrvwDoc.pas';
--- 3,7 ----
uses
Forms,
! MainFrm in 'MainFrm.pas' {frmMain},
JvPrvwDoc in '..\..\source\JvPrvwDoc.pas';
***************
*** 10,14 ****
begin
Application.Initialize;
! Application.CreateForm(TForm1, Form1);
Application.Run;
end.
--- 10,14 ----
begin
Application.Initialize;
! Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
Index: MainFrm.dfm
===================================================================
RCS file: /cvsroot/jvcl/dev/p3/examples/JvPreviewDocument/MainFrm.dfm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** MainFrm.dfm 25 Jan 2003 14:30:27 -0000 1.3
--- MainFrm.dfm 28 Jan 2003 01:19:27 -0000 1.4
***************
*** 1,3 ****
! object Form1: TForm1
Left = 353
Top = 176
--- 1,3 ----
! object frmMain: TfrmMain
Left = 353
Top = 176
***************
*** 9,13 ****
Font.Color = clWindowText
Font.Height = -11
! Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
--- 9,13 ----
Font.Color = clWindowText
Font.Height = -11
! Font.Name = 'MS Shell Dlg 2'
Font.Style = []
Menu = MainMenu1
***************
*** 27,31 ****
Left = 16
Top = 8
! Width = 43
Height = 13
Caption = 'Columns:'
--- 27,31 ----
Left = 16
Top = 8
! Width = 44
Height = 13
Caption = 'Columns:'
***************
*** 34,45 ****
Left = 112
Top = 8
! Width = 64
Height = 13
! Caption = 'Visible Count:'
end
object Label3: TLabel
Left = 208
Top = 8
! Width = 71
Height = 13
Caption = 'Shadow offset:'
--- 34,45 ----
Left = 112
Top = 8
! Width = 30
Height = 13
! Caption = 'Rows:'
end
object Label3: TLabel
Left = 208
Top = 8
! Width = 74
Height = 13
Caption = 'Shadow offset:'
***************
*** 48,52 ****
Left = 304
Top = 8
! Width = 27
Height = 13
Caption = 'Zoom'
--- 48,52 ----
Left = 304
Top = 8
! Width = 26
Height = 13
Caption = 'Zoom'
***************
*** 55,73 ****
Left = 400
Top = 8
! Width = 41
Height = 13
Caption = 'Preview:'
end
- object chkAutoScroll: TCheckBox
- Left = 576
- Top = 34
- Width = 97
- Height = 17
- Caption = 'AutoScroll'
- Checked = True
- State = cbChecked
- TabOrder = 0
- OnClick = chkAutoScrollClick
- end
object Edit1: TEdit
Left = 16
--- 55,62 ----
Left = 400
Top = 8
! Width = 42
Height = 13
Caption = 'Preview:'
end
object Edit1: TEdit
Left = 16
***************
*** 75,79 ****
Width = 65
Height = 21
! TabOrder = 1
Text = '1'
end
--- 64,68 ----
Width = 65
Height = 21
! TabOrder = 0
Text = '1'
end
***************
*** 86,90 ****
Min = 1
Position = 1
! TabOrder = 2
Wrap = False
OnClick = udColumnsClick
--- 75,79 ----
Min = 1
Position = 1
! TabOrder = 1
Wrap = False
OnClick = udColumnsClick
***************
*** 95,102 ****
Width = 65
Height = 21
! TabOrder = 3
Text = '1'
end
! object udCount: TUpDown
Left = 177
Top = 24
--- 84,91 ----
Width = 65
Height = 21
! TabOrder = 2
Text = '1'
end
! object udRows: TUpDown
Left = 177
Top = 24
***************
*** 106,112 ****
Min = 1
Position = 1
! TabOrder = 4
Wrap = False
! OnClick = udCountClick
end
object Edit3: TEdit
--- 95,101 ----
Min = 1
Position = 1
! TabOrder = 3
Wrap = False
! OnClick = udRowsClick
end
object Edit3: TEdit
***************
*** 115,119 ****
Width = 65
Height = 21
! TabOrder = 5
Text = '4'
end
--- 104,108 ----
Width = 65
Height = 21
! TabOrder = 4
Text = '4'
end
***************
*** 126,130 ****
Min = -100
Position = 4
! TabOrder = 6
Wrap = False
OnClick = udShadowWidthClick
--- 115,119 ----
Min = -100
Position = 4
! TabOrder = 5
Wrap = False
OnClick = udShadowWidthClick
***************
*** 135,140 ****
Width = 65
Height = 21
! TabOrder = 7
! Text = '10'
end
object udZoom: TUpDown
--- 124,129 ----
Width = 65
Height = 21
! TabOrder = 6
! Text = '100'
end
object udZoom: TUpDown
***************
*** 146,174 ****
Min = 1
Max = 1000
! Position = 10
! TabOrder = 8
Thousands = False
Wrap = False
OnClick = udZoomClick
end
- object Button1: TButton
- Left = 680
- Top = 24
- Width = 75
- Height = 25
- Anchors = [akRight, akBottom]
- Caption = 'Printer...'
- TabOrder = 9
- OnClick = Button1Click
- end
- object chkMargins: TCheckBox
- Left = 576
- Top = 16
- Width = 65
- Height = 17
- Caption = 'Margins'
- TabOrder = 10
- OnClick = chkMarginsClick
- end
object cbPreview: TComboBox
Left = 400
--- 135,144 ----
Min = 1
Max = 1000
! Position = 100
! TabOrder = 7
Thousands = False
Wrap = False
OnClick = udZoomClick
end
object cbPreview: TComboBox
Left = 400
***************
*** 178,192 ****
Style = csDropDownList
ItemHeight = 13
! TabOrder = 11
OnChange = cbPreviewChange
Items.Strings = (
'Screen'
- 'Form'
'Printer')
end
end
object PrinterSetupDialog1: TPrinterSetupDialog
! Left = 672
! Top = 368
end
object MainMenu1: TMainMenu
--- 148,194 ----
Style = csDropDownList
ItemHeight = 13
! TabOrder = 8
OnChange = cbPreviewChange
Items.Strings = (
'Screen'
'Printer')
end
end
+ object PageControl1: TPageControl
+ Left = 0
+ Top = 0
+ Width = 775
+ Height = 429
+ ActivePage = tabOriginal
+ Align = alClient
+ TabIndex = 0
+ TabOrder = 1
+ object tabOriginal: TTabSheet
+ Caption = 'Original'
+ ImageIndex = 1
+ object reOriginal: TJvRichEdit
+ Left = 0
+ Top = 0
+ Width = 767
+ Height = 401
+ Align = alClient
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Courier New'
+ Font.Style = []
+ ParentFont = False
+ ScrollBars = ssBoth
+ TabOrder = 0
+ WantTabs = True
+ end
+ end
+ object tabPreview: TTabSheet
+ Caption = 'Preview'
+ end
+ end
object PrinterSetupDialog1: TPrinterSetupDialog
! Left = 152
! Top = 64
end
object MainMenu1: TMainMenu
***************
*** 200,204 ****
--- 202,266 ----
OnClick = Open1Click
end
+ object N1: TMenuItem
+ Caption = '-'
+ end
+ object Printer1: TMenuItem
+ Caption = 'Printer...'
+ ShortCut = 16464
+ OnClick = Printer1Click
+ end
+ object N2: TMenuItem
+ Caption = '-'
+ end
+ object Exit1: TMenuItem
+ Caption = 'Exit'
+ ShortCut = 32883
+ OnClick = Exit1Click
+ end
end
+ object View1: TMenuItem
+ Caption = 'View'
+ object First1: TMenuItem
+ Caption = 'First'
+ ShortCut = 16420
+ OnClick = First1Click
+ end
+ object Previous1: TMenuItem
+ Caption = 'Previous'
+ ShortCut = 16417
+ OnClick = Previous1Click
+ end
+ object Next1: TMenuItem
+ Caption = 'Next'
+ ShortCut = 16418
+ OnClick = Next1Click
+ end
+ object Last1: TMenuItem
+ Caption = 'Last'
+ ShortCut = 16419
+ OnClick = Last1Click
+ end
+ end
+ object Options1: TMenuItem
+ Caption = 'Options'
+ object mnuMargins: TMenuItem
+ Caption = 'Margins'
+ Checked = True
+ OnClick = mnuMarginsClick
+ end
+ end
+ object Help1: TMenuItem
+ Caption = 'Help'
+ object About1: TMenuItem
+ Caption = 'About...'
+ OnClick = About1Click
+ end
+ end
+ end
+ object OpenDialog1: TOpenDialog
+ Filter = 'RTF files|*.rtf|All files(*.*)|*.*'
+ InitialDir = '.'
+ Left = 92
+ Top = 112
end
end
Index: MainFrm.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/p3/examples/JvPreviewDocument/MainFrm.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** MainFrm.pas 25 Jan 2003 14:30:27 -0000 1.3
--- MainFrm.pas 28 Jan 2003 01:19:27 -0000 1.4
***************
*** 5,21 ****
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
! Dialogs, JvPrvwDoc, ComCtrls, StdCtrls, ExtCtrls, Menus;
type
! TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
- chkAutoScroll: TCheckBox;
Label3: TLabel;
Edit1: TEdit;
udColumns: TUpDown;
Edit2: TEdit;
! udCount: TUpDown;
Edit3: TEdit;
udShadowWidth: TUpDown;
--- 5,20 ----
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
! Dialogs, JvPrvwDoc, ComCtrls, StdCtrls, ExtCtrls, Menus, JvRichEdit;
type
! TfrmMain = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
udColumns: TUpDown;
Edit2: TEdit;
! udRows: TUpDown;
Edit3: TEdit;
udShadowWidth: TUpDown;
***************
*** 23,29 ****
Edit4: TEdit;
udZoom: TUpDown;
- Button1: TButton;
PrinterSetupDialog1: TPrinterSetupDialog;
- chkMargins: TCheckBox;
cbPreview: TComboBox;
Label5: TLabel;
--- 22,26 ----
***************
*** 31,73 ****
File1: TMenuItem;
Open1: TMenuItem;
procedure FormCreate(Sender: TObject);
- procedure chkAutoScrollClick(Sender: TObject);
procedure udColumnsClick(Sender: TObject; Button: TUDBtnType);
! procedure udCountClick(Sender: TObject; Button: TUDBtnType);
procedure udShadowWidthClick(Sender: TObject; Button: TUDBtnType);
procedure udZoomClick(Sender: TObject; Button: TUDBtnType);
- procedure Button1Click(Sender: TObject);
- procedure chkMarginsClick(Sender: TObject);
procedure cbPreviewChange(Sender: TObject);
procedure Open1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
! pd:TJvPreviewDoc;
end;
! // NB! Doesn't wordwrap!
TJvStringsPreviewRenderer = class(TObject)
private
! FStrings:TStringlist;
! FPreview:TJvPreviewDoc;
! FFinished:boolean;
! FCurrentRow:integer;
procedure CreatePreview;
procedure DoAddPage(Sender: TObject; PageIndex: integer;
Canvas: TCanvas; PageRect, PrintRect: TRect);
public
! constructor Create(Preview:TJvPreviewDoc;Strings:TStrings);
! destructor Destroy;override;
! property Finished:boolean read FFinished;
end;
var
! Form1: TForm1;
implementation
uses
! Printers;
{$R *.dfm}
--- 28,110 ----
File1: TMenuItem;
Open1: TMenuItem;
+ N1: TMenuItem;
+ Printer1: TMenuItem;
+ N2: TMenuItem;
+ Exit1: TMenuItem;
+ View1: TMenuItem;
+ First1: TMenuItem;
+ Previous1: TMenuItem;
+ Next1: TMenuItem;
+ Last1: TMenuItem;
+ Help1: TMenuItem;
+ About1: TMenuItem;
+ Options1: TMenuItem;
+ mnuMargins: TMenuItem;
+ PageControl1: TPageControl;
+ tabPreview: TTabSheet;
+ tabOriginal: TTabSheet;
+ OpenDialog1: TOpenDialog;
+ reOriginal: TJvRichEdit;
procedure FormCreate(Sender: TObject);
procedure udColumnsClick(Sender: TObject; Button: TUDBtnType);
! procedure udRowsClick(Sender: TObject; Button: TUDBtnType);
procedure udShadowWidthClick(Sender: TObject; Button: TUDBtnType);
procedure udZoomClick(Sender: TObject; Button: TUDBtnType);
procedure cbPreviewChange(Sender: TObject);
procedure Open1Click(Sender: TObject);
+ procedure Exit1Click(Sender: TObject);
+ procedure Printer1Click(Sender: TObject);
+ procedure mnuMarginsClick(Sender: TObject);
+ procedure First1Click(Sender: TObject);
+ procedure Previous1Click(Sender: TObject);
+ procedure Next1Click(Sender: TObject);
+ procedure Last1Click(Sender: TObject);
+ procedure About1Click(Sender: TObject);
private
+ procedure OpenFile(const Filename: string);
{ Private declarations }
public
{ Public declarations }
! pd: TJvPreviewDoc;
end;
!
! // NB! Implements very simple wordwrap (doesn't always work)!
TJvStringsPreviewRenderer = class(TObject)
private
! FStrings: TStrings;
! FPreview: TJvPreviewDoc;
! FFinished: boolean;
! FCurrentRow: integer;
procedure CreatePreview;
procedure DoAddPage(Sender: TObject; PageIndex: integer;
Canvas: TCanvas; PageRect, PrintRect: TRect);
public
! constructor Create(Preview: TJvPreviewDoc; Strings: TStrings);
! destructor Destroy; override;
! property Finished: boolean read FFinished;
end;
+ TJvRTFRenderer = class(TObject)
+ private
+ FFinished: boolean;
+ FLastChar: integer;
+ FSaveRect: TREct;
+ FRE: TRichEdit;
+ FPreview: TJvPreviewDoc;
+ protected
+ procedure DoAddPage(Sender: TObject; PageIndex: integer;
+ Canvas: TCanvas; PageRect, PrintRect: TRect);
+ procedure CreatePreview;
+ public
+ constructor Create(Preview: TJvPreviewDoc; RichEdit: TRichEdit);
+ property Finished: boolean read FFinished;
+ end;
var
! frmMain: TfrmMain;
implementation
uses
! RichEdit, Printers;
{$R *.dfm}
***************
*** 79,90 ****
inherited Create;
FPreview := Preview;
! FStrings := TStringlist.Create;
! FStrings.Assign(Strings);
CreatePreview;
end;
procedure TJvStringsPreviewRenderer.DoAddPage(Sender: TObject; PageIndex: integer; Canvas: TCanvas;
! PageRect, PrintRect: TRect);
! var i,X,Y,IncValue:integer;ARect:TRect;tm:TTextMetric;
begin
if not FFinished then
--- 116,126 ----
inherited Create;
FPreview := Preview;
! FStrings := Strings;
CreatePreview;
end;
procedure TJvStringsPreviewRenderer.DoAddPage(Sender: TObject; PageIndex: integer; Canvas: TCanvas;
! PageRect, PrintRect: TRect);
! var i, IncValue: integer; ARect: TRect; tm: TTextMetric; S: string;
begin
if not FFinished then
***************
*** 92,113 ****
Canvas.Font.Name := 'Courier New';
Canvas.Font.Size := 10;
- GetTextMetrics(Canvas.Handle,tm);
- IncValue := Canvas.TextHeight('Wq') + tm.tmInternalLeading + tm.tmExternalLeading;
ARect := PrintRect;
! OffsetRect(ARect,1,1);
! ARect.Bottom := ARect.Top + IncValue + 1;
for i := FCurrentRow to FStrings.Count - 1 do
begin
! DrawText(Canvas.Handle,PChar(FStrings[i]),-1, ARect, DT_NOPREFIX or DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT);
! OffsetRect(ARect,0,IncValue);
if ARect.Bottom > PrintRect.Bottom then
begin
! FPreview.Add;
! FCurrentRow := i + 1;
Exit;
end;
end;
- FFinished := true;
end;
end;
--- 128,159 ----
Canvas.Font.Name := 'Courier New';
Canvas.Font.Size := 10;
ARect := PrintRect;
!
! GetTextMetrics(Canvas.Handle, tm);
! IncValue := Canvas.TextHeight('Wq') + tm.tmInternalLeading + tm.tmExternalLeading;
! ARect.Bottom := ARect.Top + IncValue;
for i := FCurrentRow to FStrings.Count - 1 do
begin
! ARect.Right := PrintRect.Right;
! S := FStrings[i];
! IncValue := DrawText(Canvas.Handle, PChar(S), Length(S), ARect, DT_CALCRECT or DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
! if ARect.Right > PrintRect.Right then
! begin
! ARect.Right := PrintRect.Right; // reset and jsut force a line break in the middle (not fail proof!)
! S := Copy(S, 1, Length(S) div 2) + #13#10 +
! Copy(S, Length(S) div 2 + 1, Length(S));
! IncValue := DrawText(Canvas.Handle, PChar(S), Length(S), ARect, DT_CALCRECT or DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
! end;
if ARect.Bottom > PrintRect.Bottom then
begin
! FPreview.Add; // New Page
! FCurrentRow := i;
Exit;
end;
+ DrawText(Canvas.Handle, PChar(S), Length(S), ARect, DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
+ OffsetRect(ARect, 0, IncValue);
end;
end;
+ FFinished := true;
end;
***************
*** 116,173 ****
FPreview.Clear;
FPreview.OnAddPage := DoAddPage;
- FFinished := false;
FCurrentRow := 0;
if FStrings.Count > 0 then
FPreview.Add
else
! FFinished := true;
end;
destructor TJvStringsPreviewRenderer.Destroy;
begin
! FStrings.Free;
inherited;
end;
! procedure TForm1.FormCreate(Sender: TObject);
begin
pd := TJvPreviewDoc.Create(self);
! pd.Parent := self;
pd.Align := alClient;
! pd.Options.DrawMargins := chkMargins.Checked;
! pd.Options.Count := udCount.Position;
! pd.Options.Columns := udColumns.Position;
pd.Options.Shadow.Offset := udShadowWidth.Position;
pd.Options.Zoom := udZoom.Position;
! cbPreview.ItemIndex := 0;
cbPreviewChange(nil);
end;
! procedure TForm1.chkAutoScrollClick(Sender: TObject);
begin
! pd.AutoScroll := chkAutoScroll.Checked;
end;
! procedure TForm1.udColumnsClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Columns := udColumns.Position;
end;
! procedure TForm1.udCountClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Count := udCount.Position;
end;
! procedure TForm1.udShadowWidthClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Shadow.Offset := udShadowWidth.Position;
end;
! procedure TForm1.udZoomClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Zoom := udZoom.Position;
end;
! procedure TForm1.Button1Click(Sender: TObject);
begin
PrinterSetupDialog1.Execute;
--- 162,253 ----
FPreview.Clear;
FPreview.OnAddPage := DoAddPage;
FCurrentRow := 0;
if FStrings.Count > 0 then
FPreview.Add
else
! FFinished := true;
end;
destructor TJvStringsPreviewRenderer.Destroy;
begin
! // FStrings.Free;
inherited;
end;
! { TfrmMain }
!
! procedure TfrmMain.FormCreate(Sender: TObject);
begin
pd := TJvPreviewDoc.Create(self);
! pd.Parent := tabPreview;
pd.Align := alClient;
! pd.TabStop := true;
! pd.Options.DrawMargins := mnuMargins.Checked;
! pd.Options.Rows := udRows.Position;
! pd.Options.Cols := udColumns.Position;
pd.Options.Shadow.Offset := udShadowWidth.Position;
pd.Options.Zoom := udZoom.Position;
! cbPreview.ItemIndex := 1;
cbPreviewChange(nil);
end;
! procedure TfrmMain.udColumnsClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Cols := udColumns.Position;
end;
! procedure TfrmMain.udRowsClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Rows := udRows.Position;
end;
! procedure TfrmMain.udShadowWidthClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Shadow.Offset := udShadowWidth.Position;
end;
! procedure TfrmMain.udZoomClick(Sender: TObject; Button: TUDBtnType);
begin
! pd.Options.Zoom := udZoom.Position;
end;
! procedure TfrmMain.cbPreviewChange(Sender: TObject);
begin
! case cbPreview.ItemIndex of
! 0:
! pd.DeviceInfo.ReferenceHandle := 0; // reset to default (screen)
! 1:
! pd.DeviceInfo.ReferenceHandle := Printer.Handle;
! end;
! if FileExists(OpenDialog1.Filename) then
! OpenFile(OpenDialog1.Filename);
end;
! procedure TfrmMain.OpenFile(const Filename: string);
! begin
! reOriginal.Lines.LoadFromFile(OpenDialog1.Filename);
! with TJvRTFRenderer.Create(pd, reOriginal) do
! try
! while not Finished do
! Application.ProcessMessages;
! finally
! Free;
! end;
! Caption := Format('%s: - (%d pages)',
! [ExtractFilename(OpenDialog1.Filename), pd.PageCount]);
! end;
!
! procedure TfrmMain.Open1Click(Sender: TObject);
! begin
! if OpenDialog1.Execute then
! OpenFile(OpenDialog1.Filename);
! end;
!
! procedure TfrmMain.Exit1Click(Sender: TObject);
! begin
! Close;
! end;
!
! procedure TfrmMain.Printer1Click(Sender: TObject);
begin
PrinterSetupDialog1.Execute;
***************
*** 175,219 ****
end;
! procedure TForm1.chkMarginsClick(Sender: TObject);
begin
! pd.Options.DrawMargins := chkMargins.Checked;
end;
! procedure TForm1.cbPreviewChange(Sender: TObject);
begin
! case cbPreview.ItemIndex of
! 0:
! pd.DeviceInfo.ReferenceHandle := 0; // reset to default (screen)
! 1:
! pd.DeviceInfo.ReferenceHandle := Canvas.Handle; // should give same result as Screen
! 2:
! pd.DeviceInfo.ReferenceHandle := Printer.Handle;
! end;
end;
! procedure TForm1.Open1Click(Sender: TObject);
! var S:TStringlist;
begin
! with TOpenDialog.Create(nil) do
! try
! if Execute then
begin
! S := TStringlist.Create;
! try
! S.LoadFromFile(Filename);
! with TJvStringsPreviewRenderer.Create(pd,S) do
! try
! while not Finished do Application.ProcessMessages;
! finally
! Free;
! end;
! finally
! S.Free;
! end;
end;
! finally
! Free;
end;
end;
end.
--- 255,364 ----
end;
! procedure TfrmMain.mnuMarginsClick(Sender: TObject);
begin
! mnuMargins.Checked := not mnuMargins.Checked;
! pd.Options.DrawMargins := mnuMargins.Checked;
end;
! procedure TfrmMain.First1Click(Sender: TObject);
begin
! pd.SelectedPage := 0;
end;
! procedure TfrmMain.Previous1Click(Sender: TObject);
begin
! pd.SelectedPage := pd.SelectedPage - 1;
! end;
!
! procedure TfrmMain.Next1Click(Sender: TObject);
! begin
! pd.SelectedPage := pd.SelectedPage + 1;
! end;
!
! procedure TfrmMain.Last1Click(Sender: TObject);
! begin
! pd.SelectedPage := pd.PageCount - 1;
! end;
!
! procedure TfrmMain.About1Click(Sender: TObject);
! begin
! ShowMessage('JvPreviewDocument Demo');
! end;
!
! { TJvRTFRenderer }
!
! constructor TJvRTFRenderer.Create(Preview: TJvPreviewDoc;
! RichEdit: TRichEdit);
! begin
! inherited Create;
! FRE := RichEdit;
! FPreview := Preview;
! CreatePreview;
! end;
!
! procedure TJvRTFRenderer.CreatePreview;
! begin
! if FRE.Lines.Count > 0 then
! begin
! FLastChar := 0;
! FPreview.Clear;
! FPreview.OnAddPage := DoAddPage;
! FPreview.Add;
! end
! else
! FFinished := true;
! end;
!
! // this code was almost entirely stolen from TRichEidt.Print
! procedure TJvRTFRenderer.DoAddPage(Sender: TObject; PageIndex: integer;
! Canvas: TCanvas; PageRect, PrintRect: TRect);
! var
! Range: TFormatRange;
! OutDC: HDC;
! MaxLen, LogX, LogY, OldMap: Integer;
! begin
! if not Finished then
! begin
! FillChar(Range, SizeOf(TFormatRange), 0);
! OutDC := Canvas.Handle;
! Range.hdc := OutDC;
! Range.hdcTarget := OutDC;
! LogX := GetDeviceCaps(OutDC, LOGPIXELSX);
! LogY := GetDeviceCaps(OutDC, LOGPIXELSY);
! if IsRectEmpty(FRE.PageRect) then
begin
! Range.rc.right := (PrintRect.Right - PrintRect.Left) * 1440 div LogX;
! Range.rc.bottom := (PrintRect.Bottom - PrintRect.Top) * 1440 div LogY;
! end
! else
! begin
! Range.rc.left := FRE.PageRect.Left * 1440 div LogX;
! Range.rc.top := FRE.PageRect.Top * 1440 div LogY;
! Range.rc.right := FRE.PageRect.Right * 1440 div LogX;
! Range.rc.bottom := FRE.PageRect.Bottom * 1440 div LogY;
end;
! FSaveRect := Range.rc;
! Range.rcPage := Range.rc;
! MaxLen := FRE.GetTextLen;
! Range.chrg.cpMax := -1;
!
! // ensure the output DC is in text map mode
! OldMap := SetMapMode(Range.hdc, MM_TEXT);
! try
! SendMessage(FRE.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
!
! Range.chrg.cpMin := FLastChar;
! FLastChar := SendMessage(FRE.Handle, EM_FORMATRANGE, 1, Longint(@Range));
! FFinished := (FLastChar >= MaxLen) or (FLastChar = -1);
! SendMessage(FRE.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
! if not Finished then FPreview.Add;
! finally
! SetMapMode(OutDC, OldMap);
! end;
! Exit;
end;
+ // FFinished := true;
end;
end.
+
|