pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpvviewer: Starts adding print support

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2791 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2013-09-12 15:09:41 +00:00
parent 8d94f194a8
commit 628a8e6b46
4 changed files with 177 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
applications/fpvviewer/fpvv_mainform.lfm
View File

@ -82,7 +82,7 @@ object frmFPVViewer: TfrmFPVViewer
TabOrder = 1
object editFileName: TFileNameEdit
Left = 8
Height = 22
Height = 23
Top = 8
Width = 304
DialogOptions = []
@ -104,7 +104,7 @@ object frmFPVViewer: TfrmFPVViewer
end
object spinScale: TFloatSpinEdit
Left = 72
Height = 16
Height = 23
Top = 97
Width = 168
DecimalPlaces = 6
@ -117,9 +117,9 @@ object frmFPVViewer: TfrmFPVViewer
end
object Label1: TLabel
Left = 8
Height = 16
Height = 15
Top = 97
Width = 55
Width = 46
Caption = 'Scale by:'
ParentColor = False
end
@ -161,15 +161,15 @@ object frmFPVViewer: TfrmFPVViewer
end
object Label2: TLabel
Left = 8
Height = 16
Height = 15
Top = 72
Width = 88
Width = 73
Caption = 'Y adjustment:'
ParentColor = False
end
object spinAdjustY: TSpinEdit
Left = 80
Height = 16
Height = 23
Top = 72
Width = 72
Increment = 100
@ -180,7 +180,7 @@ object frmFPVViewer: TfrmFPVViewer
end
object spinAdjustX: TSpinEdit
Left = 232
Height = 16
Height = 23
Top = 72
Width = 72
Increment = 50
@ -191,9 +191,9 @@ object frmFPVViewer: TfrmFPVViewer
end
object Label3: TLabel
Left = 160
Height = 16
Height = 15
Top = 72
Width = 88
Width = 73
Caption = 'X adjustment:'
ParentColor = False
end
@ -208,18 +208,18 @@ object frmFPVViewer: TfrmFPVViewer
end
object Label4: TLabel
Left = 9
Height = 16
Height = 15
Top = 126
Width = 153
Width = 128
Caption = 'Force encoding on read:'
ParentColor = False
end
object comboEncoding: TComboBox
Left = 144
Height = 20
Height = 23
Top = 126
Width = 128
ItemHeight = 0
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'Read from the file'
@ -255,17 +255,17 @@ object frmFPVViewer: TfrmFPVViewer
end
object labelFileEncoding: TLabel
Left = 278
Height = 16
Height = 15
Top = 130
Width = 88
Width = 74
Caption = 'File encoding:'
ParentColor = False
end
object checkForceWhiteBackground: TCheckBox
Left = 9
Height = 18
Height = 19
Top = 152
Width = 178
Width = 153
Caption = 'Force white background?'
TabOrder = 11
end
@ -278,5 +278,23 @@ object frmFPVViewer: TfrmFPVViewer
OnClick = buttonViewDebugInfoClick
TabOrder = 12
end
object buttonPrint: TButton
Left = 416
Height = 25
Top = 8
Width = 59
Caption = 'Print'
OnClick = buttonPrintClick
TabOrder = 13
end
object buttonAdjust: TButton
Left = 344
Height = 25
Top = 8
Width = 56
Caption = 'Adjust'
OnClick = buttonAdjustClick
TabOrder = 14
end
end
end

137
applications/fpvviewer/fpvv_mainform.pas
View File

@ -7,7 +7,10 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
StdCtrls, Spin, ExtCtrls, ComCtrls, Grids, ColorBox, Math,
fpvv_drawer, fpimage, fpcanvas, coreconrec, fpvutils;
Printers, PrintersDlgs, LCLIntf, LCLType,
fpvv_drawer, fpimage, fpcanvas, coreconrec, fpvutils,
fpvectorial, lasvectorialreader, svgvectorialwriter,
dxfvectorialreader, epsvectorialreader, fpvtocanvas, dxftokentotree;
type
@ -20,6 +23,8 @@ type
btnVisualize: TButton;
Button1: TButton;
Button2: TButton;
buttonPrint: TButton;
buttonAdjust: TButton;
buttonViewDebugInfo: TButton;
buttonRenderingTest: TButton;
checkForceWhiteBackground: TCheckBox;
@ -47,6 +52,8 @@ type
procedure btnViewDXFTokensClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure buttonAdjustClick(Sender: TObject);
procedure buttonPrintClick(Sender: TObject);
procedure buttonRenderingTestClick(Sender: TObject);
procedure buttonViewDebugInfoClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -55,6 +62,7 @@ type
procedure spinAdjustYChange(Sender: TObject);
procedure spinScaleChange(Sender: TObject);
private
FVec: TvVectorialDocument;
procedure MyContourLineDrawingProc(z,x1,y1,x2,y2: Double);
function FPVDebugAddItemProc(AStr: string; AParent: Pointer): Pointer;
procedure HandleDrawerMouseWheel(Sender: TObject; Shift: TShiftState;
@ -62,6 +70,11 @@ type
procedure HandleDrawerPosChanged(Sender: TObject);
procedure HandleDrawerRedraw(Sender: TObject);
procedure ViewerDebugOutCallback(AStr: string);
//
procedure Render_PrepareFile();
procedure Render_DoRender(ACanvasSizeX, ACanvasSizeY,
ADrawerPosX, ADrawerPosY: Integer; AScale: Double);
procedure Render_FreeFile();
public
{ public declarations }
Drawer: TFPVVDrawer;
@ -72,12 +85,6 @@ var
implementation
uses
fpvectorial, lasvectorialreader, svgvectorialwriter,
dxfvectorialreader, epsvectorialreader,
fpvtocanvas,
dxftokentotree;
{$R *.lfm}
{ TfrmFPVViewer }
@ -320,6 +327,72 @@ begin
end;
end;
procedure TfrmFPVViewer.buttonAdjustClick(Sender: TObject);
const
FPVVIEWER_MAX_IMAGE_SIZE = 1000;
FPVVIEWER_MIN_IMAGE_SIZE = 100;
FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS = 100;
var
CanvasSize: TPoint;
begin
Render_PrepareFile();
try
// We need to be robust, because sometimes the document size won't be given
// also give up drawing everything if we need more then 4MB of RAM for the image
// and also give some space in the image to allow for negative coordinates
if FVec.Width * spinScale.Value > FPVVIEWER_MAX_IMAGE_SIZE then CanvasSize.X := FPVVIEWER_MAX_IMAGE_SIZE
else if FVec.Width < FPVVIEWER_MIN_IMAGE_SIZE then CanvasSize.X := Drawer.Width
else CanvasSize.X := Round(FVec.Width * spinScale.Value);
if CanvasSize.X < Drawer.Width then CanvasSize.X := Drawer.Width;
if FVec.Height * spinScale.Value > FPVVIEWER_MAX_IMAGE_SIZE then CanvasSize.Y := FPVVIEWER_MAX_IMAGE_SIZE
else if FVec.Height < FPVVIEWER_MIN_IMAGE_SIZE then CanvasSize.Y := Drawer.Height
else CanvasSize.Y := Round(FVec.Height * spinScale.Value);
if CanvasSize.Y < Drawer.Height then CanvasSize.Y := Drawer.Height;
Render_DoRender(Drawer.Width, Drawer.Height, 4, 4, FVec.Width / Drawer.Width);
finally
Render_FreeFile();
end;
end;
procedure TfrmFPVViewer.buttonPrintClick(Sender: TObject);
var
printDialog: TPrintDialog;
ScaleX, ScaleY: Double;
lRectSrc, lRectDest: TRect;
begin
// Create a printer selection dialog
printDialog := TPrintDialog.Create(Self);
// Set up print dialog options
printDialog.Options := [];
// if the user has selected a printer (or default), then print!
if printDialog.Execute then
begin
// Generate the image
btnVisualizeClick(Sender);
// Start printing
Printer.BeginDoc;
// Draw the image
ScaleX := LCLIntf.GetDeviceCaps(Handle, logPixelsX) / PixelsPerInch; // Don't know why, but GetDeviceCaps is returning zero...
ScaleY := LCLIntf.GetDeviceCaps(Handle, logPixelsY) / PixelsPerInch;
lRectSrc := Bounds(0, 0, Drawer.Drawing.Width, Drawer.Drawing.Height);
lRectDest := Bounds(0, 0, Printer.PageWidth, Printer.PageHeight);
Printer.Canvas.StretchDraw(
lRectDest,
Drawer.Drawing);
// Finish printing
Printer.EndDoc;
end;
printDialog.Free;
end;
procedure TfrmFPVViewer.buttonRenderingTestClick(Sender: TObject);
var
VecDoc: TvVectorialDocument;
@ -448,5 +521,55 @@ begin
memoDebug.Lines.Add(AStr);
end;
procedure TfrmFPVViewer.Render_PrepareFile;
begin
// First check the in input
if editFileName.FileName = '' then Exit; // silent exit in this simple case
//if not CheckInput() then Exit;
notebook.PageIndex := 0;
FVec := TvVectorialDocument.Create;
// If we desire, force a encoding for the read operation
if comboEncoding.ItemIndex > 0 then
FVec.ForcedEncodingOnRead := comboEncoding.Text
else FVec.ForcedEncodingOnRead := '';
FVec.ReadFromFile(editFileName.FileName);
end;
procedure TfrmFPVViewer.Render_DoRender(ACanvasSizeX, ACanvasSizeY,
ADrawerPosX, ADrawerPosY: Integer; AScale: Double);
const
FPVVIEWER_MAX_IMAGE_SIZE = 1000;
FPVVIEWER_MIN_IMAGE_SIZE = 100;
FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS = 100;
begin
// Show document properties
labelFileEncoding.Caption := 'File encoding: ' + FVec.Encoding;
Drawer.Drawing.Width := ACanvasSizeX;
Drawer.Drawing.Height := ACanvasSizeY;
Drawer.Drawing.Canvas.Brush.Color := clWhite;
Drawer.Drawing.Canvas.Brush.Style := bsSolid;
Drawer.Drawing.Canvas.FillRect(0, 0, Drawer.Drawing.Width, Drawer.Drawing.Height);
if checkForceWhiteBackground.Checked then FVec.GetPageAsVectorial(0).BackgroundColor := colWhite;
if not checkForceWhiteBackground.Checked then
FVec.GetPageAsVectorial(0).DrawBackground(Drawer.Drawing.Canvas);
FVec.GetPageAsVectorial(0).Render(
Drawer.Drawing.Canvas,
FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS + ADrawerPosX,
Drawer.Drawing.Height - FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS + ADrawerPosY,
spinScale.Value,
-1 * spinScale.Value);
Drawer.Invalidate;
end;
procedure TfrmFPVViewer.Render_FreeFile;
begin
FVec.Free;
end;
end.

17
applications/fpvviewer/fpvviewer.lpi
View File

@ -61,11 +61,9 @@
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
<LCLWidgetType Value="qt"/>
</CompilerOptions>
</Item3>
<SharedMatrixOptions Count="1">
<Item1 ID="194024408686" Modes="qt" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt"/>
</SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@ -77,17 +75,20 @@
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<RequiredPackages Count="4">
<Item1>
<PackageName Value="fpvectorialpkg"/>
<PackageName Value="Printer4Lazarus"/>
</Item1>
<Item2>
<PackageName Value="LCLBase"/>
<MinVersion Major="1" Release="1" Valid="True"/>
<PackageName Value="fpvectorialpkg"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
<PackageName Value="LCLBase"/>
<MinVersion Major="1" Release="1" Valid="True"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="5">
<Unit0>

3
applications/fpvviewer/fpvviewer.lpr
View File

@ -7,7 +7,8 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, fpvv_mainform, dxftokentotree, fpvv_drawer, fpvectorialpkg, CoreConRec;
Forms, fpvv_mainform, dxftokentotree, fpvv_drawer, fpvectorialpkg,
printer4lazarus, CoreConRec;
{$R *.res}